diff --git a/Control/CP/ComposableTransformers.hs b/Control/CP/ComposableTransformers.hs
--- a/Control/CP/ComposableTransformers.hs
+++ b/Control/CP/ComposableTransformers.hs
@@ -8,12 +8,12 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 module Control.CP.ComposableTransformers (
-  solve, 
+  solve, restart,
   NewBound, 
-  Bound,
+  Bound(..),
+  Composition(..),
   CTransformer, 
   CForSolver, 
   CForResult, 
@@ -24,6 +24,7 @@
   CDepthBoundedST(..),
   CBranchBoundST(..),
   CFirstSolutionST(..),
+  CSolutionBoundST(..),
   CIdentityCST(..),
   CRandomST(..),
   CLimitedDiscrepancyST(..)
@@ -46,6 +47,13 @@
       => q -> c -> Tree solver (CForResult c) -> (Int,[CForResult c])
 solve q c model = run $ eval model q (TStack c)
 
+
+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 = run $ eval model q (RestartST (map Seal cs) return)
+
+
 --------------------------------------------------------------------------------
 -- COMPOSABLE TRANSFORMERS
 --------------------------------------------------------------------------------
@@ -192,7 +200,18 @@
     exit False
   completeCT _ es = es 
 
+data CSolutionBoundST (solver :: * -> *) a = CSBST Int
 
+instance Solver solver => CTransformer (CSolutionBoundST solver a) where
+  type CEvalState (CSolutionBoundST solver a) = Int
+  type CTreeState (CSolutionBoundST solver a) = ()
+  type CForSolver (CSolutionBoundST solver a) = solver
+  type CForResult (CSolutionBoundST solver a) = a
+  initCT (CSBST n) = (n,())
+  returnCT _ 1 continue exit = exit 0
+  returnCT _ n continue exit = continue (n-1)
+  completeCT _ es = es==0
+
 --------------------------------------------------------------------------------
 data Composition es ts solver a where
   (:-) :: (CTransformer c1, CTransformer c2,
@@ -231,7 +250,7 @@
 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)
+newtype Bound    solver  = Bound (forall a. (Tree solver a -> Tree solver a))
 type NewBound solver  = solver (Bound solver)
 
 instance (Solver solver) => CTransformer (CBranchBoundST solver a) where
@@ -239,13 +258,13 @@
   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
+  initCT _  = (BBP 0 (Bound id),0)
+  nextCT tree c es@(BBP nv (Bound 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' :: Bound solver <- newBound  
-       continue (BBP (v + 1) bound')
+    do bound' <- newBound
+       continue $ BBP (v + 1) bound' 
 
 --------------------------------------------------------------------------------
 -- RESTARTING
diff --git a/Control/CP/FD/FD.hs b/Control/CP/FD/FD.hs
--- a/Control/CP/FD/FD.hs
+++ b/Control/CP/FD/FD.hs
@@ -4,8 +4,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Rank2Types #-}
 
 module Control.CP.FD.FD (
   module Data.Expr.Sugar,
@@ -174,7 +172,7 @@
 --        put s { fdsMinimizeTerm = Just q }
 --        return $ Just q
 
-boundMinimize :: forall s. (Show (FDIntTerm s), FDSolver s, EnumTerm s (FDIntTerm s), Integral (TermBaseType s (FDIntTerm s))) => NewBound (FDInstance s)
+boundMinimize :: (Show (FDIntTerm s), FDSolver s, EnumTerm s (FDIntTerm s), Integral (TermBaseType s (FDIntTerm s))) => NewBound (FDInstance s)
 boundMinimize = do
   bound <- getMinimizeTerm
   case bound of
@@ -184,9 +182,8 @@
       case x of
         Just val -> do
           con <- liftFD $ fdConstrainIntTerm bndvar (toInteger val)
-          (let f :: Bound (FDInstance s)
-               f = \x -> (Add (Right con) x)
-           in (return :: Bound (FDInstance s) -> NewBound (FDInstance s)) (f :: Bound (FDInstance s)) :: NewBound (FDInstance s))
+          let f = Bound (\x -> (Add (Right con) x))
+          return f
         _ -> error "bound variable is not assigned"
 
 runFD :: FDSolver s => FDInstance s a -> s a
@@ -754,27 +751,35 @@
 --      colX v = FDSpecInfoCol { fdspColSpec = an $ colS v, fdspColVar = Just v, fdspColVal = getColVal_ v s, fdspColTypes = Set.fromList $ Map.keys $ colS v }
   return (map boolS $ boolData $ egeLinks edge, map intS $ intData $ egeLinks edge, map colS $ colData $ egeLinks edge)
 
-fdSpecInfo_spec 
-  :: forall s. FDSolver s 
-  => ([Either (FDSpecInfoBool s) (FDBoolSpecType s,FDBoolSpec s)]
-     ,[Either (FDSpecInfoInt s) (FDIntSpecType s,FDIntSpec s)]
-     ,[Either (FDSpecInfoCol s) (FDColSpecType s,FDColSpec s)]) 
-  -> FDSpecInfo s
-fdSpecInfo_spec (b,i,c) =
-  (map fb b, map fi i, map fc c)
-  where
-    fb :: Either (FDSpecInfoBool s) (FDBoolSpecType s, FDBoolSpec s) -> FDSpecInfoBool s
-    fb (Left x)  = x
-    fb (Right x) = FDSpecInfoBool { fdspBoolSpec = nt x, fdspBoolVar = Nothing, fdspBoolVal = Nothing, fdspBoolTypes = Set.singleton $ fst x }
-    fi :: Either (FDSpecInfoInt s) (FDIntSpecType s, FDIntSpec s) -> FDSpecInfoInt s
-    fi (Right x) = FDSpecInfoInt  { fdspIntSpec  = nt x, fdspIntVar  = Nothing, fdspIntVal  = Nothing, fdspIntTypes = Set.singleton $ fst x }
-    fi (Left x) = x
-    fc (Right x) = FDSpecInfoCol  { fdspColSpec  = nt x, fdspColVar  = Nothing, fdspColVal  = Nothing, fdspColTypes = Set.singleton $ fst x }
-    fc (Left x) = x
-    nt :: forall a b. Eq a => (a,b) -> Maybe a ->  Maybe b
-    nt (_,x)  Nothing   = Just x
-    nt (t1,x) (Just t2) | t1==t2 = Just x
-    nt _      _         = Nothing
+fdSpecInfo_spec :: FDSolver s => ([Either (FDSpecInfoBool s) (FDBoolSpecType s,FDBoolSpec s)],[Either (FDSpecInfoInt s) (FDIntSpecType s,FDIntSpec s)],[Either (FDSpecInfoCol s) (FDColSpecType s,FDColSpec s)]) -> FDSpecInfo s
+fdSpecInfo_spec (b,i,c) = (fdSpecInfo_spec_b b, fdSpecInfo_spec_i i, fdSpecInfo_spec_c c)
+
+fdSpecInfo_spec_b :: FDSolver s => [Either (FDSpecInfoBool s) (FDBoolSpecType s,FDBoolSpec s)] -> [FDSpecInfoBool s]
+fdSpecInfo_spec_b b =
+  let fb (Right x) = FDSpecInfoBool { fdspBoolSpec = nt x, fdspBoolVar = Nothing, fdspBoolVal = Nothing, fdspBoolTypes = Set.singleton $ fst x }
+      fb (Left x) = x
+      nt (_,x) Nothing = Just x
+      nt (t1,x) (Just t2) | t1==t2 = Just x
+      nt _ _ = Nothing
+  in (map fb b)
+
+fdSpecInfo_spec_i :: FDSolver s => [Either (FDSpecInfoInt s) (FDIntSpecType s,FDIntSpec s)] -> [FDSpecInfoInt s]
+fdSpecInfo_spec_i i =
+  let fi (Right x) = FDSpecInfoInt  { fdspIntSpec  = nt x, fdspIntVar  = Nothing, fdspIntVal  = Nothing, fdspIntTypes = Set.singleton $ fst x }
+      fi (Left x) = x
+      nt (_,x) Nothing = Just x
+      nt (t1,x) (Just t2) | t1==t2 = Just x
+      nt _ _ = Nothing
+  in (map fi i)
+
+fdSpecInfo_spec_c :: FDSolver s => [Either (FDSpecInfoCol s) (FDColSpecType s,FDColSpec s)] -> [FDSpecInfoCol s]
+fdSpecInfo_spec_c c =
+  let fc (Right x) = FDSpecInfoCol  { fdspColSpec  = nt x, fdspColVar  = Nothing, fdspColVal  = Nothing, fdspColTypes = Set.singleton $ fst x }
+      fc (Left x) = x
+      nt (_,x) Nothing = Just x
+      nt (t1,x) (Just t2) | t1==t2 = Just x
+      nt _ _ = Nothing
+  in (map fc c)
 
 -- | A solver needs to be an instance of this FDSolver class in order to
 -- create an FDInstance around it.
diff --git a/Control/CP/FD/Gecode/CodegenSolver.hs b/Control/CP/FD/Gecode/CodegenSolver.hs
--- a/Control/CP/FD/Gecode/CodegenSolver.hs
+++ b/Control/CP/FD/Gecode/CodegenSolver.hs
@@ -14,6 +14,8 @@
 import Data.Map (Map)
 import Data.Maybe (isNothing)
 import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 import Control.Monad.State.Lazy
 import Control.Monad.Trans
@@ -31,9 +33,19 @@
 -- import Control.CP.FD.Expr.Util
 import Control.CP.FD.Model
 import Control.CP.FD.Gecode.Common
+import Control.CP.FD.SearchSpec.Data
 import Data.Linear
 
-import Control.CP.SearchSpec.Generator as Generator
+import Control.Search.Generator
+import Control.Search.Stat
+import Control.Search.Constraints
+import Control.Search.Combinator.And
+import Control.Search.Combinator.Base as Base
+import Control.Search.Combinator.Misc
+import Control.Search.Combinator.Print
+import Control.Search.Combinator.Until
+import Control.Search.Combinator.Once
+import Control.Search.Combinator.Or
 
 idx s c i = 
   if i<0 
@@ -71,11 +83,13 @@
   colList :: [GecodeColConst],
   colListEnt :: Map GecodeColConst Int,
   cons :: [GecodeConstraint CodegenGecodeSolver],
-  ret :: Maybe ColVar,
+  intRet :: Set IntVar,
+  boolRet :: Set BoolVar,
+  colRet :: Set ColVar,
   level :: Int,
   parent :: Maybe CodegenGecodeState,
   options :: CodegenGecodeOptions,
-  minVar :: Maybe IntVar
+  searchSpec :: Maybe (SearchSpec IntVar ColVar BoolVar)
 } deriving (Show)
 
 
@@ -102,11 +116,13 @@
   colList = [],
   colListEnt = Map.empty,
   cons = [],
-  ret = Nothing,
+  intRet = Set.empty,
+  boolRet = Set.empty,
+  colRet = Set.empty,
   level = 0,
   parent = Nothing,
   options = initOptions,
-  minVar = Nothing
+  searchSpec = Nothing
 }
 
 newIntParam :: CodegenGecodeSolver Int
@@ -251,17 +267,59 @@
 instance CompilableModel (CodegenGecodeSolver a) where
   specific_compile x = x >> return ()
 
+resolveVars :: SearchSpec ModelInt ModelCol ModelBool -> FDInstance (GecodeWrappedSolver CodegenGecodeSolver) (SearchSpec IntVar ColVar BoolVar)
+resolveVars spec = mmapSearch spec mapInt mapCol mapBool
+  where mapCol v = do
+          [GCTVar col] <- getColTerm [v] GCSVar
+          case col of
+            ColVar 0 _ -> liftFD $ liftGC $ do
+              s <- get
+              put s { colRet = Set.insert col $ colRet s }
+              return col
+            ColVar _ _ -> error "Non-toplevel array escapes"
+        mapInt v = do
+          [var] <- getIntTerm [v]
+          case var of
+            IntVar 0 r -> liftFD $ liftGC $ do
+              s <- get
+              put s { intRet = Set.insert var $ intRet s }
+              return var
+            IntVar _ _ -> error "Non-toplevel variable escapes"
+            _ -> liftFD $ liftGC $ do
+              s <- get
+              put s { intRet = Set.insert var $ intRet s }
+              return var
+        mapBool v = do
+          [var] <- getBoolTerm [v]
+          case var of
+            BoolVar 0 r -> liftFD $ liftGC $ do
+              s <- get
+              put s { boolRet = Set.insert var $ boolRet s }
+              return var
+            BoolVar _ _ -> error "Non-toplevel boolean escapes"
+            _ -> liftFD $ liftGC $ do
+              s <- get
+              put s { boolRet = Set.insert var $ boolRet s }
+              return var
+
 instance CompilableModel ((FDInstance (GecodeWrappedSolver CodegenGecodeSolver)) ModelCol) where
   specific_compile x = unliftGC $ runFD $ do
     res <- x
-    [GCTVar col] <- getColTerm [res] GCSVar
+    min <- getMinimizeVar
+    spec <- resolveVars $ PrintSol [] [res] [] $ case min of
+      Nothing -> LimitSolCount 1 $ Labelling $ LabelCol res (Term DDomSize) Minimize (Term DMedian) (\var val -> var @<= val)
+      Just m -> BranchBound m Minimize $ CombineSeq (Labelling $ LabelCol res (Term DDomSize) Minimize (Term DMedian) (\var val -> var @<= val)) (Labelling $ LabelInt m (Term DMedian) (\var val -> var @<= val))
     liftFD $ liftGC $ do
       s <- get
-      put s { ret = Just col }
-    min <- getMinimizeTerm
+      put s { searchSpec = Just spec }
+
+instance CompilableModel ((FDInstance (GecodeWrappedSolver CodegenGecodeSolver)) (SearchSpec ModelInt ModelCol ModelBool)) where
+  specific_compile x = unliftGC $ runFD $ do
+    res <- x
+    y <- resolveVars res
     liftFD $ liftGC $ do
       s <- get
-      put s { minVar = min }
+      put s { searchSpec = Just y }
 
 instance CompilableModel m => CompilableModel (ModelInt -> m) where
   specific_compile x = do
@@ -424,6 +482,9 @@
 call (CPPUnary CPPOpInd x) f = CPPMember x f True
 call x f = CPPMember x f False
 
+unvar (CPPVar s) = s
+unvar x = error $ "Unvarring " ++ show x
+
 instance Num CPPExpr where
   a + b = CPPBinary a CPPOpAdd b
   a * b = CPPBinary a CPPOpMul b
@@ -448,15 +509,29 @@
 colVarName (ColVar l n) = varName "cV" l n
 intVarName (IntVar l n) = varName "iV" l n
 
+astBoolExt state r | (Set.member r $ boolRet state)  = True
+astBoolExt _ _ = False
+astColExt state r | (Set.member r $ colRet state)  = True
+astColExt _ _ = False
+astIntExt state r | (Set.member r $ intRet state)  = True
+astIntExt _ _ = False
+
+astBoolVar :: CodegenGecodeState -> CPPExpr -> BoolVar -> CPPExpr
+astBoolVar state ctx q@(BoolVar 0 r) | (Set.member q $ boolRet state) = call ctx ("bR" ++ show r)
 astBoolVar state ctx (BoolVarCPP f) = f ctx
 astBoolVar state ctx (v@(BoolVar l _)) | (l < level state) = astBoolVar (fromJust $ parent state) ctx v
 astBoolVar state ctx b = CPPVar $ boolVarName b
+
+astIntVar :: CodegenGecodeState -> CPPExpr -> IntVar -> CPPExpr
 astIntVar state ctx (IntVarCond c t f) = CPPCond (astBoolExpr state ctx c) (Just $ astIntVar state ctx t) (astIntVar state ctx f)
 astIntVar state ctx (IntVarCPP f) = f ctx
 astIntVar state ctx (IntVarIdx c p) = CPPIndex (astColVar state ctx c) (astIntExpr state ctx p)
+astIntVar state ctx q@(IntVar 0 r) | (Set.member q $ intRet state) = call ctx ("iR" ++ show r)
 astIntVar state ctx (v@(IntVar l _)) | (l < level state) = astIntVar (fromJust $ parent state) ctx v
 astIntVar state ctx i = CPPVar $ intVarName i
-astColVar state ctx (ColVar 0 r) | (ret state == Just (ColVar 0 r)) = call ctx "ret"
+
+astColVar :: CodegenGecodeState -> CPPExpr -> ColVar -> CPPExpr
+astColVar state ctx q@(ColVar 0 r) | (Set.member q $ colRet state) = call ctx ("cR" ++ show r)
 astColVar state ctx (v@(ColVar l _)) | (l < level state) = astColVar (fromJust $ parent state) ctx v
 astColVar state ctx c = CPPVar $ (colVarName c)
 
@@ -711,14 +786,9 @@
                 ]
            else []
         ) ++
-        (case ret state of
-           Nothing -> []
-           Just c -> [(CPPProtected,astDecl "ret" (CPPTypePrim "IntVarArray"))]
-        ) ++
-        (case minVar state of
-           Nothing -> []
-           Just v -> [(CPPProtected,astDecl "cost" (CPPTypePrim "IntVar"))]
-        ),
+        ( map (\c -> (CPPPublic,astDecl (unvar $ astIntVar state astThis c) (CPPTypePrim "IntVar"))) $ Set.toList $ intRet state ) ++
+        ( map (\c -> (CPPPublic,astDecl (unvar $ astColVar state astThis c) (CPPTypePrim "IntVarArray"))) $ Set.toList $ colRet state ) ++
+        ( map (\c -> (CPPPublic,astDecl (unvar $ astBoolVar state astThis c) (CPPTypePrim "BoolVar"))) $ Set.toList $ boolRet state ),
       cppClassDefs = [
         (CPPPublic,CPPDef { 
            cppDefName="copy",
@@ -734,34 +804,14 @@
            cppDefStor=[CPPVirtual],
            cppDefArgs=[astDecl "os" $ CPPRef [] $ CPPTypePrim "ostream"],
            cppDefQual=[CPPQualConst],
-           cppDefBody = Just $ CPPSimple $ case ret state of
-             Just r -> CPPBinary (CPPBinary (CPPVar "os") CPPOpShl (call astThis "ret")) CPPOpShl (CPPVar "endl")
-             _ -> CPPBinary (CPPBinary (CPPVar "os") CPPOpShl (CPPConst $ CPPConstString "Ok")) CPPOpShl (CPPVar "endl")
-        }),
-        (CPPPublic,CPPDef {
-           cppDefName="getVar",
-           cppDefRetType=CPPTypePrim "IntVar",
-           cppDefStor=[CPPVirtual],
-           cppDefArgs=[astDecl "v" $ CPPTypePrim "int"],
-           cppDefQual=[],
-           cppDefBody = Just $ case (ret state, minVar state) of
-             (Just r, Just _) -> CPPReturn $ Just $ CPPCond (CPPBinary (CPPVar "v") CPPOpEq (CPPConst $ CPPConstInt $ -1)) (Just $ CPPVar "cost") $ CPPIndex (astColVar state astThis r) $ CPPVar "v"
-             (Just r, Nothing) -> CPPReturn $ Just $ CPPIndex (astColVar state astThis r) $ CPPVar "v"
-        }),
-        (CPPPublic,CPPDef {
-           cppDefName="getBranchVarIds",
-           cppDefRetType=CPPTypePrim "vector<int>",
-           cppDefStor=[CPPVirtual],
-           cppDefArgs=[],
-           cppDefQual=[],
-           cppDefBody = case ret state of
-              Just r -> Just $ CPPCompound [
-                 CPPBlockDecl $ astDeclFn "r" (CPPTypePrim "vector<int>") [astColSize r state astThis],
-                 CPPStatement $ CPPFor (Right $ astDeclEq "i" astTInt $ astInt 0) (Just $ CPPBinary (CPPVar "i") CPPOpLe $ astColSize r state astThis) (Just $ CPPUnary CPPOpPostInc $ CPPVar "i") $
-                   CPPSimple $ CPPAssign (CPPIndex (CPPVar "r") (CPPVar "i")) CPPAssOp $ CPPVar "i",
-                 CPPStatement $ CPPReturn $ Just $ CPPVar "r"
-               ]
-        })]++(
+--           cppDefBody = Just $ CPPSimple $ case ret state of
+--             Just r -> CPPBinary (CPPBinary (CPPVar "os") CPPOpShl (call astThis "ret")) CPPOpShl (CPPVar "endl")
+--             _ -> CPPBinary (CPPBinary (CPPVar "os") CPPOpShl (CPPConst $ CPPConstString "Ok")) CPPOpShl (CPPVar "endl")
+           cppDefBody = Just $ CPPReturn Nothing
+        })
+      ],
+{-
+        (
           case (minVar state) of
             Nothing -> []
             Just mv -> 
@@ -777,8 +827,7 @@
                     CPPStatement $ CPPSimple $ CPPCall (CPPVar "rel") [astThis,CPPVar "cost",CPPVar "IRT_LE",CPPCall (CPPMember (CPPMember (CPPVar "best") "cost" True) "val" False) []]
                   ]
               })]
-        )
-      ,
+        ) -}
       cppClassConstrs = [
         (CPPPublic, CPPConstr { cppConstrStor=[], cppConstrArgs=
           (
@@ -808,16 +857,21 @@
                 "}"
               ]
             ])++
-            (case ret state of
+{-            (case ret state of
               Nothing -> []
               Just r -> 
                 [
                   CPPComment "init of ret",
                   CPPStatement $ CPPSimple $ CPPAssign (CPPVar "ret") CPPAssOp (CPPCall (CPPVar "IntVarArray") [astThis,astColSize r state astThis])
                 ]
-            ) ++
+            ) ++  -}
             [CPPComment "begin of main post"]
-          )++pst, cppConstrInit=[]
+          )++pst, cppConstrInit=[] 
+{- (           [ (Left $ CPPVar $ boolVarName $ BoolVar (level state) j, [astThis,astInt 0,astInt 1]) | j <- Set.toList $ boolRet state ] ++
+            [ (Left $ CPPVar $ intVarName $ IntVar (level state) j, [astThis,astLowerBound,astUpperBound]) | j <- Set.toList $ intRet state ] ++
+            [ (Left $ CPPVar $ colVarName $ ColVar (level state) j, [astThis,astColSize (ColVar (level state) j) state astThis]) | j <- Set.toList $ colRet state ]
+
+          ) -}
         }),
         (CPPPublic,CPPConstr { cppConstrStor=[], cppConstrArgs=[astDecl "share" $ CPPTypePrim "bool",astDecl "s" $ CPPRef [] $ astMCPType state], cppConstrInit=
           (
@@ -832,17 +886,11 @@
                    ]
               else []
             )
-          ), cppConstrBody = Just $ CPPCompound $ 
-           (case (ret state) of
-            Nothing -> []
-            Just r -> [CPPStatement $ CPPSimple $ CPPCall (call (call astThis "ret") "update") [astThis,CPPVar "share",call (CPPVar "s") "ret"]]
---          (if (nBoolVars state > 0) then [CPPStatement $ CPPSimple $ CPPCall (call (CPPVar $ boolVarName $ BoolVar (level state) ii) "update") [astThis,CPPVar "share",CPPVar $ boolVarName $ BoolVar astBoolVar state (CPPVar "s") ii] | ii <- [0..(nBoolVars state)-1] ] else []) ++
---          (if (nIntVars state > 0) then [CPPStatement $ CPPSimple $ CPPCall (call (CPPVar $ intVarName $ IntVar (level state) ii) "update") [astThis,CPPVar "share",CPPVar $ astIntVar state (CPPVar "s") ii] | ii <- [0..(nIntVars state)-1] ] else []) ++
---          (if (length (colVars state) > 0) then [CPPStatement $ CPPSimple $ CPPCall (call (CPPVar $ colVarName $ ColVar (level state) ii) "update") [astThis,CPPVar "share",CPPVar $ astColVar state (CPPVar "s") ii] | ii <- [0..(length $ colVars state)-1] ] else [])
-           ) ++ (case (minVar state) of
-            Nothing -> []
-            Just _ -> [CPPStatement $ CPPSimple $ CPPCall (call (call astThis "cost") "update") [astThis,CPPVar "share",call (CPPVar "s") "cost"]]
-           )
+          ), cppConstrBody = Just $ CPPCompound (
+            [let vn = unvar $ astBoolVar state astThis j in CPPStatement $ CPPSimple $ CPPCall (call (call astThis vn) "update") [astThis,CPPVar "share",call (CPPVar "s") vn] | j <- Set.toList $ boolRet state] ++
+            [let vn = unvar $ astIntVar state astThis j in CPPStatement $ CPPSimple $ CPPCall (call (call astThis vn) "update") [astThis,CPPVar "share",call (CPPVar "s") vn] | j <- Set.toList $ intRet state] ++
+            [let vn = unvar $ astColVar state astThis j in CPPStatement $ CPPSimple $ CPPCall (call (call astThis vn) "update") [astThis,CPPVar "share",call (CPPVar "s") vn] | j <- Set.toList $ colRet state]
+          )
         })
       ]
     }
@@ -892,9 +940,9 @@
          ] ++ (if noTrailing $ options state then [
           CPPStatement $ CPPSimple $ CPPAssign (CPPMember (CPPVar "so") "c_d" False) CPPAssOp 1
          ] else []) ++ [
-          CPPBlockDecl $ astDeclFn "srch" (CPPTempl (case minVar state of { Nothing -> "DFS"; _ -> "BAB" }) [astMCPType state]) [CPPVar "prog",CPPVar "so"],
+--          CPPBlockDecl $ astDeclFn "srch" (CPPTempl (case minVar state of { Nothing -> "DFS"; _ -> "BAB" }) [astMCPType state]) [CPPVar "prog",CPPVar "so"],
           CPPStatement $ CPPDelete $ CPPVar "prog",
-          CPPStatement $ CPPWhile (astInt (case minVar state of { Nothing -> 0; _ -> 1 })) True $ CPPCompound [
+          CPPStatement $ CPPWhile (astInt 0) True $ CPPCompound [
             CPPBlockDecl $ astDeclEq "sol" (CPPPtr [] $ astMCPType state) $ CPPCall (call (CPPVar "srch") "next") [],
             CPPStatement $ CPPIf (CPPUnary CPPOpNeg $ CPPVar "sol") CPPBreak Nothing,
             CPPStatement $ CPPSimple $ CPPCall (call (CPPUnary CPPOpInd $ CPPVar "sol") "print") [CPPVar "std::cout"]
@@ -964,22 +1012,23 @@
       x -> error $ "Unsupported operation on constant lists: " ++ (show x)
      | pos <- [0..(length (colList state))-1] 
     ]) ++
-    (if (nBoolVars state > 0) 
-      then 
+    (
         [CPPComment "decl boolvars"]++[
-          CPPBlockDecl $ astDeclFn (boolVarName $ BoolVar (level state) j) astTBV [astThis,astInt 0,astInt 1] | j <- [0..nBoolVars state - 1] 
-        ] else []) ++
-    (if (nIntVars state > 0)
-      then
+          let glob = (Set.member (BoolVar 0 j) (boolRet state) && level state == 0) 
+              in (if glob then (\x -> CPPStatement $ CPPSimple $ CPPAssign (astBoolVar state astThis $ BoolVar (level state) j) CPPAssOp $ CPPCall (CPPVar "BoolVar") x )else (\x -> CPPBlockDecl $ astDeclFn ((\(CPPVar x) -> x) $ astBoolVar state astThis (BoolVar (level state) j)) astTBV x)) [astThis,astInt 0,astInt 1] | j <- [0..nBoolVars state - 1]
+        ]
+    ) ++
+    (
         [CPPComment "decl intvars"]++[
-          CPPBlockDecl $ astDeclFn (intVarName $ IntVar (level state) j) astTIV [astThis,astLowerBound,astUpperBound] | j <- [0..nIntVars state - 1]
-        ] else []
+          let glob = (Set.member (IntVar 0 j) (intRet state) && level state == 0) 
+              in (if glob then (\x -> CPPStatement $ CPPSimple $ CPPAssign (astIntVar state astThis $ IntVar (level state) j) CPPAssOp $ CPPCall (CPPVar "IntVar") x )else (\x -> CPPBlockDecl $ astDeclFn ((\(CPPVar x) -> x) $ astIntVar state astThis (IntVar (level state) j)) astTIV x)) [astThis,astLowerBound,astUpperBound] | j <- [0..nIntVars state - 1]
+        ]
     ) ++
-    (if (length (colVars state) > 0) 
-      then 
+    ( 
         [CPPComment "decl colvars"]++[
-          CPPBlockDecl $ astDeclFn (colVarName $ ColVar (level state) j) astTIVA [astColSize (ColVar (level state) j) state astThis] | j <- [0..(length $ colVars state)-1], not (level state == 0 && isJust (ret state) && ret state == Just (ColVar 0 j)) 
-        ] else []
+          let glob = (Set.member (ColVar 0 j) (colRet state) && level state == 0) 
+              in (if glob then (\x -> CPPStatement $ CPPSimple $ CPPAssign (astColVar state astThis $ ColVar (level state) j) CPPAssOp $ CPPCall (CPPVar "IntVarArray") x ) else (\x -> CPPBlockDecl $ astDeclFn ((\(CPPVar x) -> x) $ astColVar state astThis (ColVar (level state) j)) astTIVA x)) ((if glob then (astThis:) else id) [astColSize (ColVar (level state) j) state astThis]) | j <- [0..length (colVars state) - 1]
+        ]
     ) ++
     [CPPComment $ "init col vars"]++
     [ CPPStatement $ case x of
@@ -988,31 +1037,19 @@
          ]
         ColDefList l -> CPPCompound $ 
             (CPPComment "ColDefList") :
-            (CPPBlockDecl $ astDeclFn "b" astTIVA [astInt $ toInteger $ length l]) :
-            ([ CPPStatement $ CPPSimple $ CPPAssign (CPPIndex (CPPVar "b") (astInt $ toInteger i2)) CPPAssOp $ (astIntVar state astThis f2) | (i2,f2) <- zip [0..(length l)-1] l ] ++
-             [ CPPStatement $ CPPSimple $ CPPAssign (astColVar state astThis i) CPPAssOp (CPPVar "b") ])
-        ColDefCat a b -> if (astColVar state astThis i) == (call astThis "ret")
-          then
-            CPPCompound $ [
-              CPPComment "ColDefCat-ret",
+            [ CPPStatement $ CPPSimple $ CPPAssign (CPPIndex (astColVar state astThis i) (astInt $ toInteger i2)) CPPAssOp $ (astIntVar state astThis f2) | (i2,f2) <- zip [0..(length l)-1] l ]
+        ColDefCat a b -> CPPCompound $ [
+              CPPComment "ColDefCat",
               CPPStatement $ CPPFor (Right $ astDeclEq "i" astTInt $ astInt 0) (Just $ CPPBinary (CPPVar "i") CPPOpLe $ astColSize a state astThis) (Just $ CPPUnary CPPOpPostInc (CPPVar "i")) $ CPPSimple $ CPPAssign (CPPIndex (astColVar state astThis i) (CPPVar "i")) CPPAssOp (CPPIndex (astColVar state astThis a) (CPPVar "i")),
               CPPStatement $ CPPFor (Right $ astDeclEq "i" astTInt $ astInt 0) (Just $ CPPBinary (CPPVar "i") CPPOpLe $ astColSize b state astThis) (Just $ CPPUnary CPPOpPostInc (CPPVar "i")) $ CPPSimple $ CPPAssign (CPPIndex (astColVar state astThis i) (CPPVar "i" + astColSize a state astThis)) CPPAssOp (CPPIndex (astColVar state astThis b) (CPPVar "i"))
             ]
-          else
-            CPPCompound $ [
-              CPPComment "ColDefCat",
-              CPPBlockDecl $ astDeclFn "b" astTIVA [astColSize a state astThis + astColSize b state astThis],
-              CPPStatement $ CPPFor (Right $ astDeclEq "i" astTInt $ astInt 0) (Just $ CPPBinary (CPPVar "i") CPPOpLe $ astColSize a state astThis) (Just $ CPPUnary CPPOpPostInc (CPPVar "i")) $ CPPSimple $ CPPAssign (CPPIndex (CPPVar "b") (CPPVar "i")) CPPAssOp (CPPIndex (astColVar state astThis a) (CPPVar "i")),
-              CPPStatement $ CPPFor (Right $ astDeclEq "i" astTInt $ astInt 0) (Just $ CPPBinary (CPPVar "i") CPPOpLe $ astColSize b state astThis) (Just $ CPPUnary CPPOpPostInc (CPPVar "i")) $ CPPSimple $ CPPAssign (CPPIndex (CPPVar "b") (CPPVar "i" + astColSize a state astThis)) CPPAssOp (CPPIndex (astColVar state astThis b) (CPPVar "i")),
-              CPPStatement $ CPPSimple $ CPPAssign (astColVar state astThis i) CPPAssOp (CPPVar "b")
-            ]
   {-      ColDefTake a p l -> CPPCompound $ [
             CPPBlockDecl $ astDeclFn "b" astTIVA [astThis,astIntExpr state astThis l],
             CPPStatement $ CPPFor (Right $ astDeclEq "i" astTInt $ astInt 0) (Just $ CPPBinary (CPPVar "i") CPPOpLe $ astColSize a state astThis) (Just $ CPPUnary CPPOpPostInc (CPPVar "i")) $ CPPSimple $ CPPAssign (CPPIndex (CPPVar "b") (CPPVar "i")) CPPAssOp (CPPIndex (astColVar state astThis a) (CPPVar "i" + (astIntExpr state astThis p))),
             CPPStatement $ CPPSimple $ CPPAssign (astColVar state astThis i) CPPAssOp (CPPVar "b")
           ]-}
       | (i,x) <- zip (map (ColVar (level state)) [0..(length $ colVars state)-1]) $ colVars state ] ++
-     (case (ret state) of
+{-     (case (ret state) of
        Nothing -> []
        Just (ColVar 0 _) | level state == 0 -> []
        Just r -> 
@@ -1020,30 +1057,57 @@
            CPPComment "init ret",
            CPPStatement $ CPPFor (Right $ astDeclEq "i" astTInt $ astInt 0) (Just $ CPPBinary (CPPVar "i") CPPOpLe $ astColSize r state astThis) (Just $ CPPUnary CPPOpPostInc (CPPVar "i")) $ CPPSimple $ CPPAssign (CPPIndex (call astThis "ret") (CPPVar "i")) CPPAssOp (CPPIndex (astColVar state astThis r) (CPPVar "i"))
          ]
-     ) ++
+     ) ++ -}
      [CPPComment "constraints"]++[ CPPStatement x | x <- conss ] ++
      (if level state == 0
        then 
-         [CPPComment "branchers" ]++
-         (case minVar state of
+         [CPPComment "branchers" ]
+{-         (case minVar state of
            Nothing -> []
            Just m -> 
              [
                CPPStatement $ CPPSimple $ CPPAssign (CPPVar "cost") CPPAssOp (astIntVar state astThis m),
                CPPStatement $ CPPSimple $ CPPCall (CPPVar "branch") [astThis,call astThis "cost",CPPVar "INT_VAL_MIN"]
              ]
-         )++
-         ([CPPStatement $ CPPSimple $ CPPCall (CPPVar "branch") [astThis,call astThis "ret",CPPVar "INT_VAR_SIZE_MIN",CPPVar "INT_VAL_SPLIT_MIN"]])
-       else []
+         )++ -}
+--         ([CPPStatement $ CPPSimple $ CPPCall (CPPVar "branch") [astThis,call astThis "ret",CPPVar "INT_VAR_SIZE_MIN",CPPVar "INT_VAL_SPLIT_MIN"]])
+       else  []
      )
 
+transExprV (Term DDomSize) = domsizeV
+transExprV (Term DMedian) = medianD
+
+transExprC (Rel (Term VarRef) ERLess (Term ValRef)) = ($<)
+transExprC (Rel (Term VarRef) ERLess (Plus (Const 1) (Term ValRef))) = ($<=)
+transExprC (Rel (Term ValRef) ERLess (Term VarRef)) = ($>)
+transExprC (Rel (Plus (Const 1) (Term ValRef)) ERLess (Term VarRef)) = ($>=)
+transExprC (Rel (Term VarRef) EREqual (Term ValRef)) = ($==)
+transExprC (Rel (Term ValRef) EREqual (Term VarRef)) = ($==)
+transExprC x = error $ "transExprC doesn't support " ++ show x
+
+transDir Maximize = maxV
+transDir Minimize = minV
+
+transSearch state (Labelling (LabelInt v x f)) = Base.vlabel (unvar $ astIntVar state astThis v) (transExprV x) (transExprC $ f (Term VarRef) (Term ValRef))
+transSearch state (Labelling (LabelCol a x o d f)) = Base.label (unvar $ astColVar state astThis a) (transExprV x) (transDir o) (transExprV d) (transExprC $ f (Term VarRef) (Term ValRef))
+transSearch state (CombineSeq a b) = transSearch state a <&> transSearch state b
+transSearch state (CombinePar a b) = transSearch state a <|> transSearch state b
+transSearch state (TryOnce a) = once <@> transSearch state a
+transSearch state (LimitSolCount 1 a) = once <@> transSearch state a
+transSearch state (PrintSol _ v _ a) = prt (map (unvar . astColVar state astThis) v) <@> transSearch state a
+transSearch state (BranchBound v Minimize a) = bbmin (unvar $ astIntVar state astThis v) <@> transSearch state a
+
 generateGecode :: CompilableModel t => t -> String
 generateGecode x = 
   let ([tru,mnu],state) = run $ compile False x $ retState astGenerate
       sru = case (noGenSearch $ options state) of
         True -> ""
+        False -> search $ transSearch state $ fromJust $ searchSpec state
+{-      sru = case (noGenSearch $ options state) of
+        True -> ""
         False -> case (minVar state) of
           Nothing -> search $ prt ["branch"] <@> fs <@> Generator.label "branch" domsizeV minV medianD ($<=)
           Just _ -> search $ prt ["branch"] <@> (bbmin "cost" <@> (Generator.label "bound" lbV minV medianD ($==) <&> Generator.label "branch" domsizeV minV medianD ($<=) {- <&> Generator.label "bound" lbV minV meanD ($==) -} ))
+-}
       ret = codegen tru ++ sru ++ codegen mnu
       in ret
diff --git a/Control/CP/FD/Interface.hs b/Control/CP/FD/Interface.hs
--- a/Control/CP/FD/Interface.hs
+++ b/Control/CP/FD/Interface.hs
@@ -36,7 +36,7 @@
   Control.CP.FD.Interface.loopany,
   allin,
   asExpr, asCol, Control.CP.FD.Interface.asBool,
-  colList, labelCol,
+  colList, labelCol, 
   ModelInt, ModelCol, ModelBool,
   exists, true, false,
 --  Modelable,
@@ -54,8 +54,6 @@
 import Control.CP.EnumTerm
 
 newtype DummySolver a = DummySolver ()
-
-type MModel s = Either Model (Constraint s)
 
 instance Monad DummySolver where
   return _ = DummySolver ()
diff --git a/Control/CP/FD/SearchSpec/Data.hs b/Control/CP/FD/SearchSpec/Data.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/FD/SearchSpec/Data.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Control.CP.FD.SearchSpec.Data (
+  OptimDirection(..),
+  VarExpr(..),
+  VarStat(..),
+  Labelling(..),
+  SearchSpec(..),
+  ConstraintExpr,
+  ConstraintRefs(..),
+  mmapSearch
+) where
+
+import Control.CP.Solver
+import Control.CP.FD.FD
+import Data.Expr.Data
+import Control.Search.Generator
+import Control.Search.Language
+
+-- Wouter Swierstra - Data Types a la Carte
+-- Jacques Carette, Oleg - Finally Tagless
+
+data VarStat =
+    DLowerBound
+  | DUpperBound
+  | DDomSize
+  | DLowerRegret
+  | DUpperRegret
+  | DDegree
+  | DWDregree
+  | DRandom
+  | DMedian
+  | DDummy Int
+  deriving (Eq,Ord,Show)
+
+data OptimDirection = 
+    Maximize
+  | Minimize
+  deriving (Eq,Ord,Show)
+
+type VarExpr = Expr VarStat () ()
+
+data ConstraintRefs =
+    VarRef
+  | ValRef
+  deriving (Eq,Ord,Show)
+
+type ConstraintExpr = Expr ConstraintRefs () ()
+type ConstraintBoolExpr = BoolExpr ConstraintRefs () ()
+
+data Labelling v a b =
+    LabelInt v VarExpr (ConstraintExpr -> ConstraintExpr-> ConstraintBoolExpr)
+  | LabelCol a VarExpr OptimDirection VarExpr (ConstraintExpr -> ConstraintExpr -> ConstraintBoolExpr)
+  | LabelBool b VarExpr
+
+data SearchSpec v a b =
+    Labelling (Labelling v a b)
+  | CombineSeq (SearchSpec v a b) (SearchSpec v a b)
+  | CombinePar (SearchSpec v a b) (SearchSpec v a b)
+  | TryOnce (SearchSpec v a b)
+  | LimitSolCount Integer (SearchSpec v a b)
+  | LimitDepth Integer (SearchSpec v a b)
+  | LimitNodeCount Integer (SearchSpec v a b)
+  | LimitDiscrepancy Integer (SearchSpec v a b)
+  | BranchBound v OptimDirection (SearchSpec v a b)
+  | PrintSol [v] [a] [b] (SearchSpec v a b)
+
+deriving instance (Show v, Show a, Show b) => Show (SearchSpec v a b)
+
+instance (Show v, Show a, Show b) => Show (Labelling v a b) where
+  show (LabelInt v x f) = "LabelInt " ++ (show v) ++ " " ++ (show x) ++ " " ++ (show $ f (Term VarRef) (Term ValRef))
+  show (LabelCol v x d s f) = "LabelCol " ++ (show v) ++ " " ++ (show x) ++ " " ++ show d ++ " " ++ show s ++ " " ++ (show $ f (Term VarRef) (Term ValRef))
+  show (LabelBool v x) = "LabelBool " ++ (show v) ++ " " ++ (show x)
+
+mmapSearch :: (Monad m) => SearchSpec v1 a1 b1 -> (v1 -> m v2) -> (a1 -> m a2) -> (b1 -> m b2) -> m (SearchSpec v2 a2 b2)
+mmapSearch (Labelling (LabelInt v x f)) vf af bf = vf v >>= \y -> return $ Labelling $ LabelInt y x f
+mmapSearch (Labelling (LabelCol a x d s f)) vf af bf = af a >>= \y -> return $ Labelling $ LabelCol y x d s f
+mmapSearch (Labelling (LabelBool v x)) vf af bf = bf v >>= \y -> return $ Labelling $ LabelBool y x
+mmapSearch (CombineSeq a b) vf af bf = do
+  ad <- mmapSearch a vf af bf
+  bd <- mmapSearch b vf af bf
+  return (CombineSeq ad bd)
+mmapSearch (CombinePar a b) vf af bf = do
+  ad <- mmapSearch a vf af bf
+  bd <- mmapSearch b vf af bf
+  return (CombinePar ad bd)
+mmapSearch (TryOnce a) vf af bf = do
+  ad <- mmapSearch a vf af bf
+  return (TryOnce ad)
+mmapSearch (LimitSolCount n a) vf af bf = do
+  ad <- mmapSearch a vf af bf
+  return (LimitSolCount n ad)
+mmapSearch (LimitDepth n a) vf af bf = do
+  ad <- mmapSearch a vf af bf
+  return $ (LimitDepth n ad)
+mmapSearch (LimitNodeCount n a) vf af bf = do
+  ad <- mmapSearch a vf af bf
+  return $ (LimitNodeCount n ad)
+mmapSearch (LimitDiscrepancy n a) vf af bf = do
+  ad <- mmapSearch a vf af bf
+  return $ (LimitDiscrepancy n ad)
+mmapSearch (BranchBound v d a) vf af bf = do
+  vd <- vf v
+  ad <- mmapSearch a vf af bf
+  return (BranchBound vd d ad)
+mmapSearch (PrintSol i c b a) iF cF bF = do
+  vi <- mapM iF i
+  vc <- mapM cF c
+  vb <- mapM bF b
+  ad <- mmapSearch a iF cF bF
+  return (PrintSol vi vc vb ad)
diff --git a/Control/CP/FD/Solvers.hs b/Control/CP/FD/Solvers.hs
--- a/Control/CP/FD/Solvers.hs
+++ b/Control/CP/FD/Solvers.hs
@@ -52,6 +52,8 @@
 db = CDBST
 bb :: NewBound s -> CBranchBoundST s a
 bb = CBBST
+sb :: Int -> CSolutionBoundST s a
+sb = CSBST
 fs :: CFirstSolutionST s a
 fs = CFSST
 it :: CIdentityCST s a
diff --git a/Control/CP/SearchSpec/Generator.hs b/Control/CP/SearchSpec/Generator.hs
deleted file mode 100644
--- a/Control/CP/SearchSpec/Generator.hs
+++ /dev/null
@@ -1,1364 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE ImpredicativeTypes #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
-
-module Control.CP.SearchSpec.Generator
-  ( (<@>) , (<|>) , (<&>)
-  , def
-  , nb
-  , dbs
-  , lds
-  , fs
-  , once
-  , bbmin
-  , prt
-  , search
-  , label
-  , vlabel
-  , glabel
-  , foldVarSel
-  , ifoldVarSel
-  , until
-  , failure
-  , repeat
-  , for, foreach
-  , properLDS
-  , limit
-  , lbV
-  , ubV
-  , domsizeV      
-  , lbRegretV     
-  , ubRegretV     
-  , degreeV       
-  , wDegreeV
-  , domSizeWDegreeV
-  , domSizeDegreeV
-  , randomV       
-  , maxV
-  , minV
-  , minD
-  , maxD    
-  , meanD   
-  , medianD 
-  , randomD 
-  , ($==)
-  , ($/=)
-  , ($<) 
-  , ($<=)
-  , ($>) 
-  , ($>=)
-  , (@>)
-  , appStat
-  , depthStat
-  , nodesStat
-  , discrepancyStat
-  , solutionsStat
-  , failsStat
-  , (#>)
-  ) where
-
-import Prelude hiding (lex, until, init, repeat)
-import Control.CP.SearchSpec.Language
-import Text.PrettyPrint hiding (space)
-import List (sort, nub)
-import Data.Int
-
-{- TODO:
- - completeness
- - restart optimization
- - time limit
- - reinstate advanced variable selection
- -}
-
-import Control.Monatron.Monatron hiding (Abort, L, state)
-import Control.Monatron.Zipper hiding (i,r)
-import Control.Monatron.IdT
-
-type TreeState = Value
-type EvalState = Value
-
-data Eval m = Eval 
-                 { structs    :: ([Struct],[Struct])                        -- auxiliary type declarations
-                 , treeState_ :: [(String,Type, Info -> Statement)]        -- tree state fields (name, type, init)
-                 , evalState  :: [(String,Type,Value)]
-                 , pushLeft   :: Info -> m Statement
-                 , pushRight  :: Info -> m Statement
-		 , bodyE      :: Info -> m Statement
-                 , addE       :: Info -> m Statement
-		 , returnE    :: Info -> m Statement
-	         , failE      :: Info -> m Statement
-                 , continue   :: EvalState -> m Value
-                 , tryE       :: Info -> m Statement
-                 , tryE_      :: Info -> m Statement
-                 , intArraysE :: [String]
-                 , intVarsE   :: [String]
-                 }
-
-entry name ty up = (name, ty, \i -> up (tstate i @-> name))
-
-treeState e  =  entry "space" (Pointer SpaceType) (assign RootSpace) : treeState_ e 
-space i      =  baseTstate i @-> "space"
-
-mkCopy   i f   = (tstate i @-> f) <==   (tstate (old i) @-> f)
-mkUpdate i f g = (tstate i @-> f) <== g (tstate (old i) @-> f)
-
-
-pushLeftTop  e = \i -> pushLeft  e (i `onCommit` mkCopy   i "space"      )
-pushRightTop e = \i -> pushRight e (i `onCommit` mkUpdate i "space" Clone)
-
-mapE :: (forall x. m x -> n x) -> Eval m -> Eval n
-mapE f e =
-  Eval { structs    = structs e
-       , treeState_  = treeState_ e
-       , evalState  = evalState e
-       , pushLeft   = f . pushLeft e
-       , pushRight  = f . pushRight e
-       , bodyE      = f . bodyE e
-       , addE       = f . addE e
-       , returnE    = f . returnE e
-       , failE      = f . failE e
-       , continue   = f . continue e
-       , tryE       = f . tryE e
-       , tryE_      = f . tryE_ e
-       , intArraysE = intArraysE e
-       , intVarsE   = intVarsE e
-       }  
-
-data Info = Info { baseTstate :: TreeState
-                 , path       :: TreeState -> TreeState
-                 , abort      :: Statement
-	         , commit     :: Statement
-	         , old        :: Info
-                 , clone      :: Info -> Statement
-                 , field      :: String -> Value
-                 }
-
-type Field = String
-
-tstate i = path i (baseTstate i)
-estate i = tstate i @-> "evalState"
-
-withCommit i f   = i { commit = f (commit i) }
-onAbort  i stmt  = i { abort  = stmt >>> abort i  }
-onCommit i stmt  = i `withCommit` (stmt >>>)
-withPath i p     = i { path   = p . path i
-                     , old    = old i `withPath` p
-                     }
-withBase i str   = i { baseTstate = Var str }
-
-withClone i stmt  = i { clone = \j -> clone i j >>> stmt (i { baseTstate = baseTstate j }) }
-withField i (f,g) = i { field = \f' -> if f' == f then g i else field i f' }
-
-resetPath   i     = i { path = id
-                      , old  = resetPath $ old i }
-resetCommit i     = i { commit = Delete $ space i }
-resetClone  i     = i { clone = \j -> space j <== Clone (space i) }
-
-mkInfo name       =
-       let i = Info { baseTstate = Var name
-                    , path       = id
-                    , abort      = Delete $ space i
-                    , commit     = Delete $ space i
-                    , old        = i
-                    , clone      = \j -> space j <== Clone (space i)
-                    , field      = \f -> error ("unknown field `" ++ f ++ "'")
-                    }
-       in i
-
-info = mkInfo "estate"
-
-newinfo i = 
-       Info { baseTstate = Var "nstate"
-            , path       = id
-            , abort      = Skip
-	    , commit     = Skip
-            , old        = resetPath i
-            , clone      = \j -> space j <== Clone (space i)
-            , field      = \f -> error ("unknown field `" ++ f ++ "'")
-            }
-
---------------------------------------------------------------------------------
--- LABELING
---------------------------------------------------------------------------------
-data Label m = Label 
-	           { treeStateL   :: [(String,Type, Value -> Statement)]
-                   , leftChild_L  :: [Info -> Statement]
-                   , rightChild_L :: [Info -> Statement]
-                   , addL         :: Info -> m Statement
-                   , tryL         :: Info -> m Statement
-                   , intArraysL   :: [String]
-                   , intVarsL     :: [String]
-                   }
-
-v1Label var1 selVal rel e = 
-            Label { treeStateL  = [("val", Int,  assign 0)
-                                  ,("eq",  Bool, assign true)]
-                  , leftChild_L  = 
-                                  [ \i -> mkUpdate i "eq" (const true)
-                                  , \i -> mkCopy i "val" ]
-                  , rightChild_L =
-                                  [ \i -> mkUpdate i "eq" (const false)
-                                  , \i -> mkCopy i "val" ]
-                  , addL        = \i -> return $
-                                                 IfThenElse (eq i)
-                                                   (Post (space i) (var i `rel` val i))
-                                                   (Post (space i) (neg (var i `rel` val i)))
-                  , tryL        = \i -> returnE e (resetPath i) >>= \ret ->
-                                        tryE_ e (resetPath i)   >>= \try ->
-                                        return $ (IfThenElse (Assigned (var i))
-                                                          ret
-                                                          (val i <== (selVal $ var i) >>> try))
-                  , intArraysL  = []
-                  , intVarsL    = [var1]
-                  }
-                  where val i = tstate i @-> "val"
-                        eq  i = tstate i @-> "eq"
-                        var i = VHook (rp 0 (space i) ++ "->iv[$VAR_" ++ var1 ++ "]") 
-
-vLabel vars selVar selVal rel e = 
-            Label { treeStateL  = [("pos", Int,  assign 0)
-				  ,("val", Int,  assign 0)
-                                  ,("eq",  Bool, assign true)]
-                  , leftChild_L  = 
-                                  [ \i -> mkUpdate i "eq" (const true)
-                                  , \i -> mkCopy i "val"
-                                  , \i -> mkCopy i "pos"]
-                  , rightChild_L =
-                                  [ \i -> mkUpdate i "eq" (const false)
-                                  , \i -> mkCopy i "val"
-                                  , \i -> mkCopy i "pos"]
-                  , addL        = \i -> return $
-                                                 IfThenElse (eq i)
-                                                   (Post (space i) (var i `rel` val i))
-                                                   (Post (space i) (neg (var i `rel` val i)))
-                  , tryL        = \i -> returnE e (resetPath i) >>= \ret ->
-                                        tryE_ e (resetPath i)   >>= \try ->
-                                        return $ (selVar i vars
-                                                          ret
-                                                          (val i <== (selVal $ var i) >>> try))
-                  , intArraysL  = [vars]
-                  , intVarsL    = []
-                  }
-                  where val i = tstate i @-> "val"
-                        pos i = tstate i @-> "pos"
-                        eq  i = tstate i @-> "eq"
-                        var i = CVar vars (space i) (pos i)
-
-type ValSel = Value -> Value
-
-type VarSel = Info -> String -> Statement -> Statement -> Statement
-
-foldVarSel metric (better, zero) i vars notfound found =
-  Fold vars (tstate i) (space i) zero metric better
-  >>> IfThenElse (pos i @< 0) notfound found
-  where pos i = tstate i @-> "pos"
-
-ifoldVarSel metric (better, zero) i vars notfound found =
-  IFold vars (tstate i) (space i) zero metric better
-  >>> IfThenElse (pos i @< 0) notfound found
-  where pos i = tstate i @-> "pos"
-
-{-
-lexLabel info selVal rel e = 
-            Label { treeStateL  = [("pos", Int, 0)
-				  ,("val", Int, 0)
-                                  ,("eq",  Bool, undefined)]
-                  , leftChild_L  = [("eq", const $ true)
-                                  ,("val", \env -> env "val")
-                                  ,("pos",\env -> env "pos")]
-                  , rightChild_L = [("eq", const $ false)
-                                  ,("val", \env -> env "val")
-			          ,("pos",\env -> env "pos")]
-                  , addL        = \state -> let space = Field state "space"
-                                                var   = CVar space (Field state "pos")
-                                                val   = Field state "val"
-                                            in IfThenElse (Field state "eq")
-                                                 (Post space (var `rel` val))
-                                                 (Post space (neg (var `rel` val)))
-                  , tryL        = \state -> let val   = Field state "val"
-                                                space = Field state "space"
-                                                var   = CVar space (Field state "pos")
-                                                cmps  = [cmp | (_,(cmp,_)) <- info ]
-                                                mtxs  = [ (z,f) | (f,(_,z)) <- info ]
-                                             in MFold "estate" mtxs (lex cmps) 
-                                                >>> IfThenElse (Field state "pos" @< 0)
-                                                      (returnE e state)
-                                                      (Update val (selVal var) >>> tryE_ e state)         
-                  }
--}
-
-maxV           = (Gt,IVal minBound)
-minV           = (Lt,IVal maxBound)
-
-lbV            = MinDom
-ubV            = MaxDom 
-domsizeV       = SizeDom
-lbRegretV      = LbRegret
-ubRegretV      = UbRegret
-degreeV        = Degree
-domSizeDegreeV = \v -> domsizeV v `Div` degreeV v
-wDegreeV       = WDegree
-domSizeWDegreeV= \v -> domsizeV v `Div` wDegreeV v
-randomV        = const Random
-
-minD           = MinDom
-maxD           = MaxDom
-meanD          = \v -> (maxD v + minD v) `Div` 2
-medianD        = \v -> Median v
-randomD        = \v -> (Random `Mod` (domsizeV v)) + minD v
-
---------------------------------------------------------------------------------
--- SEARCH TRANSFORMERS
---------------------------------------------------------------------------------
-
-baseLoop label this = return $
-	    Eval { structs      = ([],[])
-                 ,  treeState_   = map (\(x,y,z) -> entry x y z) $ treeStateL label  
-                 ,  evalState   = []
-		 ,  pushLeft    = \i -> return $ commit i >>> seqs [f i | f <- leftChild_L label]  >>> Push new_tstate
-		 ,  pushRight   = \i -> return $ commit i >>> seqs [f i | f <- rightChild_L label] >>> Push new_tstate
-		 ,  bodyE       = addE this . resetPath
-                 ,  addE        = \i -> tryE this (resetPath i)   >>= \try ->
-			 	        addL label i              >>= \a   -> 
-                                        failE this (resetPath i)  >>= \fail ->
-                                        return $
-                                                   (a 
-						   >>> (Var "status" <== VHook (rp 0 (space i) ++ "->status()"))
-						   >>> IfThenElse (Var "status" @== VHook "SS_FAILED")
-                                	                 (   fail
-							 >>> Delete (space i))
-        						try) 
-	         ,  failE      = const $ return Skip
-                 ,  returnE    = \i -> return $ commit i
-                 ,  continue   = \_ -> return true
-                 ,  tryE       = tryL label
-                 ,  tryE_      = \i -> 
-                                       pushRightTop this (newinfo i)            >>= \p2 -> 
-                                       pushLeftTop this  (newinfo i)            >>= \p4 ->
-				       return (SHook "TreeState nstate;"
-                                       >>> p2
-                                       >>> p4)
-                 , intArraysE  = intArraysL label
-                 , intVarsE    = intVarsL label
-                 }
-                 where new_tstate  = Var "nstate"
-
---------------------------------------------------------------------------------
-dummyLoop super = Eval { structs    = structs super
-                       , treeState_  = treeState_ super
-                       , evalState  = evalState super
-		       , pushLeft   = pushLeft super
-		       , pushRight  = pushRight super
-                       , bodyE      = bodyE super
-                       , addE       = addE super
-	 	       , failE      = failE super
-                       , returnE    = returnE super
-                       , continue   = continue super
-                       , tryE       = tryE super
-                       , tryE_      = tryE_ super
-                       , intArraysE = intArraysE super
-                       , intVarsE   = intVarsE super
-                       }
-
-failLoop super = Eval { structs    = ([],[])
-                       , treeState_ = []
-                       , evalState  = []
-		       , pushLeft   = \_ -> return Skip
-		       , pushRight  = \_ -> return Skip
-                       , bodyE      = \i -> return $ abort i
-                       , addE       = \_ -> return Skip
-	 	       , failE      = \_ -> return Skip
-                       , returnE    = \_ -> return Skip
-                       , continue   = \_ -> return true
-                       , tryE       = \i -> return $ abort i
-                       , tryE_      = \_ -> return Skip
-                       , intArraysE = []
-                       , intVarsE   = []
-                       }
-
---------------------------------------------------------------------------------
-data SeqPos = OutS | FirstS | SecondS
-
-seqSwitch l r = 
-                do flag <- ask
-                   case flag  of 
-                     FirstS  -> l
-                     SecondS -> r
-(l1,l2) @++@ (l3,l4) = (l1 ++ l3, l2 ++ l4)
-
-seqLoop :: ReaderM SeqPos m => Int -> Eval m -> Eval m -> Eval m
-seqLoop uid lsuper rsuper =
-  Eval { structs     = structs lsuper @++@ structs rsuper @++@ mystructs 
-       , treeState_   = [entry "is_fst" Bool  (assign true)
-                       , ("seq_union",Union [(SType s3,"fst"),(SType s4,"snd")], 
-				\i -> 
-                                   let j = i `withPath` in1
-                                   in  seqs [init j | (_,init) <- fs3]
-                                       >>> initSubEvalState j s1 fs1
-                         )]
-       , evalState   = []
-       , pushLeft    = push pushLeft
-       , pushRight   = push pushRight
-       , bodyE       = \i ->
-                         let f z j = do stmt <- bodyE z (j `onAbort` dec_ref j)
-		                        cond <- continue z (estate j)
-                                        return $ IfThenElse (cont j)
-				  		    (IfThenElse cond
-						                stmt
-							        (   (cont j <== false)
-                                                                >>> dec_ref j
-                                                                >>> abort j)
-                                                    )
-						    (   dec_ref j
-						    >>> abort j)
-			 in do s1 <- local (const FirstS)  $ inSeq f i
-                               s2 <- local (const SecondS) $ inSeq f i
-                               return $ IfThenElse (is_fst i) s1 s2
-       , addE        = inSeq $ addE
-       , failE       = inSeq $ \super j -> failE super j @>>>@ return (dec_ref j)
-       , returnE     = \i -> let j1  = i `withPath` in1
-                                 j2  = i `withPath` in2 `onCommit` dec_ref j2
-                                 j2b = resetCommit j2
-                             in  seqSwitch (do action <- local (const SecondS) $
-				 	                   do stmt1 <- initTreeState_ j2b rsuper 
-                                                              stmt2 <- tryE rsuper j2b
-					                      return (dec_ref j1
-                                                                     >>> (is_fst i <== false) 
-                                                                     >>> initSubEvalState j2b s2 fs2
-                                                                     >>> stmt1 >>> stmt2)
-                                               returnE lsuper $ j1 `withCommit` const action
-                                           )
-                                           (returnE rsuper j2)
-       , continue    = \_ -> return true
-       , tryE        = inSeq $ tryE
-       , tryE_       = inSeq $ \super j -> tryE_ super j @>>>@ return (dec_ref j)
-       , intArraysE  = intArraysE lsuper ++ intArraysE rsuper
-       , intVarsE    = intVarsE lsuper ++ intVarsE rsuper
-       }
-  where mystructs = ([s1,s2],[s3,s4])
-        s1        = Struct ("LeftEvalState"  ++ show uid)  $ (Bool, "cont") : (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState lsuper]
-        s2        = Struct ("RightEvalState" ++ show uid)  $ (Bool, "cont") : (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState rsuper]
-        s3        = Struct ("LeftTreeState"  ++ show uid) $ (Pointer $ SType s1, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ lsuper]
-        s4        = Struct ("RightTreeState" ++ show uid) $ (Pointer $ SType s2, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ rsuper]
-        fs1       = [(field,init) | (field,_ty,init) <- evalState lsuper ]
-        fs2       = [(field,init) | (field,_ty,init) <- evalState rsuper ]
-        fs3       = [(field,init) | (field,_ty,init) <- treeState_ lsuper] 
-        is_fst    = \i -> tstate i @-> "is_fst"
-        cont      = \i -> estate i @=> "cont"
-        ref_count = \i -> estate i @=> "ref_count"
-        withSeq f = seqSwitch (f lsuper in1) (f rsuper in2)
-        inSeq f   = \i -> withSeq $ \super ins -> f super (i `withPath` ins)
-        dec_ref   = \j -> dec (ref_count j) >>> ifthen (ref_count j @== 0) (Delete (estate j))
-        push dir  = \i -> inSeq ( \super j -> dir super (j `onCommit` (    mkCopy i "is_fst"
-                                                                 >>> mkCopy j "evalState"
-                                                                 >>> inc (ref_count j)
-                                                                ))) i
-        initSubEvalState = \j s fs ->     (estate j <== New s)  
-				      >>> (ref_count j <== 1)
-			              >>> (cont j <== true)
-  				      >>> seqs [estate j @=> f <== init | (f,init) <- fs]	
-
-in1       = \state -> state @-> "seq_union" @-> "fst"
-in2       = \state -> state @-> "seq_union" @-> "snd"
---------------------------------------------------------------------------------
-
-cloneBase i = resetClone $ info { baseTstate = estate i @=> "parent" }
-
-orLoop :: ReaderM SeqPos m => Int -> Eval m -> Eval m -> Eval m
-orLoop uid lsuper rsuper =
-  Eval { structs     = structs lsuper @++@ structs rsuper @++@ mystructs 
-       , treeState_   = [entry "is_fst" Bool  (assign true)
-                       , ("seq_union",Union [(SType s3,"fst"),(SType s4,"snd")], 
-				\i -> 
-                                   let j = i `withPath` in1
-                                   in (estate j <== New s1)
-				       >>> (ref_count j <== 1)
-				       >>> (cont j <== true)
-                                       >>> (parent j <== baseTstate j)
-                                       >>> clone i (cloneBase j)
-                                       >>> seqs [init (j `withClone` (\k -> inc $ ref_count k)) | (f,init) <- fs3]
-                                       >>> seqs [estate j @=> f <== init | (f,init) <- fs1 ]
-                         )]
-       , evalState   = []
-       , pushLeft    = push pushLeft
-       , pushRight   = push pushRight
-       , bodyE       = \i ->
-                         let f y z = 
-                               let j = i `withPath` y
-                               in   do cond  <- continue z (estate j)
-                                       deref <- dec_ref i
-				       stmt  <- bodyE z (j `onAbort` deref)
-                                       return $ IfThenElse (cont j)
-				  		    (IfThenElse cond
-						                stmt
-							        (   (cont j <== false)
-                                                                >>> deref
-                                                                >>> abort j))
-						    (deref >>> abort j)
-			 in IfThenElse (is_fst i) @$ local (const FirstS)  (f in1 lsuper) 
-                                                  @. local (const SecondS) (f in2 rsuper)
-       , addE        = inSeq $ addE
-       , failE       = \i -> inSeq failE i @>>>@ dec_ref i
-       , returnE     = \i -> 
-			     let j1 deref = i `withPath` in1 `onCommit` deref
-                                 j2 deref = i `withPath` in2 `onCommit` deref
-                             in seqSwitch (dec_ref1 i >>= returnE lsuper . j1)
-                                          (dec_ref2 (j2 Skip) >>= returnE rsuper . j2) 
-       , continue    = \_ -> return true
-       , tryE        = inSeq $ tryE 
-       , tryE_       = \i -> inSeq tryE_ i @>>>@ dec_ref i
-       , intArraysE  = intArraysE lsuper ++ intArraysE rsuper
-       , intVarsE    = intVarsE lsuper ++ intVarsE rsuper
-       }
-  where mystructs = ([s1,s2],[s3,s4])
-        s1        = Struct ("LeftEvalState"  ++ show uid)  $ (THook "TreeState", "parent") : (Bool, "cont") : (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState lsuper]
-        fs1       = [(field,init) | (field,ty,init) <- evalState lsuper ]
-        s2        = Struct ("RightEvalState" ++ show uid) $ (Bool, "cont") : (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState rsuper]
-        fs2       = [(field,init) | (field,ty,init) <- evalState rsuper ]
-        s3        = Struct ("LeftTreeState"  ++ show uid) $ (Pointer $ SType s1, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ lsuper]
-        fs3       = [(field,init) | (field,ty,init) <- treeState_ lsuper]
-        s4        = Struct ("RightTreeState" ++ show uid) $ (Pointer $ SType s2, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ rsuper]
-        in1       = \state -> state @-> "seq_union" @-> "fst"
-        in2       = \state -> state @-> "seq_union" @-> "snd"
-        is_fst    = \i -> tstate i @-> "is_fst"
-        cont      = \i -> estate i @=> "cont"
-        ref_count = \i -> estate i @=> "ref_count"
-        parent    = \i -> estate i @=> "parent"
-        withSeq f = seqSwitch (f lsuper in1) (f rsuper in2)
-        inSeq f   = \i     -> withSeq $ \super ins -> f super (i `withPath` ins)
-        dec_ref    = \i -> seqSwitch (dec_ref1 i) (dec_ref2 $ i `withPath` in2)
-        dec_ref1   = \i ->      let j1     = i `withPath` in1
-                                    i'     = resetClone $ resetCommit $ i `withBase` ("or_tstate" ++ show uid)
-                                    j2     = i' `withPath` in2
-                                in (local (const SecondS) $
-                                    do stmt1 <- initTreeState_ j2 rsuper 
-                                       stmt2 <- tryE rsuper j2
-				       return (dec (ref_count j1) 
-                                               >>> ifthen (ref_count j1 @== 0) 
-				                        (   SHook ("TreeState or_tstate" ++ show uid ++ ";")
-							>>> (baseTstate j2 <== parent j1)
-                                                        >>> (is_fst i' <== false)
-                                                        >>> Delete (estate j1)
-                                                        >>> (estate j2 <== New s2)  
-				                        >>> (ref_count j2 <== 1)
-				                        >>> (cont j2 <== true)
-  				                        >>> seqs [estate j2 @=> f <== init | (f,init) <- fs2 ]	
-                                                        >>> stmt1 >>> stmt2)))
-        dec_ref2  = \j -> return $ dec (ref_count j) >>> ifthen (ref_count j @== 0) (Delete (estate j))
-        push dir  = \i -> seqSwitch (push1 dir i) (push2 dir i)
-        push1 dir = \i -> 
-                           let j = i `withPath` in1 
-                           in  dir lsuper (j `onCommit` (   mkCopy i "is_fst"
-                                                        >>> mkCopy j "evalState"
-                                                        >>> inc (ref_count j)
-                                                        ))
-        push2 dir = \i -> 
-                           let j = i `withPath` in2 
-                           in  dir rsuper (j `onCommit` (   mkCopy i "is_fst"
-                                                        >>> mkCopy j "evalState"
-                                                        >>> inc (ref_count j)
-                                                       ))
-
-(@>>>@) x y = do s1 <- x
-                 s2 <- y
-                 return (s1 >>> s2)
-
-f  @$ x = x >>= return . f
-mf @. x = mf >>= \f -> f @$ x
-
---------------------------------------------------------------------------------
-repeatLoop :: ReaderM Bool m => Int -> Eval m -> Eval m
-repeatLoop uid super =
-    Eval 
-       { 
-         structs     = structs super @++@ mystructs 
-       , treeState_  = ("dummy", Int, 
-				\i -> (parent i <== baseTstate i)
-                                      >>> clone i (cloneBase i)
-                       ) : treeState_ super -- `withClone` (\k -> inc $ ref_count k)
-       , evalState   = ("cont",Bool,true) : ("ref_count",Int,1) : ("parent",THook "TreeState",Null) : evalState super
-       , pushLeft    = push pushLeft
-       , pushRight   = push pushRight
-       , bodyE       = \i -> do cond  <- continue super (tstate i)
-                                deref <- dec_ref i
-			        stmt  <- bodyE super (i `onAbort` deref)
-                                return $ IfThenElse (cont i)
-				  		    (IfThenElse cond
-						                stmt
-							        (   (cont i <== false)
-                                                                >>> deref
-                                                                >>> abort i))
-						    (deref >>> abort i)
-       , addE        = addE super
-       , failE       = \i -> failE super i @>>>@ dec_ref i
-       , returnE     = \i -> let j deref = i `onCommit` deref
-                             in dec_ref i >>= returnE super . j
-       , continue    = \_ -> return true
-       , tryE        = tryE super
-       , tryE_       = \i -> tryE_ super i @>>>@ dec_ref i
-       , intArraysE  = intArraysE super
-       , intVarsE    = intVarsE super
-       }
-  where mystructs = ([],[])
-        fs1       = [(field,init) | (field,ty,init) <- evalState super]
-        cont      = \i -> estate i @=> "cont"
-        ref_count = \i -> estate i @=> "ref_count"
-        parent    = \i -> estate i @=> "parent"
-        dec_ref    = \i -> let i'     = resetCommit $ i `withBase` ("or_tstate" ++ show uid)
-                           in do flag <- ask 
-                                 if flag 
-                                   then local (const False) $ do
-				 	stmt1 <- initTreeState_ i' super 
-                                 	stmt2 <- tryE super i'
-			         	return (dec (ref_count i) 
-                                               >>> ifthen (ref_count i @== 0) 
-			                           (   SHook ("TreeState or_tstate" ++ show uid ++ ";")
-			   			   >>> (baseTstate i' <== parent i)
-						   >>> clone (cloneBase i) i'
-			                           >>> (ref_count i' <== 1)
-			                           >>> (cont i' <== true)
-  			                           >>> seqs [estate i' @=> f <== init | (f,init) <- fs1 ]	
-                                                   >>> stmt1 >>> stmt2))
-                                   else  return $dec (ref_count i) >>> ifthen (ref_count i @== 0) (Delete (space $ cloneBase i))
-        push dir  = \i -> dir super (i `onCommit` inc (ref_count i))
-
---------------------------------------------------------------------------------
-forLoop :: ReaderM Bool m => Int32 -> Int -> (Eval m,IsComplete) -> Eval m
-forLoop n uid (super,iscomplete) =
-    Eval 
-       { 
-         structs     = structs super @++@ mystructs 
-       , treeState_  = ("dummy", Int, 
-				\i -> (parent i <== baseTstate i)
-                                      >>> clone i (cloneBase i)
-                       ) : treeState_ super
-       , evalState   = ("counter",Int,0) : ("cont",Bool,true) : ("ref_count",Int,1) : ("parent",THook "TreeState",Null) : evalState super
-       , pushLeft    = push pushLeft
-       , pushRight   = push pushRight
-       , bodyE       = \i -> do cond  <- continue super (tstate i)
-                                deref <- dec_ref i
-			        stmt  <- bodyE super (i `onAbort` deref)
-                                return $ IfThenElse (cont i)
-				  		    (IfThenElse cond
-						                stmt
-							        (   (cont i <== false)
-                                                                >>> deref
-                                                                >>> abort i))
-						    (deref >>> abort i)
-       , addE        = addE super
-       , failE       = \i -> failE super i @>>>@ dec_ref i
-       , returnE     = \i -> let j deref = i `onCommit` deref
-                             in dec_ref i >>= returnE super . j
-       , continue    = \_ -> return true
-       , tryE        = \i -> tryE super (i `withField` ("counter", counter))
-       , tryE_       = \i -> tryE_ super i @>>>@ dec_ref i
-       , intArraysE  = intArraysE super
-       , intVarsE    = intVarsE super
-       }
-  where mystructs = ([],[])
-        fs1       = [(field,init) | (field,ty,init) <- evalState super]
-        cont      = \i -> estate i @=> "cont"
-        ref_count = \i -> estate i @=> "ref_count"
-        parent    = \i -> estate i @=> "parent"
-        counter   = \i -> estate i @=> "counter"
-        dec_ref    = \i -> let i'     = resetCommit $ i `withBase` ("or_tstate" ++ show uid)
-                           in do flag <- ask 
-                                 if flag 
-                                   then local (const False) $ do
-				 	stmt1 <- initTreeState_ i' super 
-                                 	stmt2 <- tryE super (i' `withField` ("counter", counter))
-			         	return (dec (ref_count i) 
-                                               >>> ifthen (ref_count i @== 0) 
-                                                     (   inc (counter i)
-                                                     >>> ifthen (counter i @< IVal n &&& Not (iscomplete i))
-				                           (   SHook ("TreeState or_tstate" ++ show uid ++ ";")
-				   			   >>> (baseTstate i' <== parent i)
-							   >>> clone (cloneBase i) i'
-				                           >>> (ref_count i' <== 1)
-				                           >>> (cont i' <== true)
-	  			                           >>> seqs [estate i' @=> f <== init | (f,init) <- fs1 ]	
-	                                                   >>> stmt1 >>> stmt2)
-						     ))
-                                   else  return $dec (ref_count i) >>> ifthen (ref_count i @== 0) (Delete (space $ cloneBase i))
-        push dir  = \i -> dir super (i `onCommit` inc (ref_count i))
-
---------------------------------------------------------------------------------
-untilLoop :: ReaderM SeqPos m => Stat -> Int -> (Eval m, IsComplete) -> (Eval m,IsComplete) -> Eval m
-untilLoop cond uid (lsuper', liscomplete) (rsuper, riscomplete) =
-  Eval { structs     = structs lsuper @++@ structs rsuper @++@ mystructs 
-       , treeState_   = [entry "is_fst" Bool (assign true)
-                       ,("seq_union", Union [(SType s3,"fst"),(SType s4,"snd")], 
-				 \i -> 
-                                   let j = i `withPath` in1
-                                   in  seqs [init j | (f,init) <- fs3]
-				       >>> initSubEvalState j s1 fs1)
-                       ]
-       , evalState   = [("until_complete",Bool,true)]
-       , pushLeft    = push pushLeft
-       , pushRight   = push pushRight
-       , bodyE       = \i ->
-                         let f y z iscomplete = 
-                               let j = i `withPath` y `onAbort` dec_ref i j iscomplete
-                               in   do stmt <- bodyE z j
-		                       cond <- continue z (estate j)
-                                       return $ IfThenElse (cont j)
-				  		    (IfThenElse cond
-						                stmt
-							        (cont j <== false >>> abort j))
-						    (abort j)
-			 in do s1 <- local (const FirstS)  $ f in1 lsuper liscomplete
-                               s2 <- local (const SecondS) $ f in2 rsuper riscomplete
-                               return $ IfThenElse (is_fst i) s1 s2
-       , addE        = inSeq $ addE
-       , failE       = \i -> inSeq' (\super j iscomplete -> failE super j @>>>@ return (dec_ref i j iscomplete)) i
-       , returnE     = \i -> inSeq' (\super j iscomplete -> returnE super (j `onCommit` dec_ref i j iscomplete)) i
-       , continue    = \_ -> return true
-       , tryE        = \i ->let j1 = i `withPath` in1
-                                j2 = i `withPath` in2 `onAbort` dec_ref i j2 riscomplete
-                            in seqSwitch (tryE lsuper j1 >>= \stmt ->
-                                          (local (const SecondS) $
-                                            do stmt1 <- initTreeState_ j2 rsuper 
-                                               stmt2 <- tryE rsuper j2
-                                               return (dec_ref i j1 liscomplete
-                                            	      >>> (is_fst i <== false) 
-						      >>> initSubEvalState j2 s2 fs2
-                                                      >>> stmt1 >>> stmt2)
-                                          ) >>= \stmt2 ->
-                                          return $ IfThenElse (readStat cond j1)
-							      stmt2
-                                                              stmt
-                                         )
-                                         (tryE rsuper j2) 
-       , tryE_       = \i -> inSeq' (\super j iscomplete -> tryE_ super j @>>>@ return (dec_ref i j iscomplete)) i
-       , intArraysE  = intArraysE lsuper ++ intArraysE rsuper
-       , intVarsE    = intVarsE lsuper ++ intVarsE rsuper
-       }
-  where mystructs = ([s1,s2],[s3,s4])
-        s1        = Struct ("LeftEvalState"  ++ show uid)  $ (Bool, "cont") : (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState lsuper]
-        fs1       = [(field,init) | (field,ty,init) <- evalState lsuper ]
-        s2        = Struct ("RightEvalState" ++ show uid) $ (Bool, "cont") : (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState rsuper]
-        fs2       = [(field,init) | (field,ty,init) <- evalState rsuper ]
-        s3        = Struct ("LeftTreeState"  ++ show uid) $ (Pointer $ SType s1, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ lsuper]
-        fs3       = [(field,init) | (field,ty,init) <- treeState_ lsuper]
-        s4        = Struct ("RightTreeState" ++ show uid) $ (Pointer $ SType s2, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ rsuper]
-        in1       = \state -> state @-> "seq_union" @-> "fst"
-        in2       = \state -> state @-> "seq_union" @-> "snd"
-        withSeq f = seqSwitch (f lsuper in1) (f rsuper in2)
-        inSeq  f  = \i -> withSeq $ \super ins -> f super (i `withPath` ins)
-        inSeq' f  = \i -> seqSwitch (f lsuper (i `withPath` in1) liscomplete)  
-                                    (f rsuper (i `withPath` in2) riscomplete)
-        dec_ref   = \i j iscomplete
-                         -> dec (ref_count j) >>> 
-                            ifthen (ref_count j @== 0) 
-                                   (Delete (estate j) >>>
-                                    (complete i <== (complete i &&& iscomplete j))
-                                   )
-        push dir  = \i -> seqSwitch (push1 dir i) (push2 dir i)
-        push1 dir = \i -> 
-                           let j = i `withPath` in1 
-                           in  dir lsuper (j `onCommit` (   mkCopy i "is_fst"
-                                                        >>> mkCopy j "evalState"
-                                                        >>> inc (ref_count j)
-                                                        ))
-        push2 dir = \i -> 
-                           let j = i `withPath` in2 
-                           in  dir rsuper (j `onCommit` (    mkCopy i "is_fst"
-                                                        >>> mkCopy j "evalState"
-                                                        >>> inc (ref_count j)
-                                                       ))
-        lsuper = evalStat cond lsuper'
-        is_fst    = \i -> tstate i @-> "is_fst"
-        cont      = \i -> estate i @=> "cont"
-        ref_count = \i -> estate i @=> "ref_count"
-        complete  = \i -> estate i @=> "until_complete"
-        initSubEvalState = \j s fs ->     (estate j <== New s)  
-				      >>> (ref_count j <== 1)
-			              >>> (cont j <== true)
-  				      >>> seqs [estate j @=> f <== init | (f,init) <- fs]	
-
---------------------------------------------------------------------------------
-ldsLoop :: Monad m => Int32 -> MkEval m
-ldsLoop limit super = return $ dummyLoop super
-                     { treeState_  = entry "lds" Int (assign $ IVal limit) : treeState_ super
-                     , evalState  = ("lds_complete", Bool, true) : evalState super
-                     , pushLeft   = \i -> pushLeft  super (i `onCommit` mkCopy i "lds")
-                     , pushRight  = \i -> pushRight super (i `onCommit` mkUpdate i "lds" (\x -> x - 1)) >>= \stmt -> 
-						return $ IfThenElse 
-							   (tstate (old i) @-> "lds" @>= 0) 
-                                                           stmt
-							   (abort i >>> (estate i @=> "lds_complete" <== false))
-                     }
-
-
---------------------------------------------------------------------------------
-dbsLoop :: Monad m => Int32 -> MkEval m
-dbsLoop limit super = return $ dummyLoop super
-                     { treeState_  = entry "depth_limit" Int (assign $ IVal limit) : treeState_ super
-                     , evalState  = ("dbs_complete", Bool, true) : evalState super
-		     , pushLeft   = push pushLeft
-                     , pushRight  = push pushRight
-                     }
-  where push dir = 
-	  \i -> dir super (i `onCommit` mkUpdate i "depth_limit" (\x -> x - 1)) >>= \stmt ->
-                return $ IfThenElse (tstate (old i) @-> "depth_limit" @>= 0)
-                                    stmt
-                                    ((estate i @=> "dbs_complete" <== false) >>> abort i)
-
---------------------------------------------------------------------------------
-nbLoop :: Monad m => Int32 -> MkEval m
-nbLoop limit super = return $ dummyLoop super
-                     { evalState  = ("nodes", Int, IVal limit)  :
-                                    ("nb_complete", Bool, true) : evalState super,
-		       bodyE      = \i -> bodyE super i >>= \r -> return $ dec (estate i @=> "nodes") >>> r,
-                       continue   = \estate -> continue super estate >>= \r -> return $ (estate @=> "nodes" @> 0) &&& r
-                     }
-
---------------------------------------------------------------------------------
-printLoop :: Monad m => [String] -> MkEval m
-printLoop arrs super = return $ dummyLoop super
-                     { returnE = \i -> returnE super $ i `onCommit` Print (space i) arrs
-                     }
-
---------------------------------------------------------------------------------
-onceLoop :: Monad m => MkEval m
-onceLoop super = return $ dummyLoop super
-                     { evalState  = ("once",Bool,true) : evalState super
-                     , returnE    = \i -> returnE super (i {commit = (estate i @=> "once" <== false) >>> commit i})
-		     , continue   = \estate -> continue super estate >>= \r -> return $ (estate @=> "once") &&& r
-                     }
-
---------------------------------------------------------------------------------
-nSolutionsLoop :: Monad m => Int32 -> MkEval m
-nSolutionsLoop limit super = return $ dummyLoop super
-                     { evalState = ("solutions", Int, IVal limit) : evalState super 
-                     , returnE   = \i -> returnE super (i `onCommit` dec (estate i @=> "solutions"))
-                     , continue = \estate ->  continue super estate >>= \r -> return $ (estate @=> "solutions" @> 0) &&& r
-                     }
-
---------------------------------------------------------------------------------
-bbLoop :: Monad m => String -> MkEval m 
-bbLoop var super = return $ dummyLoop super
-  { treeState_  = entry "tree_bound_version" Int (assign 0) : treeState_ super
-  , evalState   = ("bound_version",Int,0) : ("bound",Int,IVal maxBound) : evalState super
-  , returnE     = \i -> returnE super (i `onCommit`
-			   let get = VHook (rp 0 (space i) ++ "->getVar($VAR_" ++ var ++ ").min()")
-                           in  (Update (estate i @=> "bound") get >>> inc (estate i @=> "bound_version"))) 
-  , bodyE = \i -> let set = Post (space i) (VHook (rp 0 (space i) ++ "->getVar($VAR_" ++ var ++ ")") $< (estate i @=> "bound"))
-                              in  do r <- bodyE super i
-                                     return $ (ifthen (tstate i @-> "tree_bound_version" @< (estate i @=>"bound_version"))
-                                                      (set >>> (Update (tstate i @-> "tree_bound_version") ((tstate i @-> "tree_bound_version") + 1)))
-                                                           >>> r)
-  , pushLeft  = push pushLeft
-  , pushRight = push pushRight
-  , intVarsE  = var : intVarsE super
-  }
-  where push dir = \i -> dir super (i `onCommit` mkCopy i "tree_bound_version")
-
-
---------------------------------------------------------------------------------
--- PRINTING
---------------------------------------------------------------------------------
-
-printTreeStateType :: Monad m => Eval m -> String
-printTreeStateType e =
-  render $ pretty $ Struct "TreeState" [ (ty,name) | (name,ty,_) <- treeState e ]
-
-initEvalState :: Monad m => Eval m -> Doc
-initEvalState e =
-  vcat [pretty ty <+> text name <+> (case val of { Null -> empty ; _ -> text "=" <+> pretty val}) <> text ";" | (name,ty,val) <- evalState e]
-
-initTreeState :: Monad m => Info -> Eval m -> m Statement
-initTreeState i e =
-  return $ seqs [ init i | (_,_,init) <- treeState e]
-
-initTreeState_ :: Monad m => Info -> Eval m -> m Statement
-initTreeState_ i e =
-  return $ seqs [ init i | (_,_,init) <- treeState_ e]
-
-initIntArrays :: Eval m -> Doc
-initIntArrays eval =
-  vcat [ doc arr | arr <- nub $ sort $ intArraysE eval]
-  where doc arr = text "vector<int>" <+> text "$ARR_" <> text arr <> 
-          case arr of
-            "branch" -> empty <+> text "=" <+> text "root->getBranchVarIds()" <> semi
-            "bound" -> text "(1)" <> semi <+> text "$ARR_bound[0]=-1" <> semi
-
-initIntVars :: Eval m -> Doc
-initIntVars eval =
-  vcat [ doc var | var <- nub $ sort $ intVarsE eval]
-  where doc var = text "int" <+> text "$VAR_" <> text var <> 
-          case var of
-            "cost" -> empty <+> text "=" <+> text "-1" <> semi
-
--- initIntVars :: Eval m -> Doc 
--- initIntVars eval =
---   vcat [ doc var | var <- nub $ sort $ intVarsE eval]
---   where doc var = (text "int" <+> text "$VAR_" <> text var <> semi) $$
---                (text "vm->getintVarIndex(\"" <> text var <> text "\", " <> text "$VAR_" <> text var <> text ");")
-
-generate eval = 
-  do tell $ (++ "\n") $ render $ vcat $ [text "struct" <+> text name <> semi | Struct name _ <- fst $ structs eval]
-     tell $ (++ "\n") $ render $ vcat $ map pretty $ snd $ structs eval
-     tell $ printTreeStateType eval 
-     tell $ (++ "\n") $ render $ vcat $ map pretty $ fst $ structs eval
-     tell ("\n\nvoid eval(" ++ spacetype  ++ "* root) {\n")
-     tell $ (++ "\n") $ render $ nest 2 $ initIntVars   eval
-     tell $ (++ "\n") $ render $ nest 2 $ initIntArrays eval
-     tell "\n  Gecode::SpaceStatus status = root->status();\n"
-     tell "\n"
-     tell "  std::list<TreeState> *queue = new std::list<TreeState>();\n"
-     tell $ render (nest 2 (initEvalState eval)) ++ "\n"
-     tell "  TreeState estate;\n"
-     initTreeState info eval >>= tell . (++ "\n") . rp 2
-     tryE eval info >>= tell . (++ "\n") . rp 2
-     continue eval (estate info) >>= \c -> tell $ "  while ( !queue->empty() && (" ++ rp 0 c ++ "))  {\n"
-     tell "    /* pop first element */\n" 
-     tell "    estate = queue->front();\n"
-     tell "    queue->pop_front();\n"
-     bodyE eval info >>= tell . (++ "\n") . rp 4
-     tell "  }\n"
-     tell "}"
-
-rp n = render . nest n . pretty
-
---------------------------------------------------------------------------------
--- TESTS
---------------------------------------------------------------------------------
-testHorst = search $ prt ["q"] <@> label "q" ubV maxV minD  ($==)
-
---------------------------------------------------------------------------------
-test0 = search $ lds 3 <@> dbs 4 <@> prt ["get"] <@> label "get" ubV maxV minD  ($==)
-       
-
-t0 = putStrLn test0
-w0 f = writeFile f test0
-
---------------------------------------------------------------------------------
-test1 = search $ lds 1000 <@> (b1 <&> (b2 <&> b3 ))
-        where
-            b1 = label "getP" lbV minV meanD ($<=)
-            b2 = prt ["getQ"] <@> label "getQ" ubV maxV minD  ($==)
-            b3 = label "getP" lbV minV meanD ($<=)
-
-t1 = putStrLn test1
-w1 f = writeFile f test1
-
---------------------------------------------------------------------------------
-test2 = search $ nb 100 <@> (b1 <&> (b2 <&> b3))
-        where
-            b1 = label "get" lbV minV meanD ($<=)
-            b2 = nb 5 <@> prt ["get"] <@> label "get" ubV maxV minD  ($==)
-            b3 = label "get" lbV minV meanD ($<=)
-
-t2 = putStrLn test2
-w2 f = writeFile f test2
-
---------------------------------------------------------------------------------
-test3 = search $ nb 1000 <@> (until (appStat (@> 4) depthStat) b1 b2)
-        where
-            b1 = label "get" lbV minV minD ($==)
-            b2 = prt ["get"] <@> label "get" lbV minV maxD  ($==)
-
-
-t3 = putStrLn test3
-w3 f = writeFile f test3
-
---------------------------------------------------------------------------------
-test4 = search $ dbs 10 <@> prt ["get"] <@> label "get" lbV minV minD ($==)
-test5 = search $ until (appStat (@> 11) depthStat) (prt ["get"] <@> label "get" lbV minV minD ($==)) failure
---------------------------------------------------------------------------------
-test6 = search $ label "get" lbV minV minD ($==) <|> label "get" lbV minV minD ($==)
-
-----
-test7 = search $ (nb 10 <@> label "getP" lbV minV minD ($==)) <&> (nb 20 <@> label "getQ" lbV minV minD ($==)) 
-
---------------------------------------------------------------------------------
-test8 = search $ prt ["get"] <@> ((label "get" lbV minV minD ($==) <|> label "get" lbV minV minD ($==)) <|> label "get" lbV minV minD ($==))
-
---------------------------------------------------------------------------------
-test9 = search $ prt ["get"] <@> ((b1 <&> b2) <|> b3) 
-      where b1 = nb 2 <@> label "get" lbV minV minD ($==) 
-            b2 = label "get" lbV minV minD ($==) 
-            b3 = label "get" lbV minV minD ($==)
-
---------------------------------------------------------------------------------
-testa = search $ prt ["get"] <@> repeat (label "get" lbV minV minD ($==))
-
---------------------------------------------------------------------------------
-testb = search $ prt ["get"] <@> for 4 (label "get" lbV minV minD ($==))
-
---------------------------------------------------------------------------------
-testc = search $ prt ["get"] <@> foreach 6 (\index -> until (depthStat #> index) 
-                                                    (label "get" lbV minV minD ($==)) 
-                                              failure
-                                   )
-
---------------------------------------------------------------------------------
-testd = search $ prt ["q"] <@> properLDS 7 (label "q" lbV minV minD ($==)) 
-
--- main = putStrLn test0
-
---------------------------------------------------------------------------------
--- COMPOSITION COMBINATORS
---------------------------------------------------------------------------------
-
-def vars = label vars lbV minV minD ($==)
-
-type MkEval m = Eval m -> State Int (Eval m)
-
-fixall :: MkEval m -> Eval m
-fixall f = let this = fst $ runState 0 $ f this
-           in this
-
-data Search = forall t2. FMonadT t2 =>
-  Search { mkeval     :: forall m t1. (Monad m, FMonadT t1) => MkEval ((t1 :> t2) m)
-         , runsearch  :: forall m x. Monad m => t2 m x -> m x
-         , iscomplete :: Info -> Value
-         }
-
-type IsComplete = Info -> Value
-
-nb :: Int32 -> Search
-nb n = 
-  Search { mkeval     = nbLoop n 
-         , runsearch  = runIdT
-         , iscomplete = const true -- DUMMY VALUE
-         }
-
-bbmin :: String -> Search
-bbmin var = 
-  Search { mkeval     = bbLoop var 
-         , runsearch  = runIdT
-         , iscomplete = const true
-         }
-
-lds :: Int32 -> Search
-lds n = 
-  Search { mkeval     = ldsLoop n
-         , runsearch  = runIdT
-         , iscomplete = \i -> estate i @=> "lds_complete"
-         }
-
-properLDS 
-  :: Int32 
-  -> Search
-  -> Search
-properLDS n search = foreach n (\limit -> until (discrepancyStat #> limit)
-                                                search
-                                                failure)
-limit :: Int32 -> Stat -> Search -> Search
-limit n stat s = until (stat #> const (IVal n)) s failure
-
-once :: Search
-once = 
-  Search { mkeval     = onceLoop
-         , runsearch  = runIdT
-         , iscomplete = const true -- DUMMY VALUE
-         } 
-
-dbs :: Int32 -> Search
-dbs n = 
-  Search { mkeval     = dbsLoop n
-         , runsearch  = runIdT
-         , iscomplete = \i -> estate i @=> "dbs_complete"
-         } 
-
-prt :: [String] -> Search
-prt str = 
-  Search { mkeval     = printLoop str
-         , runsearch  = runIdT
-         , iscomplete = const true
-         }
-
-fs :: Search
-fs =
-  Search { mkeval    = nSolutionsLoop 1
-         , runsearch = runIdT
-         , iscomplete = const true
-         }
-
-failure :: Search
-failure = 
-  Search { mkeval     = return . failLoop
-         , runsearch  = runIdT
-         , iscomplete = const false
-         }
-
-(<@>)
-  :: Search -> Search -> Search
-s1 <@> s2 = 
-  case s1 of
-    Search { mkeval = evals1, runsearch = runs1, iscomplete = iscompletes1 } ->
-      case s2 of
-        Search { mkeval = evals2, runsearch = runs2, iscomplete = iscompletes2 } ->
-	  Search {mkeval =
-	          \super -> do { s2' <- evals2 $ mapE (L . L . mmap runL . runL)  super
-	                       ; s1' <- evals1 (mapE runL s2')
-	                       ; return $ mapE (L . mmap L . runL) s1'
-	                       }
-	         , runsearch  = runs2 . runs1 . runL
-	         , iscomplete = \i -> iscompletes1 i  &&& iscompletes2 i
-	         }
-
-(<&>)
-  :: Search
-  -> Search
-  -> Search
-s1 <&> s2 = 
-  case s1 of
-    Search { mkeval = evals1, runsearch = runs1, iscomplete = iscompletes1 } ->
-      case s2 of
-        Search { mkeval = evals2, runsearch = runs2, iscomplete = iscompletes2 } ->
-	  Search {mkeval =
-	          \super -> do { s2' <- evals2 $ mapE (L . L . L . mmap (mmap runL . runL) . runL)  super
-	                       ; s1' <- evals1 $ mapE (L . L . mmap (mmap runL . runL) . runL) super
-			       ; uid <- get
-			       ; put (uid + 1)
-	                       ; return $ mapE (L . mmap L . runL) $ 
-			           	seqLoop uid (mapE (L . mmap (mmap L) . runL . runL) s1')
-	                                               (mapE (L . mmap (mmap L) . runL . runL . runL) s2')
-	                       }
-	        , runsearch  = runs2 . runs1 . runL . runReaderT FirstS . runL
-	        , iscomplete = const true -- DUMMY VALUE
-	        }
-
-(<|>)
-  :: Search
-  -> Search
-  -> Search
-s1 <|> s2 = 
-  case s1 of
-    Search { mkeval = evals1, runsearch = runs1, iscomplete = iscompletes1 } ->
-      case s2 of
-        Search { mkeval = evals2, runsearch = runs2, iscomplete = iscompletes2 } ->
-	  Search {mkeval =
-	          \super -> do { s2' <- evals2 $ mapE (L . L . L . mmap (mmap runL . runL) . runL)  super
-	                       ; s1' <- evals1 $ mapE (L . L . mmap (mmap runL . runL) . runL) super
-			       ; uid <- get
-			       ; put (uid + 1)
-	                       ; return $ mapE (L . mmap L . runL) $ 
-			           	orLoop uid (mapE (L . mmap (mmap L) . runL . runL) s1')
-	                                               (mapE (L . mmap (mmap L) . runL . runL . runL) s2')
-	                       }
-	         , runsearch  = runs2 . runs1 . runL . runReaderT FirstS . runL
-	         , iscomplete = \i -> Cond (tstate i @-> "is_fst") (iscompletes1 (i `withPath` in1)) (iscompletes2 (i`withPath` in2))
-	         }
-
-mmap :: (FMonadT t, Monad m, Monad n) => (forall x. m x -> n x) -> t m a -> t n a
-mmap f x = tmap' mfunctor mfunctor id f x
-
-mfunctor :: Monad m => FunctorD m
-mfunctor = FunctorD { fmapD = \f m -> m >>= return . f }
-
-search :: Search -> String
-search s  = 
-  case s of
-    Search { mkeval = evals, runsearch = runs } ->
-      snd $ runId $ runs $runWriterT $ generate $ mapE runL $ fixall $ evals
-
-label :: String -> (Value -> Value) -> (Value -> Value -> Value, Value) -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
-label get varMeasure varComp valSel rel = 
-  Search { mkeval     = \this -> baseLoop (vLabel get (foldVarSel varMeasure varComp) valSel rel this) this 
-         , runsearch  = runIdT
-         , iscomplete = const true -- PROPER VALUE
-         }
-
-vlabel :: String -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
-vlabel get valSel rel = 
-  Search { mkeval     = \this -> baseLoop (v1Label get valSel rel this) this 
-         , runsearch  = runIdT
-         , iscomplete = const true -- PROPER VALUE
-         }
-
-ilabel :: String -> (Value -> Value) -> (Value -> Value -> Value, Value) -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
-ilabel get varMeasure varComp valSel rel = 
-  Search { mkeval     = \this -> baseLoop (vLabel get (ifoldVarSel varMeasure varComp) valSel rel this) this 
-         , runsearch  = runIdT
-         , iscomplete = const true -- PROPER VALUE
-         }
-
-glabel :: String -> VarSel -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
-glabel get varSel valSel rel = 
-  Search { mkeval     = \this -> baseLoop (vLabel get varSel valSel rel this) this 
-         , runsearch  = runIdT
-         , iscomplete = const true -- PROPER VALUE
-         }
-
-until 
-  :: Stat
-  -> Search
-  -> Search
-  -> Search
-until cond s1 s2 = 
-  case s1 of
-    Search { mkeval = evals1, runsearch = runs1, iscomplete = iscompletes1 } ->
-      case s2 of
-        Search { mkeval = evals2, runsearch = runs2, iscomplete = iscompletes2 } ->
-	  Search { mkeval =
-	          \super -> do { s2' <- evals2 $ mapE (L . L . L . mmap (mmap runL . runL) . runL)  super
-	                       ; s1' <- evals1 $ mapE (L . L . mmap (mmap runL . runL) . runL) super
-		   	       ; uid <- get
-		   	       ; put (uid + 1)
-	                       ; return $ mapE (L . mmap L . runL) $ 
-		   			untilLoop cond uid (mapE (L . mmap (mmap L) . runL . runL) s1', iscompletes1)
-	                                                      (mapE (L . mmap (mmap L) . runL . runL . runL) s2', iscompletes2)
-	                       }
-	         , runsearch  = runs2 . runs1 . runL . runReaderT FirstS . runL
-	         , iscomplete = \i -> estate i @=> "until_complete"
-	         } 
-
-repeat 
-  :: Search
-  -> Search
-repeat s = 
-  case s of
-    Search { mkeval = evals, runsearch = runs, iscomplete = iscompletes } ->
-	  Search { mkeval =
-	            \super ->
-	           do { uid <- get
-	              ; put (uid + 1)
-	              ; s' <- evals $ mapE (L . L . mmap runL . runL) super
-	              ; return $ mapE (L . mmap L . runL) $ repeatLoop uid $ mapE runL s' 
-	              }
-	         , runsearch  =  runs . runReaderT True . runL
-	         , iscomplete = const true -- PROPER VALUE (TODO: repeat only steps when the search is complete)
-	         } 
-
-for
-  :: Int32
-  -> Search
-  -> Search
-for n s  = 
-  case s of
-    Search { mkeval = evals, runsearch = runs, iscomplete = iscompletes } ->
-	  Search { mkeval =
-	           \super ->
-	           do { uid <- get
-	              ; put (uid + 1)
-	              ; s' <- evals $ mapE (L . L . mmap runL . runL) super
-	              ; return $ mapE (L . mmap L . runL) $ forLoop n uid (mapE runL s', iscompletes)
-	              }
-	         , runsearch   = runs . runReaderT True . runL
-	         , iscomplete  = iscompletes
-	         }
-
-foreach
-  :: Int32
-  -> ((Info -> Value) -> Search)
-  -> Search
-foreach n mksearch  = 
-        case mksearch (\i -> field i "counter")  of
-          Search { mkeval = eval, runsearch = run, iscomplete = cpl } ->
-           Search { mkeval = 
-                    \super ->
-                    do { uid <- get
-                       ; put (uid + 1)
-                       ; s' <- eval $ mapE (L . L . mmap runL . runL) super
-                       ; return $ mapE (L . mmap L . runL) $ forLoop n uid (mapE runL s', cpl)
-                       }
-                  , runsearch  = run . runReaderT True . runL
-                  , iscomplete = cpl
-                  }
-
--- ========================================================================== --
--- IVALUE
--- ========================================================================== --
-
-type IValue = Info -> Value
-
-instance Show (Info -> Value) where
-  show x  = "<IValue>"
-instance Eq (Info -> Value) where
-  x == y  = False
-
-instance Num (Info -> Value) where
-  x - y          = \i -> x i - y i
-  fromInteger x  = \i -> IVal (fromInteger x)
-  x + y          = \i -> x i + y i
-  x * y          = \i -> x i * y i
-  abs            = undefined
-  signum         = undefined
-
--- ========================================================================== --
--- STATS
--- ========================================================================== --
-
-data Stat = Stat (forall m. Monad m => Eval m -> Eval m) 
-                 IValue
-
-instance Show Stat where
-  show x  = "<Stat>"
-instance Eq Stat where
-  x == y  = False
-
-readStat (Stat _ r) = r
-evalStat (Stat e _) = e
-
--- -------------------------------------------------------------------------- --
-
-instance Num Stat where
-  x - y          = undefined
-  fromInteger x  = Stat dummyLoop (fromInteger x)
-  x + y          = undefined
-  x * y          = undefined
-  abs            = undefined
-  signum         = undefined
-
-appStat :: (Value -> Value) -> Stat -> Stat
-appStat f (Stat e r) = Stat e (f . r)
-
-liftStat :: (Value -> Value -> Value) -> Stat -> IValue -> Stat
-liftStat op (Stat e r) x  = Stat e (\i -> r i`op` x i)
-
-(#>) :: Stat -> IValue -> Stat
-(#>) stat x = liftStat (@>) stat x
-
--- -------------------------------------------------------------------------- --
-
-depthStat :: Stat
-depthStat = 
-  Stat (\super -> 
-               let push dir = \i -> dir super (i `onCommit` mkUpdate i "depth" (\x -> x + 1))
-	       in super
-                     { treeState_ = entry "depth" Int (assign $ 0) : treeState_ super
-		     , pushLeft   = push pushLeft
-                     , pushRight  = push pushRight
-                     })
-       (\info -> tstate info @-> "depth")
-
-discrepancyStat :: Stat
-discrepancyStat = 
-  Stat 
-    (\super -> 
-       super
-         { treeState_ = entry "discrepancy" Int (assign $ 0) : treeState_ super
-         , pushLeft   = \i -> pushLeft  super (i `onCommit` mkCopy i "discrepancy")
-         , pushRight  = \i -> pushRight super (i `onCommit` mkUpdate i "discrepancy" (\x -> x + 1))
-         })
-    (\info -> tstate info @-> "discrepancy")
-
-nodesStat :: Stat
-nodesStat = 
-  eStat ("nodes", Int, 0) $
-    \super -> super { bodyE = \i -> return (inc (estate i @=> "nodes")) @>>>@ bodyE super i }
-
-solutionsStat :: Stat
-solutionsStat = 
-  eStat ("solutions", Int, 0) $
-     \super -> super {returnE  = \i -> returnE super (i `onCommit` dec (solutions i))}
-  where solutions i = estate i @=> "solutions"
-
-failsStat :: Stat
-failsStat = 
-  eStat ("fails", Int, 0)
-    $ \super -> super { failE = \i -> returnE super i @>>>@ return (inc (fails i)) }
-  where fails i = estate i @=> "fails"
-
-eStat :: (String, Type, Value) -> (forall m. Monad m => Eval m -> Eval m) -> Stat
-eStat entry@(name,_,_) f =
-  Stat (\super -> f $ super { evalState = entry : evalState super })
-       (\i -> estate i @=> name)
diff --git a/Control/CP/SearchSpec/Language.hs b/Control/CP/SearchSpec/Language.hs
deleted file mode 100644
--- a/Control/CP/SearchSpec/Language.hs
+++ /dev/null
@@ -1,345 +0,0 @@
-module Control.CP.SearchSpec.Language  where 
-
-import Text.PrettyPrint
-import Data.Monoid
-import Data.Int
-
-spacetype = "MCPProgram"
-
-instance Monoid Statement where
-  mempty  = Skip
-  mappend = (>>>)
-
-
-class Pretty x where
-  pretty :: x -> Doc
-
-data Struct = Struct String [(Type,String)] deriving (Show, Eq)
-
-instance Pretty Struct where
-  pretty (Struct name fields) =
-    text "struct" <+> text name <+> text "{"
-    $+$ nest 2 (vcat [pretty ty <+> text f <> text ";" | (ty,f) <- fields])
-    $+$ text "};" 
-
-
-data Type = Pointer Type
-          | SpaceType
-          | Int
-          | Bool
-          | Union [(Type,String)]
-          | SType Struct
-          | THook String
-          deriving (Show, Eq)
-
-data Value = IVal Int32
-           | BVal Bool
-           | RootSpace
-           | Minus Value Value
-           | Plus Value Value
-           | Div Value Value
-           | Mod Value Value
-           | Abs Value
-           | Var String
-           | Clone Value
-           | Field String String
-           | Field' Value String
-           | PField Value String
-           | Lt Value Value
-	   | Gq Value Value
-	   | Gt Value Value
-	   | Eq Value Value
-	   | BaseContinue
-	   | And Value Value
-	   | Or  Value Value
-           | Not Value
-           | VHook String
-           | Max Value Value
-           | CVar String Value Value
-           | XVar String Value String
-           | MinDom Value
-           | MaxDom Value
-           | SizeDom Value
-           | Degree Value
-           | WDegree Value
-           | UbRegret Value
-           | LbRegret Value
-	   | Median Value
-           | Random 
-	   | Null
-	   | New Struct
-           | Base
-           | Cond Value Value Value
-           | Assigned Value
-           deriving (Show, Eq)
-
-instance Num Value where
-  (-)         = Minus
-  fromInteger = IVal . fromInteger
-  (+)    = Plus
-  (*)    = undefined
-  abs    = Abs
-  signum = undefined
-
-true  = BVal True
-false = BVal False
-(&&&) = And
-(|||) = Or
-(@>)  = Gt
-(@>=) = Gq
-(@==) = Eq
-(@->) = Field' 
-(@=>) = PField 
-(@<)  = Lt
-lex cmps l1 l2 = foldr (\(x,y,cmp) r -> (x `cmp` y) ||| ((x @== y) &&& r)) false (zip3 l1 l2 cmps)
-
-simplValue :: Value -> Value
-simplValue (Cond c t e) =
-  let c' = simplValue c
-      t' = simplValue t
-      e' = simplValue e
-  in case (c',t',e') of
-      (BVal True, _, _)  -> t'
-      (BVal False, _, _) -> e'
-      _  | t' == e'      -> t'
-      _                  -> Cond c' t' e'
-simplValue (Minus (IVal x) (IVal y)) = IVal (x - y)
-simplValue (Lt x y)  = Lt (simplValue x) (simplValue y)
-simplValue (Gq x y)  = Gq (simplValue x) (simplValue y)
-simplValue (And x y) =
-  let x' = simplValue x
-      y' = simplValue y
-  in case (x',y') of
-       (x, (BVal True))  -> x 
-       (x, (BVal False)) -> BVal False
-       _                 -> And x' y'
-simplValue (Not x)   =
-  let x' = simplValue x
-  in case x' of
-       (BVal True)   -> BVal False
-       (BVal False)  -> BVal True
-       _             -> x'
-simplValue v = v
-
-instance Pretty Type where
-  pretty (Pointer t) = pretty t <> text "*"
-  pretty SpaceType      = text spacetype
-  pretty Int         = text "int"
-  pretty Bool        = text "bool"
-  pretty (Union fields)   = 
-    text "union" <+> text "{"
-     $+$ nest 2 (vcat [pretty ty <+> text f <> text ";" | (ty,f) <- fields])
-     $+$ text "}" 
-  pretty (SType (Struct name fields))  =
-    text name
-  pretty (THook str) = 
-    text str
-
-instance Pretty Value where
-  pretty = pretty_ . simplValue
-    where
-      pretty_ (Cond c t e)   = pretty c <+> text "?" <+> pretty t <+> text ":" <+> pretty e
-      pretty_ Base           = text "<BASE>"
-      pretty_ Null           = text "NULL"
-      pretty_ (IVal i)       = int $ fromInteger $ toInteger i
-      pretty_ (BVal True)    = text "true" 
-      pretty_ (BVal False)   = text "false" 
-      pretty_ (Abs x)        = text "abs" <> parens (pretty_ x)
-      pretty_ RootSpace      = text "root"
-      pretty_ (Minus v1 v2)  = pretty_ v1 <+> text "-" <+> pretty_ v2
-      pretty_ (Plus v1 v2)   = pretty_ v1 <+> text "+" <+> pretty_ v2
-      pretty_ (Div v1 v2)    = parens (pretty_ v1) <+> text "/" <+> parens (pretty_ v2)
-      pretty_ (Mod v1 v2)    = parens (pretty_ v1) <+> text "%" <+> parens (pretty_ v2)
-      pretty_ (Var x)        = text x
-      pretty_ (Clone x)      = text ("static_cast<" ++ spacetype ++ "*>(") <> pretty_ x <> text "->clone(true))"
-      -- pretty_ (Clone x)      = text ("static_cast<" ++ spacetype ++ "*>(") <> pretty_ x <> text "->clone(false))"
-      pretty_ (Field r f)    = text r <> text "." <> text f
-      pretty_ (Field' r f)   = pretty_ r <> text "." <> text f
-      pretty_ (PField (Field' (Var _) "evalState") f)
-                             = text f
-      pretty_ (PField r f)   = pretty_ r <> text "->" <> text f
-      pretty_ (Lt x y)       = parens (pretty_ x) <+> text "<" <+> parens (pretty_ y) 
-      pretty_ (Gq x y)       = parens (pretty_ x) <+> text ">=" <+> parens (pretty_ y) 
-      pretty_ (Gt x y)       = parens (pretty_ x) <+> text ">" <+> parens (pretty_ y) 
-      pretty_ (Eq x y)       = parens (pretty_ x) <+> text "==" <+> parens (pretty_ y) 
-      pretty_ BaseContinue   = text "! queue->empty()"
-      pretty_ (And x y)      = parens (pretty x) <+> text "&&" <+> parens (pretty y) 
-      pretty_ (Or  x y)      = parens (pretty x) <+> text "||" <+> parens (pretty y) 
-      pretty_ (Not x)        = text "!" <> parens (pretty x)
-      pretty_ (VHook s)      = text s
-      pretty_ (Max x y)      = text "max" <> parens (pretty x <> text "," <> pretty y)
-      -- pretty_ (CVar vs s i)  = pretty_ s <> text "->" <> text vs <> text "()" <> brackets (pretty i)
-      pretty_ (CVar vs s i)  = pretty_ s <> text "->getVar" <> parens (text "$ARR_" <> text vs <> brackets (pretty i))
-      pretty_ (XVar vs s i)  = pretty_ s <> text "->getVar" <> parens (text "$ARR_" <> text vs <> brackets (text i))
-      pretty_ (MinDom v)     = pretty_ v <> text ".min()"
-      pretty_ (MaxDom v)     = pretty_ v <> text ".max()"
-      pretty_ (SizeDom v)    = pretty_ v <> text ".size()"
-      pretty_ (Degree v)     = pretty_ v <> text ".degree()"
-      pretty_ (WDegree v)    = pretty_ v <> text ".afc()" -- aka accumulated failure count
-      pretty_ (UbRegret v)   = pretty_ v <> text ".regret_max()"
-      pretty_ (LbRegret v)   = pretty_ v <> text ".regret_min()"
-      pretty_ (Median v)     = pretty_ v <> text ".med()"
-      pretty_ Random         = text "rand()"
-      pretty_ (New (Struct name _)) = text "new" <+> text name
-      pretty_ (Assigned var) = pretty_ var <> text ".assigned()"
-
-data Constraint = EqC Value Value
-                | NqC Value Value
-                | LtC Value Value
-                | LqC Value Value
-                | GtC Value Value
-                | GqC Value Value
-                
-
-($==) = EqC
-($/=) = NqC
-($<)  = LtC
-($<=) = LqC
-($>)  = GtC
-($>=) = GqC
-
-neg (EqC x y) = NqC x y
-neg (NqC x y) = EqC x y
-neg (LtC x y) = GqC x y
-neg (LqC x y) = GtC x y
-neg (GtC x y) = LqC x y
-neg (GqC x y) = LtC x y
-
-instance Pretty Constraint where
-  pretty (EqC x y) =
-    pretty x <> text "," <> text "IRT_EQ" <> text "," <> pretty y
-  pretty (NqC x y) =
-    pretty x <> text "," <> text "IRT_NQ" <> text "," <> pretty y
-  pretty (LtC x y) =
-    pretty x <> text "," <> text "IRT_LE" <> text "," <> pretty y
-  pretty (LqC x y) =
-    pretty x <> text "," <> text "IRT_LQ" <> text "," <> pretty y
-  pretty (GtC x y) =
-    pretty x <> text "," <> text "IRT_GR" <> text "," <> pretty y
-  pretty (GqC x y) =
-    pretty x <> text "," <> text "IRT_GQ" <> text "," <> pretty y
-
-
-data Statement = IfThenElse Value Statement Statement
-               | Push Value
-               | Skip
-               | Update Value Value
-               | Seq Statement Statement
-               | Assign Value Value
-	       | Abort
-	       | Print Value [String]
-               | SHook String
-               | Post Value Constraint
-               | Fold String Value Value Value (Value -> Value) (Value -> Value -> Value)
-               | IFold String Value Value Value (Value -> Value) (Value -> Value -> Value)
-	       | MFold String [(Value, Value->Value)] ([Value] -> [Value] -> Value)
-	       | Delete Value
-
-dec var = Update var (var - 1)
-inc var = Update var (var + 1)
-(>>>) = Seq
-(<==) = Update
-assign = flip Update
-ifthen c t = IfThenElse c t Skip
-seqs = foldr (>>>) Skip
-
-instance Pretty Statement where
-  pretty (Push tstate)      = 
-    text "queue->push_front" <> parens (pretty tstate) <> text ";"
-  pretty (IfThenElse c t e)  =
-    let c' = simplValue c
-    in case c' of 
-         BVal True  -> pretty t
-         BVal False -> pretty e
-         c          -> case e of
-                         Skip -> text "if" <+> parens (pretty c) <+> text "{" $+$ nest 2 (pretty t) $+$ text "}"
-                         _    -> text "if" <+> parens (pretty c) <+> text "{" $+$ nest 2 (pretty t) $+$ text "} else {" $+$ nest 2 (pretty e) $+$ text "}"
-  pretty Skip =
-    empty
-  pretty (Update var (Minus val 1))
-    | var == val
-    = pretty var <> text "--;"
-  pretty (Update var (Plus val 1))
-    | var == val
-    = pretty var <> text "++;"
-  pretty (Update var val)  =
-    pretty var <+> text "=" <+> pretty val <> text ";"
-  pretty (Seq s1 s2)  =
-    pretty s1 $+$ pretty s2
-  pretty (Assign x Null) = pretty x
-  pretty (Assign x y)  =
-    pretty x <+> text "=" <+> pretty y <> text ";"
-  pretty Abort =
-    text "break;"
-  pretty (Print space vs) = (vcat $ map (\s -> text ("std::cout << \"[\"; for (int i=0; i<$ARR_" ++ s ++ ".size(); i++) { std::cout << ") <> pretty (XVar s space "i") <> text " << \" \"; }; std::cout << \"] \";") vs) <> text "std::cout << std::endl;"
-  pretty (SHook s) =
-    text s
-  pretty (Post space c)  = 
-    text "rel(*" <> parens (pretty space) <> text "," <> pretty c <> text ");" 
-  pretty (Fold vars state space m0 metric better) = 
-    let
-       pos   = Field' state "pos"
-       size  = VHook $ render $ text "$ARR_" <> text vars <> text ".size()" 
-    in
-      text "int best_pos = -1;" 
-      $+$ pretty (Update pos 0)
-      $+$ text "for (int metric = " <> pretty m0 <> text "; " <> pretty (pos @< size )  <> text "; "  <> pretty pos  <>  text "++) {"
-      $+$ nest 2 (text "if" <+> parens (text "!" <> pretty (CVar vars space pos) <> text ".assigned()") <+> text "{"
-                      $+$ nest 2 ( text "int current_metric = " <> pretty (metric (CVar vars space pos)) <> text ";"
-                                   $+$ pretty (IfThenElse (Var "current_metric" `better` Var "metric")
-                                                 (Update (Var "metric") (Var "current_metric") >>> (Update (Var "best_pos") pos))
-                                                 Skip
-                                               )
-                                 )
-                      $+$ text "}"
-                 )
-      $+$ text "}" 
-      $+$ pretty (Update pos (Var "best_pos"))  
-  pretty (IFold vars state space m0 metric better) = 
-    let
-       pos   = Field' state "pos"
-       size  = VHook $ render $ text "$ARR_" <>  text vars <> text ".size()" 
-    in
-      text "int best_pos = -1;" 
-      $+$ pretty (Update pos 0)
-      $+$ text "for (int metric = " <> pretty m0 <> text "; " <> pretty (pos @< size )  <> text "; "  <> pretty pos  <>  text "++) {"
-      $+$ nest 2 (text "if" <+> parens (text "!" <> pretty (CVar vars space pos) <> text ".assigned()") <+> text "{"
-                      $+$ nest 2 ( text "int current_metric = " <> pretty (metric pos) <> text ";"
-                                   $+$ pretty (IfThenElse (Var "current_metric" `better` Var "metric")
-                                                 (Update (Var "metric") (Var "current_metric") >>> (Update (Var "best_pos") pos))
-                                                 Skip
-                                               )
-                                 )
-                      $+$ text "}"
-                 )
-      $+$ text "}" 
-      $+$ pretty (Update pos (Var "best_pos"))  
-  pretty (MFold state metrics better) = 
-    let
-       space         = Field "estate" "space"
-       pos           = Field state "pos"
-       cvar          = CVar "get" space pos
-       size          = VHook $ render $ pretty space <> text "->" <> text "get" <> text "().size()" 
-       acc_vars      = [Var $ "metric"         ++ show i | i <- [1..length metrics]]
-       cur_vars      = [Var $ "current_metric" ++ show i | i <- [1..length metrics]]
-       init_list     = hcat $ punctuate comma [pretty v <+> text "=" <+> pretty z | (v,(z,_)) <- zip acc_vars metrics]
-       computations  = vcat $ [text "int" <+> pretty (Update var (f cvar))| (var,(_,f)) <- zip cur_vars metrics]
-       updates       = foldl (>>>) Skip [Update v1 v2 | (v1,v2) <- zip acc_vars cur_vars]
-    in
-      text "int best_pos = -1;" 
-      $+$ pretty (Update pos 0)
-      $+$ text "for (int " <> init_list <> text "; " <> pretty (pos @< size )  <> text "; "  <> pretty pos  <>  text "++) {"
-      $+$ nest 2 (text "if" <+> parens (text "!" <> pretty cvar <> text ".assigned()") <+> text "{"
-                      $+$ nest 2 ( computations
-                                   $+$ pretty (IfThenElse (cur_vars `better` acc_vars)
-                                                 (updates >>> (Update (Var "best_pos") pos))
-                                                 Skip
-                                               )
-                                 )
-                      $+$ text "}"
-                 )
-      $+$ text "}" 
-      $+$ pretty (Update pos (Var "best_pos"))  
-  pretty (Delete value)  =
-    text "delete" <+> pretty value <> text ";" 
-
diff --git a/Control/Monatron/AutoInstances.hs b/Control/Monatron/AutoInstances.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/AutoInstances.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS
+  -XFlexibleInstances
+  -XOverlappingInstances
+#-}
+
+module Control.Monatron.AutoInstances where
+
+import Control.Monatron.MonadT
+
+------------------------------------------------------------------
+instance (Monad m, MonadT t) => Monad (t m) where
+    return = treturn
+    fail   = lift . fail
+    (>>=)  = tbind
+
+instance (Monad m, MonadT t) => Functor (t m) where fmap = liftM
diff --git a/Control/Monatron/AutoLift.hs b/Control/Monatron/AutoLift.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/AutoLift.hs
@@ -0,0 +1,128 @@
+{-# OPTIONS
+  -XFlexibleInstances
+  -XMultiParamTypeClasses
+  -XFunctionalDependencies
+  -XUndecidableInstances
+  -XOverlappingInstances
+#-}
+
+--  -XOverlappingInstances
+
+module Control.Monatron.AutoLift (
+ StateM(..), get,put,
+ WriterM (..), tell,
+ ReaderM(..), ask,local,
+ ExcM(..), throw,handle,
+ ContM(..), callCC,
+ ListM(..), mZero,mPlus,
+ module Control.Monatron.Operations
+) where
+
+import Control.Monatron.Operations
+import Control.Exception (SomeException)
+
+
+------------------------------------------------------------------
+-- State
+class Monad m => StateM z m | m -> z where
+    stateModel :: AlgModel (StateOp z) m
+
+instance Monad m => StateM z (StateT z m) where
+    stateModel = modelStateT
+
+instance (StateM z m, MonadT t) => StateM z (t m) where
+    stateModel = liftAlgModel stateModel
+
+get :: StateM z m => m z
+get = getX stateModel
+
+put :: StateM z m => z -> m ()
+put = putX stateModel
+
+------------------------------------------------------------------
+-- Traces
+class (Monoid z, Monad m) => WriterM z m | m -> z where
+    writerModel :: AlgModel (WriterOp z) m
+
+instance (Monoid z, Monad m) => WriterM z (WriterT z m) where
+    writerModel = modelWriterT
+
+instance (Monoid z, WriterM z m, MonadT t) => WriterM z (t m) where
+    writerModel = liftAlgModel writerModel
+
+tell :: (Monoid z, WriterM z m) => z -> m ()
+tell z = traceX writerModel z
+
+------------------------------------------------------------------
+-- Environments
+class Monad m => ReaderM z m | m -> z where
+    readerModel :: Model (ReaderOp z) m
+
+instance Monad m => ReaderM z (ReaderT z m) where
+    readerModel = modelReaderT
+
+instance (ReaderM z m, Functor m, FMonadT t) => ReaderM z (t m) where
+    readerModel = liftModel readerModel
+
+ask :: ReaderM z m => m z
+ask = askX readerModel
+
+local :: ReaderM z m => (z -> z) -> m a -> m a
+local = localX readerModel
+
+------------------------------------------------------------------
+-- Throw and Handle
+class Monad m => ExcM z m | m -> z where
+    throwModel :: AlgModel (ThrowOp z) m
+    handleModel :: Model (HandleOp z) m
+
+instance Monad m => ExcM z (ExcT z m) where
+    throwModel = modelThrowExcT
+    handleModel = modelHandleExcT
+
+instance ExcM SomeException IO where
+    throwModel  = modelThrowIO
+    handleModel = modelHandleIO
+
+instance (ExcM z m, Functor m, FMonadT t) => ExcM z (t m) where
+    throwModel = liftAlgModel throwModel
+    handleModel = liftModel handleModel
+
+throw :: ExcM z m => z -> m a
+throw = throwX throwModel
+
+handle :: ExcM z m => m a -> (z -> m a) -> m a
+handle = handleX handleModel
+
+------------------------------------------------------------------
+-- callCC operation
+
+class Monad m => ContM r m | m -> r where
+    contModel :: AlgModel (ContOp r) m
+
+instance Monad m => ContM (m r) (ContT r m) where
+    contModel = modelContT
+
+instance (ContM r m, MonadT t) => ContM r (t m) where
+    contModel = liftAlgModel contModel
+
+callCC :: ContM r m => ((a -> r) -> a) -> m a
+callCC = callCCX contModel
+
+------------------------------------------------------------------
+-- MPlus operations
+
+class Monad m => ListM m where
+    listModel :: AlgModel ListOp m
+
+instance Monad m => ListM (ListT m) where
+    listModel = modelListT
+
+instance (ListM m, MonadT t) => ListM (t m) where
+    listModel = liftAlgModel listModel
+
+mZero :: (ListM m) => m a
+mZero = zeroListX listModel
+
+mPlus :: ListM m => m a -> m a -> m a
+mPlus = plusListX listModel
diff --git a/Control/Monatron/Codensity.hs b/Control/Monatron/Codensity.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Codensity.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS -XRank2Types #-}
+
+module Control.Monatron.Codensity (
+ Codensity,
+ codensity,
+ runCodensity
+) where
+
+import Control.Monatron.MonadT
+import Control.Monad.Fix
+import Control.Monatron.AutoInstances()
+
+----------------------------------------------------------
+-- Codensity Monad
+----------------------------------------------------------
+
+newtype Codensity f a = Codensity { 
+      unCodensity :: forall b. (a -> f b) -> f b 
+}
+
+codensity :: (forall b. (a -> f b) -> f b) -> Codensity f a
+codensity = Codensity
+
+runCodensity :: Monad m => Codensity m a -> m a
+runCodensity c = unCodensity c return 
+
+instance MonadT Codensity where
+    lift m        = Codensity (m >>=)
+    c `tbind` f   = Codensity (\k -> unCodensity c (\a -> unCodensity (f a) k))
+
+-- still need to prove that MonadFix laws hold
+instance MonadFix m => MonadFix (Codensity m) where
+    mfix f = Codensity $ \k -> mfix (runCodensity. f) >>= k
+
+------------------------
+
diff --git a/Control/Monatron/IdT.hs b/Control/Monatron/IdT.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/IdT.hs
@@ -0,0 +1,13 @@
+module Control.Monatron.IdT  where 
+
+import Control.Monatron.Monatron
+
+newtype IdT m a = IdT { runIdT :: m a }
+
+instance MonadT IdT where
+    lift         = IdT
+    tbind m f    = IdT $ runIdT m >>= runIdT . f 
+    
+instance FMonadT IdT where
+    tmap' d1 _d2 g f       = IdT . f . fmapD d1 g . runIdT
+
diff --git a/Control/Monatron/Monad.hs b/Control/Monatron/Monad.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Monad.hs
@@ -0,0 +1,67 @@
+
+module Control.Monatron.Monad (
+  State, Writer, Reader, Exception, Cont,
+  state,writer,reader,exception,cont,
+  runState, runWriter, runReader, runException, runCont,
+  Id(..), Lift(..)
+) where
+  
+
+import Control.Monatron.Transformer
+import Control.Monad
+import Control.Monad.Fix
+
+newtype Id a   = Id {runId :: a}
+data    Lift a = L  {runLift :: a}
+
+type State s      = StateT s Id
+type Writer w     = WriterT w Id
+type Reader r     = ReaderT r Id
+type Exception x  = ExcT x Id
+type Cont r       = ContT r Id
+
+state :: (s -> (a, s)) -> State s a
+state st = stateT $ \s -> Id $ st s
+
+runState :: s -> State s a -> (a,s)
+runState s = runId. runStateT s
+
+writer :: Monoid w => (a,w) -> Writer w a
+writer = writerT . Id
+
+runWriter :: Monoid w => Writer w a -> (a,w)
+runWriter = runId. runWriterT
+
+reader :: (r -> a) -> Reader r a
+reader e = readerT $ \r -> Id (e r)
+
+runReader :: r -> Reader r a -> a
+runReader r = runId . runReaderT r
+
+exception :: Either x a -> Exception x a
+exception = excT . Id
+
+runException :: Exception x a -> Either x a
+runException = runId. runExcT
+
+cont :: ((a -> r) -> r) -> Cont r a
+cont c = contT $ \k -> Id $ c (runId . k)
+
+runCont :: (a -> r) -> Cont r a  -> r
+runCont k = runId. runContT (Id. k)
+
+instance Monad Id where
+    return  = Id
+    fail    = error
+    m >>= f = f (runId m)
+
+instance Monad Lift where
+  return x  = L x
+  fail x    = error x
+  L x >>= k = k x
+
+instance Functor Id   where fmap = liftM
+instance Functor Lift where fmap = liftM
+
+instance MonadFix Id   where mfix f = let m = f (runId m)   in m
+instance MonadFix Lift where mfix f = let m = f (runLift m) in m
diff --git a/Control/Monatron/MonadInfo.hs b/Control/Monatron/MonadInfo.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/MonadInfo.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE FlexibleInstances #-}
+-- {-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Control.Monatron.MonadInfo (
+  MInfo(..), MonadInfo(minfo), MonadInfoT(tminfo),
+  miInc
+) where
+
+import Control.Monatron.Monad
+import Control.Monatron.MonadT
+import Control.Monatron.IdT
+import Control.Monatron.Transformer
+import Control.Monatron.Zipper
+import Control.Monatron.Codensity
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+newtype MInfo = MInfo (Map String Int)
+  deriving (Show, Eq, Ord)
+
+miBase = MInfo Map.empty
+
+miInc s (MInfo m) = MInfo $ Map.alter (\x -> case x of { Nothing -> Just 1; Just n -> Just (n+1) }) s m
+
+undef :: a
+undef = error "MonadInfo: undefined"
+
+class Monad m => MonadInfo m where
+  minfo :: m a -> MInfo
+
+class MonadT t => MonadInfoT t where
+  tminfo :: MonadInfo m => t m a -> MInfo
+
+instance MonadInfoT (StateT s) where
+  tminfo x = miInc "StateT" (minfo $ runStateT (undef :: s) x)
+
+instance Monoid w => MonadInfoT (WriterT w) where
+  tminfo x = miInc "WriterT" (minfo $ runWriterT x)
+
+instance MonadInfoT (ReaderT s) where
+  tminfo x = miInc "ReaderT" (minfo $ runReaderT (undef :: s) x)
+
+instance MonadInfoT (ExcT x) where
+  tminfo x = miInc "ExcT" (minfo $ runExcT x)
+
+instance MonadInfoT (ContT x) where
+  tminfo x = miInc "ContT" (minfo $ runContT (undef) x)
+
+instance MonadInfoT ListT where
+  tminfo x = miInc "ListT" (minfo $ runListT x)
+
+instance Functor f => MonadInfoT (StepT f) where
+  tminfo x = miInc "StepT" (minfo $ runStepT x)
+
+instance (MonadInfoT t1, MonadInfoT t2) => MonadInfoT (t1 :> t2) where
+  tminfo x = miInc ":>" (minfo $ runZipper x)
+
+instance MonadInfoT Codensity where
+  tminfo x = miInc "Codensity" (minfo $ runCodensity x)
+
+instance MonadInfo Id where
+  minfo _ = miInc "Id"  miBase
+
+instance MonadInfo Lift where
+  minfo _ = miInc "Lift"  miBase
+
+instance MonadInfoT IdT where
+  tminfo x = miInc "IdT" (minfo $ runIdT x)
+
+instance (MonadInfo m, MonadInfoT t) => MonadInfo (t m) where
+  minfo x = tminfo x
+
diff --git a/Control/Monatron/MonadT.hs b/Control/Monatron/MonadT.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/MonadT.hs
@@ -0,0 +1,47 @@
+{-# OPTIONS -XRank2Types #-}
+
+module Control.Monatron.MonadT (
+  MonadT(..), FMonadT(..), MMonadT(..), FComp(..), FunctorD(..), tmap, mtmap,
+  module Control.Monad
+) where
+
+import Control.Monad
+
+
+----------------------------------------------------------
+-- Class of monad transformers with 
+-- a lifting of first-order operations
+----------------------------------------------------------
+
+class MonadT t where
+    lift    :: Monad m  => m a -> t m a
+    treturn :: Monad m => a -> t m a
+    treturn =  lift. return
+    tbind   :: Monad m => t m a -> (a -> t m b) -> t m b
+
+newtype FunctorD f = FunctorD {fmapD :: forall a b . (a -> b) -> f a -> f b}
+
+functor :: Functor f => FunctorD f
+functor = FunctorD fmap
+
+class MonadT t => FMonadT t where
+    tmap' :: FunctorD m -> FunctorD n -> (a -> b) -> (forall x. m x -> n x) -> t m a -> t n b
+    
+tmap :: (FMonadT t, Functor m, Functor n) => (forall b. m b -> n b) -> t m a -> t n a
+tmap = tmap' functor functor id
+
+mtmap :: FMonadT t => FunctorD f -> (a -> b) -> t f a -> t f b
+mtmap fd f = tmap' fd fd f id
+
+class FMonadT t => MMonadT t where
+    flift      :: Functor f => f a -> t f a --should coincide with lift!
+    monoidalT  :: (Functor f, Functor g) => t f (t g a) -> t (FComp f g) a 
+
+----------------------------------------
+-- Functor Composition
+----------------------------------------
+      
+newtype (FComp f g) a = Comp {deComp :: (f (g a)) }
+
+instance (Functor f, Functor g) => Functor (FComp f g) where
+    fmap f (Comp fga) = Comp (fmap (fmap f) fga)
diff --git a/Control/Monatron/Monatron.hs b/Control/Monatron/Monatron.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Monatron.hs
@@ -0,0 +1,12 @@
+
+module Control.Monatron.Monatron (
+   module Control.Monatron.Monad,
+   module Control.Monatron.AutoLift,
+   version
+)where
+
+import Control.Monatron.Monad
+import Control.Monatron.AutoLift
+
+version :: (Int,Int,Int)
+version = (0,0,1)
diff --git a/Control/Monatron/Open.hs b/Control/Monatron/Open.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Open.hs
@@ -0,0 +1,52 @@
+{-# OPTIONS -fglasgow-exts -XNoMonomorphismRestriction -XOverlappingInstances #-}
+
+module Control.Monatron.Open where
+
+import Control.Monatron.Monatron ()
+import Control.Monatron.AutoLift
+
+infixr 9 :+:
+infixr 9 <@>
+
+data (:+:) f g a = Inl (f a) | Inr (g a)
+
+newtype Fix f = In {out :: f (Fix f)}
+
+type Open e f r = (e -> r) -> (f e -> r)
+
+(<@>) :: Open e f r -> Open e g r -> Open e (f :+: g) r
+evalf <@> evalg = \eval e -> 
+  case e of
+    Inl el  -> evalf eval el
+    Inr er  -> evalg eval er       
+    
+fix :: Open (Fix f) f r -> (Fix f -> r)
+fix f =  let this = f this . out 
+         in this
+            
+-- Borrowed from Data types \`a la Carte
+
+class (f :<: g) where
+  inj :: f a -> g a
+ 
+instance Functor f => (:<:) f f where
+  inj = id
+ 
+instance  (Functor g, Functor f) 
+          => (:<:) f (f :+: g) where
+  inj = Inl
+ 
+instance  (Functor g, Functor h, Functor f, f :<: g) 
+          => (:<:) f (h :+: g) where 
+  inj = Inr . inj
+
+inject :: (f :<: g) => f (Fix g) -> Fix g
+inject = In . inj
+
+instance (Functor f, Functor g) => 
+ Functor (f :+: g) where
+  fmap f (Inl x)  = Inl (fmap f x)
+  fmap f (Inr y)  = Inr (fmap f y)
+  
+foldFix :: Functor f => (f a -> a) ->  Fix f -> a
+foldFix f = f . fmap (foldFix f) . out 
diff --git a/Control/Monatron/Operations.hs b/Control/Monatron/Operations.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Operations.hs
@@ -0,0 +1,195 @@
+{-# OPTIONS -XRank2Types #-}
+
+module Control.Monatron.Operations (
+    ExtModel, Model, AlgModel, toAlg, liftModel, liftAlgModel, liftExtModel,                         
+    StateOp(..), modelStateT, getX, putX,
+    ReaderOp(..), modelReaderT, askX, inEnvX,  localX,     
+    WriterOp(..), modelWriterT, traceX,
+    ThrowOp(..),HandleOp(..), modelThrowExcT, modelHandleExcT,
+    modelThrowIO, modelHandleIO, throwX, handleX,
+    ContOp(..), modelContT, callccX, callCCX, abortX,
+    StepOp(..), stepX, modelStepT,
+    ListOp(..), modelListT, zeroListX, plusListX,
+    module Control.Monatron.Transformer
+) where
+
+import Control.Monatron.Codensity
+import Control.Monatron.Transformer
+import qualified Control.Exception as IO (throwIO,catch,SomeException)
+
+-------------------------------------------------
+-- Models and Standard Liftings
+-------------------------------------------------
+      
+type ExtModel f g m  = forall a. f (m (g a)) -> m a
+type Model f m       = forall a. f (m a) -> m a
+type AlgModel f m    = forall a. f a -> m a
+
+toAlg       :: (Functor f, Monad m) => Model f m -> AlgModel f (Codensity m)
+toAlg op t  = codensity $ \k ->  op (fmap k t)
+
+liftModel     :: (Functor f, Monad m, Functor m, FMonadT t, Monad (t (Codensity m))) => 
+                 Model f m -> Model f (t m)
+liftModel op  = tmap runCodensity . join . lift . toAlg op . fmap (tmap lift)
+
+liftAlgModel     :: (MonadT t, Monad m, Functor f) => AlgModel f m -> AlgModel f (t m)
+liftAlgModel op  = lift . op
+
+liftExtModel     ::  (  Functor f, Functor g, Monad m, Functor m, 
+                        MMonadT t, Functor (t f), Functor (t m)) => 
+                     ExtModel f g m -> ExtModel f g (t m)
+liftExtModel op  =    tmap (op . fmap deComp . deComp) . 
+                      monoidalT . flift . fmap  (monoidalT . fmap flift) 
+      
+----------------------
+-- State Operations
+----------------------
+      
+data StateOp s a = Get (s -> a) | Put s a
+
+instance Functor (StateOp s) where
+    fmap f (Get g)    = Get (f . g)
+    fmap f (Put s a)  = Put s (f a)
+
+modelStateT            :: Monad m => AlgModel (StateOp s) (StateT s m)
+modelStateT (Get g)    = stateT (\s -> return (g s, s))
+modelStateT (Put s a)  = stateT (\_ -> return (a, s))
+
+getX     :: Monad m => AlgModel (StateOp s) m -> m s
+getX op  = op $ Get id
+
+putX       :: Monad m => AlgModel (StateOp s) m -> s -> m ()
+putX op s  = op $ Put s ()
+      
+----------------------
+-- Reader Operations
+----------------------
+      
+data ReaderOp s a = Ask (s -> a) | InEnv s a
+
+instance Functor (ReaderOp s) where
+    fmap f (Ask g)      = Ask (f . g)
+    fmap f (InEnv s a)  = InEnv s (f a)
+
+modelReaderT              :: Monad m => Model (ReaderOp s) (ReaderT s m)
+modelReaderT (Ask g)      = readerT (\s -> runReaderT s (g s))
+modelReaderT (InEnv s a)  = readerT (\_ -> runReaderT s a)
+
+askX     :: Monad m => Model (ReaderOp s) m -> m s
+askX op  = op $ Ask return
+
+inEnvX         :: Monad m => Model (ReaderOp s) m -> s -> m a -> m a
+inEnvX op s m  = op $ InEnv s m 
+      
+--derived
+
+localX :: Monad m => Model (ReaderOp z) m -> (z -> z) -> m a -> m a
+localX m f t = do z <- askX m
+                  inEnvX m (f z) t
+
+------------------------
+-- Exception Operations
+------------------------
+      
+data ThrowOp x a   = Throw x
+data HandleOp x a  = Handle a (x -> a)
+
+instance Functor (ThrowOp x) where
+    fmap _ (Throw x) = Throw x
+
+instance Functor (HandleOp x) where
+    fmap f (Handle a h) = Handle (f a) (f . h)
+
+modelThrowExcT            :: Monad m => AlgModel (ThrowOp x) (ExcT x m)
+modelThrowExcT (Throw x)  = excT (return (Left x))
+
+modelHandleExcT               :: Monad m => Model (HandleOp x) (ExcT x m)
+modelHandleExcT (Handle m h)  = excT (runExcT m >>= \exa -> case  exa of
+                                                Left x  -> runExcT (h x)
+                                                Right a -> return (Right a))
+
+modelThrowIO              :: AlgModel (ThrowOp IO.SomeException) IO
+modelThrowIO (Throw x)    = IO.throwIO x
+
+modelHandleIO               :: Model (HandleOp IO.SomeException) IO
+modelHandleIO (Handle m h)  = IO.catch m h
+
+throwX       :: Monad m => AlgModel (ThrowOp x) m -> x -> m a
+throwX op x  = op $ Throw x
+
+handleX         :: Monad m => Model(HandleOp x) m -> m a -> (x -> m a) -> m a
+handleX op m h  = op $ Handle m h
+      
+------------------------
+-- Writer Operations
+------------------------
+      
+data WriterOp w a = Trace w a
+
+instance Functor (WriterOp w) where
+    fmap f (Trace w a) = Trace w (f a)
+
+modelWriterT :: (Monad m, Monoid w) => AlgModel (WriterOp w) (WriterT w m)
+modelWriterT (Trace w a)  = writerT (return (a,w))
+
+traceX       :: (Monad m) => AlgModel (WriterOp w) m -> w -> m ()
+traceX op w  = op $ Trace w ()
+      
+--------------------------
+-- Continuation Operations
+--------------------------
+      
+data ContOp r a = Abort r | CallCC ((a -> r) -> a)
+
+instance Functor (ContOp r) where
+    fmap _ (Abort r)      = Abort r
+    fmap f (CallCC k)     = CallCC (\c -> f (k (c . f)))
+
+modelContT             :: Monad m => AlgModel (ContOp (m r)) (ContT r m)
+modelContT (Abort mr)  = contT $ \_ -> mr
+modelContT (CallCC k)  = contT $ \c -> c (k c)
+
+abortX       :: Monad m => AlgModel (ContOp r) m -> r -> m a
+abortX op r  = op (Abort r)
+
+callCCX       :: Monad m => AlgModel (ContOp r) m -> ((a -> r) -> a) -> m a
+callCCX op f  = op (CallCC f)
+
+callccX       :: Monad m => AlgModel (ContOp r) m -> ((a -> m b) -> m a) -> m a
+callccX op f  =  join $ callCCX op (\k -> f (\x -> abortX op (k (return x))))  
+      
+--------------------------
+-- Step Operations
+--------------------------
+      
+newtype StepOp f x = StepOp (f x)
+
+instance (Functor f) => Functor (StepOp f) where 
+    fmap h (StepOp fa) = StepOp (fmap h fa)
+
+modelStepT              :: (Functor f, Monad m) => Model (StepOp f) (StepT f m)
+modelStepT (StepOp fa)  = stepT (return (Right fa))
+
+stepX     :: (Monad m) => Model (StepOp f) m -> f (m x) -> m x
+stepX op  = op . StepOp 
+  
+--------------------------
+-- List Operations
+--------------------------
+      
+data ListOp a = ZeroList | PlusList a a
+
+instance Functor ListOp where
+    fmap _ ZeroList        = ZeroList
+    fmap f (PlusList a b)  = PlusList (f a) (f b)
+
+modelListT               :: Monad m => AlgModel ListOp (ListT m)
+modelListT ZeroList        = emptyL
+modelListT (PlusList t u)  = appendL (return t) (return u)
+
+zeroListX         :: Monad m => AlgModel ListOp m -> m a
+zeroListX op      = op ZeroList
+
+plusListX         :: Monad m => AlgModel ListOp m -> m a -> m a -> m a
+plusListX op t u  = join $ op (PlusList t u)
+
diff --git a/Control/Monatron/Transformer.hs b/Control/Monatron/Transformer.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Transformer.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Control.Monatron.Transformer (
+  StateT, stateT, runStateT,
+  WriterT, writerT, runWriterT,
+  ReaderT, readerT, runReaderT,
+  ExcT, excT, runExcT,
+  ContT, contT, runContT,
+  StepT, stepT, runStepT, caseStepT, unfoldStepT,
+  ListT, listT, runListT, foldListT, collectListT, emptyL, appendL,
+--  module Monatron.Operations,
+  module Control.Monatron.MonadT,
+  module Data.Monoid
+) where
+
+--import Monatron.Operations
+import Control.Monad.Fix
+import Control.Monatron.MonadT
+-- for Writer
+import Data.Monoid
+-- for Error (and Reader?)
+--import Monatron.Codensity
+import Control.Monatron.AutoInstances()
+
+--State Monad Transformer
+newtype StateT s m a = S { unS :: s -> m (a,s) }
+
+stateT ::  (s -> m (a, s)) -> StateT s m a
+stateT = S
+
+runStateT :: s -> StateT s m a -> m (a,s) 
+runStateT s m = unS m s
+
+instance MonadT (StateT s) where
+    lift  m           = S $ \s -> m >>= \a -> return (a,s)
+    m `tbind` k       = S $ \s -> unS m s >>= \ ~(a, s') -> unS (k a) s'
+
+instance (MonadFix m) => MonadFix (StateT s m) where
+  mfix f  = S $ \s -> mfix (runStateT s . f . fst)
+
+instance FMonadT (StateT s) where
+    tmap' d1 _d2 g f (S m) = S (f . fmapD d1 (\(x,s) -> (g x,s)) . m)
+
+instance MMonadT (StateT s) where
+    flift t          = S (\s -> fmap (\a -> (a,s)) t)
+    monoidalT (S t)  = S (\s -> Comp $ fmap (\(S t',s') -> t' s') (t s))
+
+{-
+-- StateT implementation of operations
+withStateT :: Monad m => Fop (With s) (StateT s m)
+withStateT (With f)  = S $ \s  -> runStateT s (f s)
+
+makeStateT :: Monad m => Fop (Make s) (StateT s m)
+makeStateT (Make (m,s)) = S $ \_ -> runStateT s m
+-}
+
+--------------------------------------------------------------
+-- Writer Monad Transformer
+
+newtype WriterT w m a = W {unW :: m (a,w) } 
+
+writerT :: (Monoid w, Monad m) => m (a,w) -> WriterT w m a
+writerT = W
+
+runWriterT :: (Monoid w) => WriterT w m a -> m (a,w)
+runWriterT = unW
+                 
+instance Monoid w => MonadT (WriterT w) where  
+    tbind (W m) f  = W (do  (a,w) <- m
+                            (a',w') <- unW (f a)
+                            return (a',w `mappend` w'))
+    lift m         = W (liftM (\a -> (a,mempty)) m)
+
+{-
+instance (MonadFix m, Monoid w) => MonadFix (WriterT w m) where
+    mfix f = W $ mfix (unW. f) 
+-}
+
+instance Monoid w => FMonadT (WriterT w) where
+    tmap' d1 _d2 g f  = W . f . fmapD d1 (\(x,s) -> (g x,s)) . unW
+
+instance Monoid w => MMonadT (WriterT w) where
+    flift t          = W (fmap (\a -> (a,mempty)) t)
+    monoidalT (W t)  = W $ Comp $  fmap (\(W t',w) -> 
+                                   fmap (\(a,w') -> (a,w `mappend` w')) t') $ t
+
+{-
+-- WriterT implementation of operations
+withWriterT :: (Monoid w, Monad m) => Fop (With w) (WriterT w m)
+withWriterT (With c)   = W $ S $ \w -> runWriterT (c w)
+
+
+makeWriterT :: (Monoid w, Monad m) => Fop (Make w) (WriterT w m)
+makeWriterT (Make (m, w)) = writerT $ runWriterT m >>= \(a,w') -> 
+                            return (a,w' `mappend` w)
+-}
+--------------------------------------------------------------
+-- Reader Monad Transformer
+newtype ReaderT s m a = R { unR :: s -> m a }
+
+runReaderT      :: s -> ReaderT s m a -> m a
+runReaderT s m  = unR m s
+
+instance MonadT (ReaderT s) where
+    tbind m k  = R (\s -> unR m s >>= \a -> unR (k a) s)
+    lift  m    = R (\_ -> m)
+
+readerT :: Monad m => (e -> m a) -> ReaderT e m a
+readerT = R
+
+{-
+instance (MonadFix m) => MonadFix (ReaderT w m) where
+    mfix f = R $ mfix (unR. f) 
+-}
+
+instance FMonadT (ReaderT s) where
+    tmap' d1 _d2 g f (R m) = R (f . fmapD d1 g . m)
+
+instance MMonadT (ReaderT s) where
+    flift t          = R (\_ -> t)
+    monoidalT (R t)  = R (\s -> Comp $ fmap (($ s) . unR) (t s))
+
+{-
+-- ReaderT implementation of operations
+makeReaderT :: Monad m => Fop (Make e) (ReaderT e m)
+makeReaderT = R . makeStateT . fmap unR
+
+withReaderT :: Monad m => Fop (With e) (ReaderT e m)
+withReaderT = R . withStateT . fmap unR
+-}
+--------------------------------------------------------------
+-- Exceptions Monad Transformer
+newtype ExcT x m a = X {unX :: m (Either x a)}
+
+excT :: Monad m => m (Either x a) -> ExcT x m a
+excT = X
+
+runExcT :: Monad m => ExcT x m a -> m (Either x a)
+runExcT = unX
+--
+instance (MonadFix m) => MonadFix (ExcT x m) where
+  mfix f  = X $ mfix (unX . f . fromRight)
+    where fromRight (Right a) = a
+          fromRight _         = error "ExceptionT: mfix looped."
+
+
+--
+instance MonadT (ExcT x) where
+    lift m           = X (liftM Right m)
+    (X m) `tbind` f  = X (do a <- m
+                             case a of
+                                Left x  -> return (Left x)
+                                Right b -> unX (f b))
+
+
+instance FMonadT (ExcT x) where
+    tmap' d1 _d2 g f  = X . f . fmapD d1 func . unX where
+      func (Left x)   = Left x
+      func (Right y)  = Right (g y)
+
+{-
+-- internal operations
+throwExcT :: Monad m => Fop (Throw x) (ExcT x m)
+throwExcT (Throw x) = X $ return (Left x)
+--
+handleExcT :: Monad m => Fop (Handle x) (ExcT x m)
+handleExcT (Handle (m, h)) = X (unX m >>= \exa ->
+                                    case exa of
+                                      Left x  -> unX (h x)
+                                      Right a -> return (Right a))
+
+-- Instances of the operations for IO exceptions
+throwIO :: Fop (Throw IO.SomeException) IO
+throwIO (Throw x) = IO.throwIO x
+--
+handleIO :: Fop (Handle IO.SomeException) IO
+handleIO (Handle (m, h)) = IO.catch m h
+-}
+
+--------------------------------------------------------------
+-- Continuations Monad Transformer
+
+newtype ContT r m a = C {unC :: (a -> m r) -> m r}
+
+runContT :: (a -> m r) -> ContT r m a -> m r
+runContT = flip unC
+
+contT ::  ((a -> m r) -> m r) -> ContT r m a
+contT = C
+
+instance MonadT (ContT r) where
+    lift m = C (m >>=)
+    m `tbind` k   = C $ \c -> unC m (\a -> unC (k a) c)
+
+{-
+callCCContT :: Monad m => Fop (CallCC (m r)) (ContT r m)
+callCCContT (CallCC f) = C $ \k -> unC (f (\a -> unC a k)) k
+
+abortContT :: Monad m => Fop (Abort (m r)) (ContT r m)
+abortContT (Abort mr) = C $ \_ -> mr
+-}
+--------------------------------------------------------------
+-- List monad transformer
+
+data LSig f a b = NilT b
+                | ConsT a (f a)
+
+newtype ListT m a = L {unL :: m (LSig (ListT m) a ())}
+
+runListT :: ListT m a -> m (LSig (ListT m) a ())
+runListT = unL
+
+listT :: m (LSig (ListT m) a ()) -> ListT m a
+listT = L
+
+emptyL :: Monad m => ListT m a
+emptyL = L $ return $ NilT ()
+
+appendL :: Monad m=> ListT m a -> ListT m a -> ListT m a
+appendL (L m1) (L m2) = L $ do
+            l <- m1
+            case l of
+              NilT ()    -> m2
+              ConsT a l1 -> return (ConsT a (appendL l1 (L m2)))
+
+foldListT :: Monad m => (a -> m b -> m b) -> m b -> ListT m a -> m b
+foldListT c n (L m) = do l <- m 
+                         case l of 
+                            NilT ()    -> n 
+                            ConsT a l1 -> c a (foldListT c n l1)
+
+collectListT :: Monad m => ListT m a -> m [a]
+collectListT lt = foldListT (\a m -> m >>= return. (a:)) (return []) lt
+
+instance MonadT ListT where
+    lift m       = L $ liftM (`ConsT` emptyL) m
+    m `tbind` f  = L $ foldListT (\a l -> unL $ f a `appendL` L l)
+                                 (return $ NilT ())
+                                 m
+
+instance FMonadT ListT where
+    tmap' d1 d2 g t (L m) = L $ t $ fmapD d1 (\lsig  -> case lsig of
+                                            NilT ()    -> NilT ()
+                                            ConsT a l  -> ConsT (g a) (tmap' d1 d2 g t l)) m
+
+{-
+mZeroListT :: Monad m => Fop MZero (ListT m)
+mZeroListT (MZero _) = emptyL 
+
+mPlusListT :: (Monad m) => Fop MPlus (ListT m)
+mPlusListT (MPlus (a, b)) = appendL a b
+-}
+------------------------------------------------
+-- Step Monad Transformer
+------------------------------------------------
+      
+newtype StepT f m x = T {runT :: m (Either x (f (StepT f m x)))}
+
+stepT :: m (Either x (f (StepT f m x))) -> StepT f m x
+stepT = T
+
+runStepT :: StepT f m x ->  m (Either x (f (StepT f m x)))
+runStepT = runT
+
+{-
+instance (Functor f, Monad m) => Monad (StepT f m) where
+    return  = treturn
+    (>>=)   = tbind
+-}
+
+--instance (Functor f, Monad m) => Functor (StepT f m) where fmap = liftM
+
+caseStepT            ::  (Functor f, Monad m) =>  
+                         (a -> StepT f m x) -> (f (StepT f m a) -> StepT f m x)
+                         -> StepT f m a -> StepT f m x
+caseStepT v c (T m)  = T (m >>= either (runT . v) (runT . c))
+
+unfoldStepT      :: (Functor f, Monad m) => (y -> m (Either x (f y))) -> y -> StepT f m x
+unfoldStepT k y  = T (liftM (fmap (fmap (unfoldStepT k))) (k y))
+
+instance (Functor f) => MonadT (StepT f) where
+    tbind t f  = caseStepT f (T . return . Right . fmap (`tbind` f)) t
+    lift       = T . liftM Left
+
+instance (Functor f) => FMonadT (StepT f) where
+    tmap' d1 d2 g t (T m) = T (t (fmapD d1 (either (Left . g) (Right . fmap (tmap' d1 d2 g t))) m))
diff --git a/Control/Monatron/Zipper.hs b/Control/Monatron/Zipper.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Zipper.hs
@@ -0,0 +1,118 @@
+{-# OPTIONS -fglasgow-exts -XNoMonomorphismRestriction #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Control.Monatron.Zipper where
+
+import Control.Monatron.MonadT ()
+import Control.Monatron.IdT ()
+import Control.Monatron.AutoLift 
+import Control.Monatron.Operations
+import Control.Monatron.Monad ()
+-- import Monatron.AutoInstances()
+
+newtype (t1 :> (t2 :: (* -> *) -> * -> *)) m a = L { runL :: t1 (t2 m) a }
+
+runZipper :: (t1 :> t2) m a -> t1 (t2 m) a
+runZipper = runL
+
+zipper :: t1 (t2 m) a -> (t1 :> t2) m a 
+zipper = L
+
+-- * Relative Navigation
+
+-- | shift focus to left
+leftL  :: (t1 :> t2) m a -> t1 (t2 m) a
+leftL   = runL
+
+-- | shift focus to right
+rightL :: t1 (t2 m) a -> (t1 :> t2) m  a
+rightL  =  L 
+
+-- The zipper is an FMonadT and a MonadT
+
+instance (FMonadT t1, FMonadT t2) => FMonadT (t1 :> t2) where
+     tmap' d1 d2 g f       = 
+       L . tmap' (FunctorD (mtmap d1)) (FunctorD (mtmap d2)) g (tmap' d1 d2 id f) . runL
+
+instance (MonadT t1, MonadT t2) => MonadT (t1 :> t2) where
+     lift         = L . lift . lift
+     tbind m f    = L $ runL m >>= runL . f
+     
+-- Instances of the zipper for the various effects
+     
+instance (Monad m, MonadT t1, MonadT t2, StateM z (t2 m)) => StateM z ((t1 :> t2) m) where
+     stateModel = L . liftAlgModel stateModel
+     
+instance (WriterM z (t2 m), MonadT t1, Monad m, MonadT t2) => WriterM z ((t1 :> t2) m) where
+     writerModel  = L . liftAlgModel writerModel
+
+instance (ReaderM z (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ReaderM z ((t1 :> t2) m) where     
+      readerModel  = L . liftModel readerModel . fmap runL 
+      
+instance (ExcM z (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ExcM z ((t1 :> t2) m) where
+    throwModel  = L . liftAlgModel throwModel
+    handleModel = L . liftModel handleModel . fmap runL 
+    
+instance (ContM r (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ContM r ((t1 :> t2) m) where
+    contModel = L . liftAlgModel contModel
+    
+instance (ListM (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ListM ((t1 :> t2) m) where
+    listModel = L . liftAlgModel listModel
+    
+-- runtest :: (((),Int),Int)
+-- runtest = runState 0 $ runStateT 0 $ runZipper (put 3)
+
+-- Views and masks; could be in a different file
+    
+data (:><:) m n = View {
+  to    :: forall a . m a -> n a,
+  from  :: forall a . n a -> m a
+}
+
+i :: m :><: m
+i = View id id
+
+o :: (Monad m, MonadT t1, MonadT t2) => t1 (t2 m) :><: (t1 :> t2) m
+o = View rightL leftL
+
+vlift  :: (FMonadT t, Functor m, Functor n) 
+       => (m :><: n) -> (t m :><: t n)
+vlift v  = View (tmap (to v)) (tmap (from v))
+
+
+hcomp :: (n :><: o) -> (m :><: n) -> (m :><: o)
+v2 `hcomp` v1  =  View  (to v2 . to v1) (from v1 . from v2)
+
+vcomp  :: (Functor m1, Functor m2, FMonadT t) 
+       => (t m2 :><: m3) -> (m1 :><: m2) -> (t m1 :><: m3)
+v2 `vcomp` v1  = v2 `hcomp` (vlift v1)
+
+-- program :: StateM Int m => m Int
+-- program = put 3 >> return 4
+
+-- t = runState 1 $ runStateT 0 $ runIdT $ runIdT $ view i program
+
+r :: Monad m => StateT s m :><: ReaderT s m
+r  = View  {
+  to    = \s -> readerT (\e -> liftM fst $ runStateT e s),
+  from  = \e -> stateT (\s ->  liftM (\x -> (x,s)) $ runReaderT s e)
+}
+
+stateIso  :: Monad m => (s1 -> s2) -> (s2 -> s1) -> StateT s1 m :><: StateT s2 m
+stateIso f fm1 = View  {to = iso f fm1, from = iso fm1 f } where 
+  iso g h m = stateT $ \s2 -> do  (a, s1) <- runStateT (h s2) m
+                                  return (a, g s1)
+                                  
+getv :: StateM s n => (m :><: n) -> m s
+getv var  = from var get 
+
+putv :: StateM s n => (m :><: n) -> s -> m ()
+putv var  = from var . put
diff --git a/Control/Monatron/ZipperExamples.hs b/Control/Monatron/ZipperExamples.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/ZipperExamples.hs
@@ -0,0 +1,83 @@
+{-# OPTIONS -XTypeOperators -XFlexibleContexts #-}
+
+module Control.Monatron.ZipperExamples where
+
+import Control.Monatron.Monatron
+import Control.Monatron.Zipper
+import Control.Monatron.Open
+
+-- Don't we need a bidirectional view to implement this combinator?
+
+fmask :: (m :><: n) -> Open e f (n a) -> Open e f (m a)
+fmask v evalf eval = from v . evalf (to v . eval)
+
+type Env = [(String,Int)]
+
+type Count = Int
+
+data Mem e  = Store e | Retrieve
+
+type Reg    = Int
+ 
+evalMem2  :: (StateM Reg (t m), StateM Count m, MonadT t) 
+             => Open e Mem (t m Int)
+evalMem2 eval (Store e) =
+  do  count <- lift $ get
+      lift $ put (count + 1)
+      n <- eval e
+      put n
+      return n
+evalMem2 eval Retrieve = lift $ get
+
+type M4 =  StateT Reg (StateT Env (ExcT String (StateT Count Id)))
+
+data Lit a = Lit Int
+data Var a = Var String
+data Add e = Add e e
+
+instance Functor Lit where
+  fmap _ (Lit l)      = Lit l
+
+instance Functor Var where
+  fmap _ (Var v)      = Var v
+
+instance Functor Add where
+  fmap f (Add e1 e2)  = Add (f e1) (f e2)
+  
+instance Functor Mem where
+  fmap f (Store x)  = Store (f x)
+  fmap f Retrieve   = Retrieve
+  
+lit :: (Lit :<: g)  => Int -> Fix g
+lit l      = inject (Lit l)
+
+var :: (Var :<: g)  => String -> Fix g 
+var v      = inject (Var v)
+
+add :: (Add :<: g)  => Fix g -> Fix g -> Fix g
+add e1 e2  = inject (Add e1 e2)
+
+store :: (Mem :<: g) => Fix g -> Fix g
+store e = inject (Store e)
+
+retrieve :: (Mem :<: g) => Fix g
+retrieve = inject Retrieve
+
+type Expr3  = Fix (Mem :+: Var :+: Lit)
+
+evalLit _ (Lit n) = return n 
+
+evalVar _ (Var v) = do env <- get
+                       case lookup v env of
+                         Just n -> return n
+                         Nothing -> throw "undefined variable"
+
+eval4 :: Expr3 -> M4 Int
+eval4 = fix  (    fmask (i `vcomp` o `vcomp` o) evalMem2
+             <@>  fmask o evalVar  
+             <@>  evalLit)
+        
+test = runId $ runStateT 0 $ handleExc $ runStateT [] $ runStateT 0 $ eval4 (store (lit 3))
+
+handleExc :: Monad m => ExcT a m b -> m b
+handleExc = liftM (either (error "Error!") id) . runExcT
diff --git a/Control/Search/Combinator/And.hs b/Control/Search/Combinator/And.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/And.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.And (andN,(<&>)) where
+
+import Maybe (fromMaybe, catMaybes, fromJust)
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Memo
+import Control.Search.MemoReader
+import Control.Search.Generator
+
+import Control.Search.Combinator.Success
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+import Control.Monatron.IdT
+
+seqNLoop :: (ReaderM Int m, Evalable m) => Int -> [Eval m] -> Eval m
+seqNLoop uid lst = commentEval $
+  Eval { structs     = (foldr1 (@++@) $ map (structs) lst) @++@ mystructs 
+       , toString = "seqN" ++ show uid ++ "(" ++ (foldr1 (\x y -> x ++ "," ++ y) $ map (toString) lst) ++ ")"
+       , treeState_  = [entry ("seqn_pos",Int,assign 0)                      -- is the first or the second search active?
+                       , ("seqn_union",Union [(SType (s3 i),"seq" ++ show i) | i <- [0..nbranches-1]], -- union of both tree states
+				\i -> 						 -- init nested state of first search
+                                   let j = xpath i 0
+                                   in initSubEvalState j (s1 0) (fs1 0)
+                         )]
+       , initH       = \i -> (local (const 0) $ inits (xsuper 0) (xpath i 0))
+       , evalState_  = [("complete",Bool,const $ return true)] -- some global data
+       , pushLeftH    = push pushLeft
+       , pushRightH   = push pushRight
+       , nextSameH    = \i -> let j = i `withBase` "popped_estate"
+                             in do nd <- inSeq nextDiff i
+                                   ns <- inSeq nextSame i
+                                   return $ IfThenElse ((seq_pos i) @== (seq_pos j)) ns nd
+       , nextDiffH    = inSeq $ nextDiff
+       , bodyH       = \i -> 
+                                let seqBody super j pos = 
+                                      do
+                                        dr <- dec_ref "bodyE-stmt" j i pos
+                                        bodyE super (j `onAbort` (comment "seqLoopN.bodyE" >>> dr))
+                                    in do cb <- mapM (\x -> canBranch x >>= \b -> return (if b then 1 else 0)) {- (const $ return 1) -} lst
+                                          let cu n | n==nbranches = 0
+                                              cu n                = (cb!!n) + cu (n+1)
+                                          ss <- mapM (\pos -> local (const $ fromIntegral pos) $ inSeq_ seqBody i) [0..nbranches-1]
+                                          let cc n | n==nbranches = Skip
+                                              cc n | cu n <= 1   = if ((cb !! n) == 1) then (ss !! n) else cc (n+1)
+                                              cc n | otherwise      = IfThenElse (seq_pos i @== fromIntegral n) (ss !! n) (cc (n+1))
+                                          return $ cc 0
+       , addH        = inSeq $ addE
+       , failH       = \i -> inSeq_ (\super j pos -> failE super j @>>>@ (dec_ref "failE" j i pos)) i
+       , returnH     = \i -> numSwitch (\n -> if (n<nbranches-1)
+                                                    then do let j1 = xpath i n
+                                                                j2o = xpath i (n+1)
+                                                            dr <- dec_ref "returnE-j2A" j2o i (n+1)
+                                                            let j2 = j2o `onCommit` dr
+                                                                j2b = resetCommit j2
+				 	                    action <- local (const $ n+1) $ do stmt1 <- inits (xsuper (n+1)) j2b
+                                                                                               stmt2 <- startTryE (xsuper (n+1)) j2b
+                                                                                               init <- initSubEvalState j2b (s1 $ n+1) (fs1 $ n+1)
+                                                                                               dr2 <- dec_ref "returnE-j1" j1 i n
+					                                                       return (    comment ("Switching from branch" ++ show n ++ " to branch" ++ show (n+1))
+                                                                                                           >>> dr2
+                                                                                                           >>> (seq_pos i <== fromIntegral (n+1))
+                                                                                                           >>> init >>> stmt1 >>> stmt2)
+                                                            returnE (xsuper n) $ j1 `withCommit` const action
+                                                    else do let j2o  = xpath i n
+                                                            dr3 <- dec_ref "returnE-j2B" j2o i n
+                                                            let j2 = j2o `onCommit` dr3
+                                                            returnE (xsuper n) j2
+                                          )
+--       , continue    = \_ -> return true
+       , tryH        = \i -> inSeq_ (\super j pos -> do { dr <- dec_ref "tryE" j i pos; return (comment "seqLoop.tryE(a)") @>>>@ tryE  super (j `onAbort` (comment "seqLoop.tryE(b)" >>> dr))}) i
+       , startTryH   = \i -> local (const 0) $ inSeq_ (\super j pos -> do { dr <- dec_ref "startTryE" j i pos; return (comment "seqLoop.startTryE(a)") @>>>@ startTryE super (j `onAbort` (comment "seqLoop.startTryE(b)" >>> dr))}) i
+       , tryLH       = \i -> inSeq_ (\super j pos -> tryE_ super j @>>>@ (dec_ref "tryE_" j i pos)) i
+       , intArraysE  = foldr1 (++) $ map (intArraysE) lst
+       , boolArraysE  = foldr1 (++) $ map (boolArraysE) lst
+       , intVarsE    = foldr1 (++) $ map (intVarsE) lst
+       , deleteH     = deleteMe
+       , canBranch   = do res <- mapM (canBranch) lst
+                          return $ or res
+       , complete = \i -> return $ estate i @=> "complete"
+--       , complete = const $ return false
+       }
+  where nbranches = length lst
+        xsuper i = lst !! i
+        mystructs = (catMaybes (map s1 [0..nbranches-1]),map s3 [0..nbranches-1])
+	evalStruct side super = Just $ -- if (length (evalState_ super) == 0) then Nothing else Just $
+			Struct (side ++ "EvalState"  ++ show uid) $ 
+--				(Bool, "cont") :				-- continue or not with this search 
+				(Int, "ref_count") : 				-- how many active nodes of this search
+				[(ty, field) | (field,ty,_) <- evalState_ super] -- fields of this search
+--        needSide = \pos stm -> if (length (evalState_ (xsuper pos)) == 0) then Skip else stm
+        needSide pos stm = stm
+        s1 i      = evalStruct ("Seq" ++ show i) (xsuper i)
+        et i      = maybe (THook "void") (Pointer . SType) $ s1 i
+        s3 i      = Struct ("Seq" ++ show i ++ "TreeState" ++ show uid) $ (case s1 i of { Nothing -> id; Just s -> ((Pointer $ SType s, "evalState"):) }) [(ty, field) | (field,ty,_) <- treeState_ (xsuper i)]
+        st i      = Pointer . SType $ s3 i
+        xpath i n = flip withClone (\i -> inc (ref_count i)) $ withPath i (inN n) (et n) (st n)
+        fs1 n     = \i -> [(field,init) | (field,_ty,init) <- evalState_ (xsuper n) ]
+        fs3 n     = \i -> [(field,init) | (field,_ty,init) <- treeState_ (xsuper n) ]
+        withSeq f = numSwitch (\n -> f (xsuper n) (inN n))
+        inSeq f   = \i -> numSwitch (\n -> f (xsuper n) (xpath i n))
+        inSeq_ f  = \i -> numSwitch (\n -> f (xsuper n) (xpath i n) n)
+        push dir  = \i -> inSeq_ ( \super j pos -> dir super (j `onCommit` (mkCopy i "seqn_pos"
+                                                                            >>> needSide pos (mkCopy j "evalState")
+                                                                            >>> needSide pos (inc (ref_count j))
+                                                                           )
+                                                             )
+                                 ) i
+        initSubEvalState = \j s fs -> (case s of { Nothing -> return Skip; Just ss -> return (    (estate j <== New ss)
+				              >>> (ref_count j <== 1)
+--			                      >>> (cont j <== true)
+                                             )})
+                                        @>>>@ inite (fs j) j
+	deleteMe = \i -> inSeq_ (\super j pos -> do delrest <- deleteE super j
+                                                    dr <- dec_ref "deleteMe" j i pos
+                                                    return (delrest >>> dr)) i
+--        dec_ref :: String -> Info -> Info -> Int -> Statement
+        dec_ref s j i pos = complete (xsuper pos) j >>= \compl -> decrefx j pos (estate_type i,estate i) (estate_type j,estate j) (ref_count_type, ref_count j) (THook "bool", compl)
+        decrefx j pos = memo "dec_ref_and" j (\(_,esti) (_,estj) (_,rcj) (_,xcl) -> return $ ((assign ((esti @=> "complete") &&& (xcl))) (esti @=> "complete") >>> 
+                            needSide pos (dec (rcj) >>> ifthen (rcj @== 0) (Delete (estj)))) {- >>> DebugValue ("completeness and" ++ show uid) (esti @=> "complete") -})
+	inN n     = \state -> state @-> "seqn_union" @-> ("seq" ++ show n)
+	seq_pos   = \i -> tstate i @-> "seqn_pos"
+
+
+andN [] = dummy
+andN [s] = s
+andN s =
+  let sc = buildCombiner s
+      in case sc of 
+        SearchCombiner { runner = runner, elems = elems } ->
+          Search { mkeval = \super -> do { ss <- extractCombiners elems $ mapE (L . mmap runL . runL) super
+                                         ; uid <- get
+                                         ; put $ uid+1
+                                         ; return $ mapE (L . mmap L . runL) $ memoLoop $ seqNLoop uid ss
+                                         }
+                 , runsearch = runner . rReaderT 0 . runL
+                 }
+
+a <&> b = andN [a,b]
+
diff --git a/Control/Search/Combinator/Base.hs b/Control/Search/Combinator/Base.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Base.hs
@@ -0,0 +1,320 @@
+module Control.Search.Combinator.Base (
+    label
+  , vlabel
+  , glabel, gblabel
+  , int_assign
+  , ilabel
+  , maxV, minV, lbV, ubV, domsizeV, lbRegretV, ubRegretV, degreeV, domSizeDegreeV, wDegreeV, domSizeWDegreeV, randomV, minD, maxD, meanD, medianD, randomD
+  , foldVarSel, ifoldVarSel, bfoldVarSel, bifoldVarSel
+  ) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+
+import Control.Monatron.IdT
+
+data Label m = Label 
+	           { treeStateL   :: [(String,Type, Value -> Statement)]
+                   , leftChild_L  :: [Info -> Statement]
+                   , rightChild_L :: [Info -> Statement]
+                   , addL         :: Info -> m Statement
+                   , tryL         :: Info -> m Statement
+                   , intArraysL   :: [String]
+                   , boolArraysL  :: [String]
+                   , intVarsL     :: [String]
+                   }
+
+v1Label var1 selVal rel e = 
+            Label { treeStateL  = [("val", Int,  assign 0)
+                                  ,("eq",  Bool, assign true)]
+                  , leftChild_L  = 
+                                  [ \i -> mkUpdate i "eq" (const true)
+                                  , \i -> mkCopy i "val" ]
+                  , rightChild_L =
+                                  [ \i -> mkUpdate i "eq" (const false)
+                                  , \i -> mkCopy i "val" ]
+                  , addL        = \i -> return $
+                                                 IfThenElse (eq i)
+                                                   (Post (space i) (var i `rel` val i))
+                                                   (Post (space i) (neg (var i `rel` val i)))
+                  , tryL        = \i -> returnE e (resetInfo i) >>= \ret -> -- XXX
+                                        tryE_ e (resetInfo i)   >>= \try -> -- XXX
+                                        return $ (IfThenElse (Assigned (var i))
+                                                          ret
+                                                          (val i <== (selVal $ var i) >>> try))
+                  , intArraysL  = []
+                  , boolArraysL = []
+                  , intVarsL    = [var1]
+                  }
+                  where val i = tstate i @-> "val"
+                        eq  i = tstate i @-> "eq"
+                        var i = IVar var1 (space i)
+
+
+vLabel vars selVar selVal rel e = 
+            Label { treeStateL  = [("pos", Int,  assign 0)
+				  ,("val", Int,  assign 0)
+                                  ,("eq",  Bool, assign true)]
+                  , leftChild_L  = 
+                                  [ \i -> mkUpdate i "eq" (const true)
+                                  , \i -> mkCopy i "val"
+                                  , \i -> mkCopy i "pos"]
+                  , rightChild_L =
+                                  [ \i -> mkUpdate i "eq" (const false)
+                                  , \i -> mkCopy i "val"
+                                  , \i -> mkCopy i "pos"]
+                  , addL        = \i -> return $
+                                                 IfThenElse (eq i)
+                                                   (Post (space i) (var i `rel` val i))
+                                                   (Post (space i) (neg (var i `rel` val i)))
+                  , tryL        = \i -> returnE e (resetInfo i) >>= \ret -> -- XXX
+                                        tryE_ e (resetInfo i)   >>= \try -> -- XXX
+                                        return $ (selVar i vars
+                                                          ret
+                                                          (val i <== (selVal $ var i) >>> try))
+                  , intArraysL  = [vars]
+                  , boolArraysL = []
+                  , intVarsL    = []
+                  }
+                  where val i = tstate i @-> "val"
+                        pos i = tstate i @-> "pos"
+                        eq  i = tstate i @-> "eq"
+                        var i = AVarElem vars (space i) (pos i)
+
+vbLabel vars selVar selVal rel e = 
+            Label { treeStateL  = [("pos", Int,  assign 0)
+				  ,("val", Int,  assign 0)
+                                  ,("eq",  Bool, assign true)]
+                  , leftChild_L  = 
+                                  [ \i -> mkUpdate i "eq" (const true)
+                                  , \i -> mkCopy i "val"
+                                  , \i -> mkCopy i "pos"]
+                  , rightChild_L =
+                                  [ \i -> mkUpdate i "eq" (const false)
+                                  , \i -> mkCopy i "val"
+                                  , \i -> mkCopy i "pos"]
+                  , addL        = \i -> return $
+                                                 IfThenElse (eq i)
+                                                   (Post (space i) (var i `rel` val i))
+                                                   (Post (space i) (neg (var i `rel` val i)))
+                  , tryL        = \i -> returnE e (resetInfo i) >>= \ret -> -- XXX
+                                        tryE_ e (resetInfo i)   >>= \try -> -- XXX
+                                        return $ (selVar i vars
+                                                          ret
+                                                          (val i <== (selVal $ var i) >>> try))
+                  , intArraysL  = []
+                  , boolArraysL = [vars]
+                  , intVarsL    = []
+                  }
+                  where val i = tstate i @-> "val"
+                        pos i = tstate i @-> "pos"
+                        eq  i = tstate i @-> "eq"
+                        var i = BAVarElem vars (space i) (pos i)
+
+type ValSel = Value -> Value
+
+type VarSel = Info -> String -> Statement -> Statement -> Statement
+
+foldVarSel metric (better, zero) i vars notfound found =
+  Fold vars (tstate i) (space i) zero metric better
+  >>> IfThenElse (pos i @< 0) notfound found
+  where pos i = tstate i @-> "pos"
+
+ifoldVarSel metric (better, zero) i vars notfound found =
+  IFold vars (tstate i) (space i) zero metric better
+  >>> IfThenElse (pos i @< 0) notfound found
+  where pos i = tstate i @-> "pos"
+
+bfoldVarSel metric (better, zero) i vars notfound found =
+  BFold vars (tstate i) (space i) zero metric better
+  >>> IfThenElse (pos i @< 0) notfound found
+  where pos i = tstate i @-> "pos"
+
+bifoldVarSel metric (better, zero) i vars notfound found =
+  BIFold vars (tstate i) (space i) zero metric better
+  >>> IfThenElse (pos i @< 0) notfound found
+  where pos i = tstate i @-> "pos"
+
+
+--------------------------------------------------------------------------------
+-- SEARCH TRANSFORMERS
+--------------------------------------------------------------------------------
+
+pushLeftTop  e = \i -> pushLeft  e (i `onCommit` mkCopy   i "space"      )
+pushRightTop e = \i -> pushRight e (i `onCommit` mkUpdate i "space" Clone)
+
+
+baseLoop label this = return $ commentEval $ current
+  where current =
+	    Eval { structs      = ([],[])
+                 ,  treeState_  = map entry $ treeStateL label  
+                 ,  initH       = const $ return Skip
+                 ,  evalState_   = []
+		 ,  pushLeftH    = \i -> cachedCommit i @>>>@ return (seqs [f i | f <- leftChild_L label])
+		 ,  pushRightH   = \i -> cachedCommit i @>>>@ return (seqs [f i | f <- rightChild_L label])
+	         ,  nextSameH    = \i -> return Skip
+	         ,  nextDiffH    = \i -> return Skip
+		 ,  bodyH       = addE this . resetInfo -- XXX
+                 ,  addH        = \i -> tryE this (resetInfo i)   >>= \try -> -- XXX
+			 	        addL label i              >>= \a   -> 
+                                        return (a >>> try)
+	         ,  failH      = const $ return Skip
+                 ,  returnH    = \i -> cachedCommit i
+--                 ,  continue   = \_ -> return true
+                 ,  tryH       = tr label
+                 ,  startTryH  = tr label
+                 ,  tryLH      = \i -> pushRightTop this (newinfo i "R")            >>= \p2 -> 
+                                       pushLeftTop this  (newinfo i "L")            >>= \p4 ->
+                                       return $ (
+                                         SHook "st->queue->push_back(TreeState());" >>>
+                                         SHook "TreeState& nstateR = st->queue->back();" >>>
+                                         p2 >>>
+                                         SHook "st->queue->push_back(TreeState());" >>>
+                                         SHook "TreeState& nstateL = st->queue->back();" >>>
+                                         p4
+                                       )
+                 , intArraysE  = intArraysL label
+                 , boolArraysE = boolArraysL label
+                 , intVarsE    = intVarsL label
+		 , deleteH     = \i -> return Skip
+                 , toString    = "base"
+                 , canBranch   = return True
+                 , complete    = const $ return true
+                 }
+                 where new_tstate  = Var "nstate"
+        tr lab i = failE this (resetInfo i) >>= \fail ->
+                   tryL lab i >>= \tryl ->
+                   return $ (SHook "Gecode::SpaceStatus status;" >>>
+                      (Var "status" <== VHook (rp 0 (space i) ++ "->status()")) >>>
+                      IfThenElse (Var "status" @== VHook "SS_FAILED") (fail >>> Delete (space i)) tryl
+                   )
+
+label :: String -> (Value -> Value) -> (Value -> Value -> Value, Value) -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
+label get varMeasure varComp valSel rel = 
+  Search { mkeval     = \this -> baseLoop (vLabel get (foldVarSel varMeasure varComp) valSel rel this) this 
+         , runsearch  = runIdT
+         }
+
+vlabel :: String -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
+vlabel get valSel rel = 
+  Search { mkeval     = \this -> baseLoop (v1Label get valSel rel this) this 
+         , runsearch  = runIdT
+         }
+
+ilabel :: String -> (Value -> Value) -> (Value -> Value -> Value, Value) -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
+ilabel get varMeasure varComp valSel rel = 
+  Search { mkeval     = \this -> baseLoop (vLabel get (ifoldVarSel varMeasure varComp) valSel rel this) this 
+         , runsearch  = runIdT
+         }
+
+int_assign :: String -> VarSel -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
+int_assign get varSel valSel rel = 
+  Search { mkeval     = \this -> assignLoop (vLabel get varSel valSel rel this) this 
+         , runsearch  = runIdT
+         }
+
+glabel :: String -> VarSel -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
+glabel get varSel valSel rel = 
+  Search { mkeval     = \this -> baseLoop (vLabel get varSel valSel rel this) this 
+         , runsearch  = runIdT
+         }
+
+gblabel :: String -> VarSel -> (Value -> Value) -> (Value -> Value -> Constraint) -> Search
+gblabel get varSel valSel rel = 
+  Search { mkeval     = \this -> baseLoop (vbLabel get varSel valSel rel this) this 
+         , runsearch  = runIdT
+         }
+
+maxV           = (Gt,IVal minBound)
+minV           = (Lt,IVal maxBound)
+
+lbV            = MinDom
+ubV            = MaxDom 
+domsizeV       = \v -> MaxDom v - MinDom v
+lbRegretV      = LbRegret
+ubRegretV      = UbRegret
+degreeV        = Degree
+domSizeDegreeV = \v -> domsizeV v `Div` degreeV v
+wDegreeV       = WDegree
+domSizeWDegreeV= \v -> domsizeV v `Div` wDegreeV v
+randomV        = const Random
+
+minD           = MinDom
+maxD           = MaxDom
+meanD          = \v -> (maxD v + minD v) `Div` 2
+medianD        = \v -> Median v
+randomD        = \v -> (Random `Mod` (domsizeV v)) + minD v
+
+{-
+assignLoop label this = return $ commentEval $ current
+  where current =
+	    Eval { structs      = ([],[])
+                 ,  treeState_  = map entry $ treeStateL label  
+                 ,  initH       = const $ return Skip
+                 ,  evalState_   = []
+		 , pushLeftH    = error "assignLoop.tyE_"
+		 , pushRightH   = error "assignLoop.tyE_"
+	         ,  nextSameH    = \i -> return Skip
+	         ,  nextDiffH    = \i -> return Skip
+		 ,  bodyH       = addE this . resetInfo -- XXX
+                 ,  addH        = \i -> tryE this (resetInfo i)   >>= \try -> -- XXX
+			 	        addL label i              >>= \a   -> 
+                                        return (a >>> try)
+	         ,  failH      = const $ return Skip
+                 ,  returnH    = \i -> cachedCommit i
+                 ,  tryH       = returnE this . resetInfo
+                 ,  startTryH  = \i -> (return $ comment "<startTryE assign>") @>>>@ (returnE this . resetInfo) i @>>>@ (return $ comment "</startTryE succes>")
+                 ,  tryLH      = error "assignLoop.tryE_"
+                 , intArraysE  = intArraysL label
+                 , boolArraysE = boolArraysL label
+                 , intVarsE    = intVarsL label
+		 , deleteH     = \i -> return Skip
+                 , toString    = "assign"
+                 , canBranch   = return False
+                 , complete    = const $ return true
+                 }
+-}
+assignLoop label this = return $ commentEval $ current
+  where current =
+	    Eval { structs      = ([],[])
+                 ,  treeState_  = map entry $ treeStateL label  
+                 ,  initH       = const $ return Skip
+                 ,  evalState_   = []
+		 ,  pushLeftH    = \i -> cachedCommit i @>>>@ return (seqs [f i | f <- leftChild_L label])
+		 ,  pushRightH   = \i -> cachedCommit i @>>>@ return (seqs [f i | f <- rightChild_L label])
+	         ,  nextSameH    = \i -> return Skip
+	         ,  nextDiffH    = \i -> return Skip
+		 ,  bodyH       = addE this . resetInfo -- XXX
+                 ,  addH        = \i -> tryE this (resetInfo i)   >>= \try -> -- XXX
+			 	        addL label i              >>= \a   -> 
+                                        return (a >>> try)
+	         ,  failH      = const $ return Skip
+                 ,  returnH    = \i -> cachedCommit i
+                 ,  tryH       = tr label
+                 ,  startTryH  = tr label
+                 ,  tryLH      = \i -> -- pushRightTop this (newinfo i "R")            >>= \p2 -> 
+                                       pushLeftTop this  (newinfo i "L")            >>= \p4 ->
+                                       return $ (
+                                         -- SHook "queue->push_back(TreeState());" >>>
+                                         -- SHook "TreeState& nstateR = queue->back();" >>>
+                                         -- p2 >>>
+                                         SHook "st->queue->push_back(TreeState());" >>>
+                                         SHook "TreeState& nstateL = st->queue->back();" >>>
+                                         p4
+                                       )
+                 , intArraysE  = intArraysL label
+                 , boolArraysE = boolArraysL label
+                 , intVarsE    = intVarsL label
+		 , deleteH     = \i -> return Skip
+                 , toString    = "base"
+                 , canBranch   = return True
+                 , complete    = const $ return true
+                 }
+                 where new_tstate  = Var "nstate"
+        tr lab i = failE this (resetInfo i) >>= \fail ->
+                   tryL lab i >>= \tryl ->
+                   return $ (
+                      (Var "status" <== VHook (rp 0 (space i) ++ "->status()")) >>>
+                      IfThenElse (Var "status" @== VHook "SS_FAILED") (fail >>> Delete (space i)) tryl
+                   )
diff --git a/Control/Search/Combinator/Failure.hs b/Control/Search/Combinator/Failure.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Failure.hs
@@ -0,0 +1,40 @@
+module Control.Search.Combinator.Failure (failure) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.IdT
+
+failLoop uid _super = 
+  commentEval $   Eval { structs    = ([],[])
+                       , treeState_ = []
+                       , evalState_ = []
+		       , pushLeftH   = \_ -> return Skip
+		       , pushRightH  = \_ -> return Skip
+		       , nextSameH   = \_ -> return Skip
+		       , nextDiffH   = \_ -> return Skip
+                       , bodyH      = \i -> cachedAbort i
+                       , addH       = \_ -> return Skip
+	 	       , failH      = \i -> cachedAbort i
+                       , returnH    = \i -> cachedAbort i
+--                       , continue   = \_ -> return true
+                       , tryH       = \i -> cachedAbort i
+                       , startTryH  = \i -> cachedAbort i
+                       , tryLH      = \_ -> return Skip
+                       , intArraysE = []
+                       , intVarsE   = []
+                       , boolArraysE = []
+		       , deleteH     = \i -> cachedAbort i
+                       , initH      = \_ -> return $ {- DebugOutput $ "fail" ++ show uid >>> -} Skip
+                       , toString   = "fail" ++ show uid
+                       , canBranch  = return False
+                       , complete = const $ return false
+                       }
+
+failure :: Search
+failure = 
+  Search { mkeval     = \super -> get >>= \uid -> return (failLoop uid super)
+         , runsearch  = runIdT
+         }
diff --git a/Control/Search/Combinator/For.hs b/Control/Search/Combinator/For.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/For.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.For (for, foreach) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.Memo
+import Control.Search.MemoReader
+
+import Data.Int
+
+import Control.Monatron.Zipper hiding (i,r)
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+
+forLoop :: (ReaderM Bool m, Evalable m) => Int32 -> Int -> (Eval m) -> Eval m
+forLoop n uid (super) = commentEval $
+    Eval 
+       { 
+         structs     = structs super @++@ mystructs 
+       , toString    = "for" ++ show uid ++ "(" ++ show n ++ "," ++ toString super ++ ")"
+       , treeState_  = treeState_ super
+       , initH       = \i -> initE super i @>>>@ return (parent i <== baseTstate i) @>>>@ cachedClone i (cloneBase i)
+       , evalState_  = ("counter",Int,const $ return 0) : {- ("cont",Bool,const $ return true) : -} ("ref_count",Int,const $ return 1) : ("parent",THook "TreeState",const $ return Null) : evalState_ super
+       , pushLeftH    = push pushLeft
+       , pushRightH   = push pushRight
+       , nextSameH    = nextSame super
+       , nextDiffH    = nextDiff super 
+       , bodyH = \i -> dec_ref i >>= \deref -> bodyE super (i `onAbort` deref)
+       , addH        = addE super
+       , failH       = \i -> failE super i @>>>@ dec_ref i
+       , returnH     = \i -> let j deref = i `onCommit` deref
+                             in dec_ref i >>= returnE super . j
+       , tryH        = \i -> do deref <- dec_ref i
+                                tryE super ((i `withField` ("counter", counter)) `onAbort` deref)
+       , startTryH   = \i -> do deref <- dec_ref i
+                                startTryE super ((i `withField` ("counter", counter)) `onAbort` deref)
+       , tryLH       = \i -> tryE_ super i @>>>@ dec_ref i
+       , intArraysE  = intArraysE super
+       , boolArraysE  = boolArraysE super
+       , intVarsE    = intVarsE super
+       , deleteH     = error "forLoop.deleteE NOT YET IMPLEMENTED"
+       , canBranch   = return True
+       , complete    = complete super
+       }
+  where mystructs = ([],[])
+        fs1       = [(field,init) | (field,ty,init) <- evalState_ super]
+        parent    = \i -> estate i @=> "parent"
+        counter   = \i -> estate i @=> "counter"
+        dec_ref    = \i -> let i'     = resetCommit $ i `withBase` ("for_tstate" ++ show uid)
+                           in do flag <- ask 
+                                 if flag 
+                                   then local (const False) $ do
+				 	stmt1 <- inits super i'
+                                 	stmt2 <- startTryE super (i' `withField` ("counter", counter))
+                                        ini <- inite fs1 i'
+                                        cc <- cachedClone (cloneBase i) i'
+                                        compl <- complete super i
+			         	return (dec (ref_count i) 
+                                               >>> ifthen (ref_count i @== 0) 
+                                                     (   inc (counter i)
+                                                     >>> comment ("forLoop: bla 1 (baseTstate i' == \"" ++ rp 0 (baseTstate i') ++ "\", ref_count i' == \"" ++ rp 0 (ref_count i') ++ "\")")
+                                                     >>> ifthen (counter i @< IVal n &&& Not compl)
+				                           (   SHook ("TreeState for_tstate" ++ show uid ++ ";")
+                                                           >>> comment "forLoop: bla 2"
+				   			   >>> (baseTstate i' <== parent i)
+                                                           >>> comment "forLoop: bla 3"
+							   >>> cc
+                                                           >>> comment "forLoop: bla 4"
+				                           >>> (ref_count i' <== 1)
+                                                           >>> comment "forLoop: bla 5"
+--				                           >>> (cont i' <== true)
+                                                           >>> comment "forLoop: bla 6"
+	                                                   >>> ini 
+                                                           >>> comment "forLoop: bla 7"
+                                                           >>> stmt1 
+                                                           >>> comment "forLoop: bla 8"
+                                                           >>> stmt2)
+						     ))
+                                   else return $ dec (ref_count i) >>> ifthen (ref_count i @== 0) (comment "Delete-forLoop-dec_ref" >>> Delete (space $ cloneBase i))
+        push dir  = \i -> dir super (i `onCommit` inc (ref_count i))
+for
+  :: Int32
+  -> Search
+  -> Search
+for n s  = 
+  case s of
+    Search { mkeval = evals, runsearch = runs } ->
+	  Search { mkeval =
+	           \super ->
+	           do { uid <- get
+	              ; put (uid + 1)
+	              ; s' <- evals $ mapE (L . L . mmap runL . runL) super
+	              ; return $ mapE (L . mmap L . runL) $ forLoop n uid (mapE runL s')
+	              }
+	         , runsearch   = runs . rReaderT True . runL
+	         }
+
+foreach
+  :: Int32
+  -> ((Info -> Value) -> Search)
+  -> Search
+foreach n mksearch  = 
+        case mksearch (\i -> field i "counter")  of
+          Search { mkeval = eval, runsearch = run } ->
+           Search { mkeval = 
+                    \super ->
+                    do { uid <- get
+                       ; put (uid + 1)
+                       ; s' <- eval $ mapE (L . L . mmap runL . runL) super
+                       ; return $ mapE (L . mmap L . runL) $ forLoop n uid (mapE runL s')
+                       }
+                  , runsearch  = run . rReaderT True . runL
+                  }
+
diff --git a/Control/Search/Combinator/If.hs b/Control/Search/Combinator/If.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/If.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.If (if') where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.MemoReader
+import Control.Search.Generator
+import Control.Search.Stat
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+
+xs1  uid lsuper rsuper      = Struct ("LeftEvalState" ++ show uid) $ {- (Bool, "cont") : -} (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState_ lsuper]
+xfs1 uid lsuper rsuper      = [(field,init) | (field,ty,init) <- evalState_ rsuper ]
+xs2  uid lsuper rsuper      = Struct ("RightEvalState" ++ show uid) $ {- (Bool, "cont") : -} (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState_ rsuper]
+xfs2 uid lsuper rsuper      = [(field,init) | (field,ty,init) <- evalState_ rsuper ]
+xs3  uid lsuper rsuper      = Struct ("LeftTreeState"  ++ show uid) $ (Pointer $ SType $ xs1 uid lsuper rsuper, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ lsuper]
+xfs3 uid lsuper rsuper      = [(field,init) | (field,ty,init) <- treeState_ lsuper]
+xs4  uid lsuper rsuper      = Struct ("RightTreeState"  ++ show uid) $ (Pointer $ SType $ xs2 uid lsuper rsuper, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ rsuper]
+xfs4 uid lsuper rsuper      = [(field,init) | (field,ty,init) <- treeState_ rsuper]
+
+in1       = \state -> state @-> "if_union" @-> "if_then"
+in2       = \state -> state @-> "if_union" @-> "if_else"
+
+xpath uid lsuper rsuper i FirstS = withPath i in1 (SType $ xs1 uid lsuper rsuper) (SType $ xs3 uid lsuper rsuper)
+xpath uid lsuper rsuper i SecondS = withPath i in2 (SType $ xs2 uid lsuper rsuper) (SType $ xs4 uid lsuper rsuper)
+
+ifLoop :: (Evalable m, ReaderM SeqPos m) => Stat -> Int -> Eval m -> Eval m -> Eval m
+ifLoop cond uid lsuper rsuper = commentEval $
+  Eval { structs     = structs lsuper @++@ structs rsuper @++@ mystructs 
+       , toString    = "if" ++ show uid ++ "(" ++ show cond ++ "," ++ toString lsuper ++ "," ++ toString rsuper ++ ")"
+       , treeState_   = [("if_true", Bool,const $ return Skip),
+                         ("if_union",Union [(SType s3,"if_true"),(SType s4,"if_false")],const $ return Skip)
+                        ]
+       , initH       = \i -> (readStat cond >>= \r -> return (assign (r i) (tstate i @-> "if_true"))) @>>>@ initstate i
+       , evalState_   = []
+       , pushLeftH    = push pushLeft
+       , pushRightH   = push pushRight
+       , nextSameH    = \i -> let j = i `withBase` "popped_estate"
+                             in do nS1 <- local (const FirstS)  $ inSeq nextSame i
+                                   nS2 <- local (const SecondS) $ inSeq nextSame i
+                                   nD1 <- local (const FirstS)  $ inSeq nextDiff i
+                                   nD2 <- local (const SecondS) $ inSeq nextDiff i
+                                   return $ IfThenElse (is_fst i) 
+                                                       (IfThenElse (is_fst j) nS1 nD1)
+                                                       (IfThenElse (is_fst j) nD2 nS2) 
+       , nextDiffH    = \i -> inSeq nextDiff i
+       , bodyH       = \i ->
+                         let f y z p = 
+                               let j = mpath i p
+{-                               in   do cond  <- continue z (estate j)
+                                       deref <- dec_ref i
+				       stmt  <- bodyE z (j `onAbort` deref)
+                                       return $ IfThenElse (cont j)
+				  		    (IfThenElse cond
+						                stmt
+							        (   (cont j <== false)
+                                                                >>> deref
+                                                                >>> abort j))
+						    (deref >>> abort j)
+-}
+                                 in dec_ref i >>= \deref -> bodyE z (j `onAbort` deref)
+			 in IfThenElse (is_fst i) @$ local (const FirstS)  (f in1 lsuper FirstS) 
+                                                  @. local (const SecondS) (f in2 rsuper SecondS)
+       , addH        = inSeq $ addE
+       , failH       = \i -> inSeq failE i @>>>@ dec_ref i
+       , returnH     = \i -> 
+			     let j1 deref = mpath i FirstS `onCommit` deref
+                                 j2 deref = mpath i SecondS `onCommit` deref
+                             in IfThenElse (is_fst i) @$ (dec_refx (j1 Skip) >>= returnE lsuper . j1) @. (dec_refx (j2 Skip) >>= returnE rsuper . j2)
+--       , continue    = \_ -> return true
+       , tryH        = \i -> IfThenElse (is_fst i) @$ tryE lsuper (mpath i FirstS) @. tryE rsuper (mpath i SecondS)
+       , startTryH   = \i -> IfThenElse (is_fst i) @$ startTryE lsuper (mpath i FirstS) @. startTryE rsuper (mpath i SecondS)
+       , tryLH       = \i -> IfThenElse (is_fst i) @$ tryE_ lsuper (mpath i FirstS) @. tryE_ rsuper (mpath i SecondS)
+       , boolArraysE  = boolArraysE lsuper ++ boolArraysE rsuper
+       , intArraysE  = intArraysE lsuper ++ intArraysE rsuper
+       , intVarsE    = intVarsE lsuper ++ intVarsE rsuper
+       , deleteH     = deleteMe
+       , canBranch   = canBranch lsuper >>= \l -> canBranch rsuper >>= \r -> return (l || r)
+       , complete    = \i -> do sid1 <- complete lsuper (mpath i FirstS)
+                                sid2 <- complete rsuper (mpath i SecondS)
+                                return $ Cond (tstate i @-> "is_fst") sid1 sid2
+       }
+  where mystructs = ([s1,s2],[s3,s4])
+        s1 = xs1 uid lsuper rsuper
+        s2 = xs2 uid lsuper rsuper
+        s3 = xs3 uid lsuper rsuper
+        s4 = xs4 uid lsuper rsuper
+        fs1 = xfs1 uid lsuper rsuper
+        fs2 = xfs2 uid lsuper rsuper
+        fs3 = xfs3 uid lsuper rsuper
+        fs4 = xfs4 uid lsuper rsuper
+        mpath = xpath uid lsuper rsuper
+        withSeq f = seqSwitch (f lsuper in1) (f rsuper in2)
+        withSeq_ f = seqSwitch (f lsuper in1 FirstS) (f rsuper in2 SecondS)
+        inSeq f   = \i     -> withSeq_ $ \super ins pos -> f super (mpath i pos)
+        dec_ref    = \i -> seqSwitch (dec_refx $ mpath i FirstS) (dec_refx $ mpath i SecondS)
+        dec_refx    = \j -> return $ dec (ref_count j) >>> ifthen (ref_count j @== 0) (comment "ifLoop-dec_refx" >>> Delete (estate j))
+        push dir  = \i -> seqSwitch (push1 dir i) (push2 dir i)
+        push1 dir = \i -> 
+                           let j = mpath i FirstS
+                           in  dir lsuper (j `onCommit` (   mkCopy i "if_true"
+                                                        >>> mkCopy j "evalState"
+                                                        >>> inc (ref_count j)
+                                                        ))
+        push2 dir = \i -> 
+                           let j = mpath i SecondS
+                           in  dir rsuper (j `onCommit` (   mkCopy i "if_true"
+                                                        >>> mkCopy j "evalState"
+                                                        >>> inc (ref_count j)
+                                                       ))
+        initstate = \i -> 
+                               let f d = 
+                                         let j = mpath i (if d then FirstS else SecondS)
+                                             in       return (    (estate j <== New (if d then s1 else s2))
+                                                              >>> (ref_count j <== 1)
+                                                             ) 
+                                                @>>>@ inite (if d then fs1 else fs2) j
+                                                @>>>@ inits (if d then lsuper else rsuper) j
+                                   in do thenP <- f True
+                                         elseP <- f False
+                                         return $ IfThenElse (tstate i @-> "if_true") thenP elseP
+	in1       = \state -> state @-> "if_union" @-> "if_then"
+	in2       = \state -> state @-> "if_union" @-> "if_else"
+	is_fst    = \i -> tstate i @-> "if_true"
+        deleteMe  = \i -> seqSwitch (deleteE lsuper (mpath i FirstS)) (deleteE rsuper (mpath i SecondS)) @>>>@ dec_ref i
+
+if'
+  :: Stat
+  -> Search
+  -> Search
+  -> Search
+if' cond s1 s2 = 
+  case s1 of
+    Search { mkeval = evals1, runsearch = runs1 } ->
+      case s2 of
+        Search { mkeval = evals2, runsearch = runs2 } ->
+	  Search { mkeval =
+	          \super -> do { s2' <- evals2 $ mapE (L . L . L . mmap (mmap runL . runL) . runL)  super
+	                       ; s1' <- evals1 $ mapE (L . L . mmap (mmap runL . runL) . runL) super
+		   	       ; uid <- get
+		   	       ; put (uid + 1)
+	                       ; return $ mapE (L . mmap L . runL) $ 
+		   			ifLoop cond uid (mapE (L . mmap (mmap L) . runL . runL) s1')
+	                                                      (mapE (L . mmap (mmap L) . runL . runL . runL) s2')
+	                       }
+	         , runsearch  = runs2 . runs1 . runL . rReaderT FirstS . runL
+	         } 
+ where 	in1       = \state -> state @-> "if_union" @-> "if_then"
+	in2       = \state -> state @-> "if_union" @-> "if_else"
diff --git a/Control/Search/Combinator/Let.hs b/Control/Search/Combinator/Let.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Let.hs
@@ -0,0 +1,41 @@
+module Control.Search.Combinator.Let (let', set') where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.Stat
+
+stmPrefixLoop stm super = super { tryH = \i -> (stm i) @>>>@ (tryE super) i, startTryH = \i -> (stm i) @>>>@ (startTryH super) i, toString = "prefix(" ++ toString super ++ ")" }
+
+letLoop :: Evalable m => VarId -> Stat -> Eval m -> Eval m
+letLoop v@(VarId i) val super'' = 
+  let super' = evalStat val super''
+      super = super' { evalState_ = ("var" ++ (show i), Int, \i -> setVarInfo v i >> readStat val >>= \x -> return (x i)) : evalState_ super', 
+                       toString = "let(" ++ show v ++ "," ++ show val ++ "," ++ toString super'' ++ ")" }
+      in commentEval super
+
+let'
+  :: VarId
+  -> Stat
+  -> Search
+  -> Search
+
+let' var val s = 
+  case s of
+    Search { mkeval = evals, runsearch = runs } ->
+      Search { mkeval = \super -> do { ss <- evals super
+                                     ; return $ letLoop var val ss
+                                     }
+             , runsearch = runs
+             }
+
+set' :: VarId -> Stat -> Search -> Search
+set' var val s = case s of
+   Search { mkeval = evals, runsearch = runs } ->
+     Search { mkeval = \super -> do { ss <- evals super
+                                    ; let ss1 = evalStat (varStat var) ss
+                                    ; let ss2 = evalStat val ss1
+                                    ; return $ stmPrefixLoop (\i -> readStat (varStat var) >>= \rvar -> readStat val >>= \rval -> return $ Assign (rvar i) (rval i)) ss2
+                                    }
+            , runsearch = runs
+            }
diff --git a/Control/Search/Combinator/Misc.hs b/Control/Search/Combinator/Misc.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Misc.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.Misc (dbs, lds, bbmin) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.Stat
+
+import Data.Int
+
+import Control.Monatron.IdT
+
+ldsLoop :: Monad m => Stat -> MkEval m
+ldsLoop limit super' = return $ commentEval $ super
+                     { treeState_  = entry ("lds",Int,assign 0) : treeState_ super
+                     , initH  = \i -> readStat limit >>= \f -> initH super i @>>>@ return (assign (f i) (tstate i @-> "lds"))
+                     , evalState_  = ("lds_complete", Bool, const $ return true) : evalState_ super
+                     , pushLeftH   = \i -> pushLeft  super (i `onCommit` mkCopy i "lds")
+                     , pushRightH  = \i -> pushRight super (i `onCommit` mkUpdate i "lds" (\x -> x - 1)) >>= \stmt -> 
+						return $ IfThenElse 
+							   (tstate (old i) @-> "lds" @>= 0) 
+                                                           stmt
+							   (abort i >>> (estate i @=> "lds_complete" <== false))
+                     , toString = "lds(" ++ show limit ++ "," ++ toString super ++ ")"
+                     , complete = \i -> return $ estate i @=> "lds_complete"
+                     }
+  where super = evalStat limit super'
+
+--------------------------------------------------------------------------------
+dbsLoop :: Monad m => Int32 -> MkEval m
+dbsLoop limit super = return $ commentEval $ super
+                     { treeState_  = entry ("depth_limit",Int,assign $ IVal limit) : treeState_ super
+                     , evalState_  = ("dbs_complete", Bool, const $ return true) : evalState_ super
+		     , pushLeftH   = push pushLeft
+                     , pushRightH  = push pushRight
+                     , toString = "dbs(" ++ show limit ++ "," ++ toString super ++ ")"
+                     , complete = \i -> return $ estate i @=> "dbs_complete"
+                     }
+  where push dir = 
+	  \i -> dir super (i `onCommit` mkUpdate i "depth_limit" (\x -> x - 1)) >>= \stmt ->
+                return $ IfThenElse (tstate (old i) @-> "depth_limit" @>= 0)
+                                    stmt
+                                    ((estate i @=> "dbs_complete" <== false) >>> abort i)
+
+--------------------------------------------------------------------------------
+bbLoop :: Monad m => String -> MkEval m 
+bbLoop var super = return $ commentEval $ super
+  { treeState_  = entry ("tree_bound_version",Int,assign 0) : treeState_ super
+  , evalState_   = ("bound_version",Int,const $ return 0) : ("bound",Int,const $ return $ IVal maxBound) : evalState_ super
+  , returnH     = \i -> returnE super (i `onCommit`
+			   let get = VHook (rp 0 (space i) ++ "->iv[VAR_" ++ var ++ "].min()")
+                           in  (Assign (estate i @=> "bound") get >>> inc (estate i @=> "bound_version"))) 
+  , bodyH = \i -> let set = Post (space i) (VHook (rp 0 (space i) ++ "->iv[VAR_" ++ var ++ "]") $< (estate i @=> "bound"))
+                              in  do r <- bodyE super i
+                                     return $ (ifthen (tstate i @-> "tree_bound_version" @< (estate i @=>"bound_version"))
+                                                      (set >>> (Assign (tstate i @-> "tree_bound_version") ((tstate i @-> "tree_bound_version") + 1)))
+                                                           >>> r)
+  , pushLeftH  = push pushLeft
+  , pushRightH = push pushRight
+  , intVarsE  = var : intVarsE super
+  , complete = const $ return true
+  , toString = "bb(" ++ show var ++ "," ++ toString super ++ ")"
+  }
+  where push dir = \i -> dir super (i `onCommit` mkCopy i "tree_bound_version")
+
+bbmin :: String -> Search
+bbmin var = 
+  Search { mkeval     = bbLoop var 
+         , runsearch  = runIdT
+         }
+
+lds :: Stat -> Search
+lds n = 
+  Search { mkeval     = ldsLoop n
+         , runsearch  = runIdT
+         }
+
+dbs :: Int32 -> Search
+dbs n = 
+  Search { mkeval     = dbsLoop n
+         , runsearch  = runIdT
+         } 
+
diff --git a/Control/Search/Combinator/Once.hs b/Control/Search/Combinator/Once.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Once.hs
@@ -0,0 +1,30 @@
+module Control.Search.Combinator.Once (once, onceOld) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.Memo
+import Control.Search.Stat
+import Control.Search.Combinator.Until
+
+import Control.Monatron.IdT
+
+onceLoop :: MkEval m
+onceLoop super = return $ commentEval $ super
+                 { evalState_  = ("onceMore", Bool, const $ return true) : evalState_ super
+		 , bodyH     = \i -> do goOn <- bodyE super i
+                                        ca <- cachedAbort i
+                                        return $ IfThenElse (estate i @=> "onceMore")
+                                                   goOn
+                                                   ca
+		 , returnH   = \i -> returnE super $ i `onCommit` assign false (estate i @=> "onceMore")
+                 , toString  = "once(" ++ toString super ++ ")"
+                 }
+
+once :: Search
+once = 
+  Search { mkeval     = onceLoop
+         , runsearch  = runIdT
+         } 
+
+onceOld = limit 1 solutionsStat
diff --git a/Control/Search/Combinator/Or.hs b/Control/Search/Combinator/Or.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Or.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.Or ((<|>)) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.MemoReader
+import Control.Search.Memo
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+
+xs1 uid lsuper rsuper       = Struct ("LeftEvalState"  ++ show uid)  $ (THook "TreeState", "parent") : {- (Bool, "cont") : -} (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState_ lsuper]
+xfs1 uid lsuper rsuper       = [(field,init) | (field,ty,init) <- evalState_ lsuper ]
+xs2 uid lsuper rsuper        = Struct ("RightEvalState" ++ show uid) $ xneedSide uid lsuper rsuper SecondS $ {- (Bool, "cont") : -} (Int, "ref_count") : [(ty, field) | (field,ty,_) <- evalState_ rsuper]
+xfs2 uid lsuper rsuper       = [(field,init) | (field,ty,init) <- evalState_ rsuper ]
+xet uid lsuper rsuper FirstS = SType $ xs1 uid lsuper rsuper
+xet uid lsuper rsuper SecondS = SType $ xs2 uid lsuper rsuper
+xs3 uid lsuper rsuper        = Struct ("LeftTreeState"  ++ show uid) $ (Pointer $ SType $ xs1 uid lsuper rsuper, "evalState") : [(ty, field) | (field,ty,_) <- treeState_ lsuper]
+xfs3 uid lsuper rsuper       = [(field,init) | (field,ty,init) <- treeState_ lsuper]
+xs4 uid lsuper rsuper        = Struct ("RightTreeState" ++ show uid) $ xneedSide uid lsuper rsuper SecondS [(Pointer $ SType $ xs2 uid lsuper rsuper, "evalState")] ++ [(ty, field) | (field,ty,_) <- treeState_ rsuper]
+xst uid lsuper rsuper FirstS = SType $ xs3 uid lsuper rsuper
+xst uid lsuper rsuper SecondS = SType $ xs4 uid lsuper rsuper
+xneedSide :: Monoid m => Int -> Eval n -> Eval n -> SeqPos -> m -> m
+xneedSide uid lsuper rsuper = \pos stm -> case pos of { FirstS -> stm;
+                                                       SecondS -> if (length (evalState_ rsuper) == 0) then mempty else stm;
+                                                     }
+
+orLoop :: (ReaderM SeqPos m, Evalable m) => Int -> (Eval m) -> (Eval m) -> Eval m
+orLoop uid (lsuper) (rsuper) = commentEval $
+  Eval { structs     = structs lsuper @++@ structs rsuper @++@ mystructs 
+       , toString    = "or" ++ show uid ++ "(" ++ toString lsuper ++ "," ++ toString rsuper ++ ")"
+       , treeState_   = [entry ("is_fst",Bool,assign true)
+                       , ("or_union",Union [(SType s3,"fst"),(SType s4,"snd")], 
+				\i -> 
+                                   let j = withPath i in1 (et FirstS) (st FirstS)
+                                   in        do cc <- cachedClone i (cloneBase j)
+                                                return (    (estate j <== New s1)
+				                        >>> (ref_count j <== 1)
+--				                        >>> (cont j <== true)
+                                                        >>> (parent j <== baseTstate j)
+                                                        >>> cc
+                                                       )
+                                       @>>>@ mseqs [init (j `withClone` (\k -> inc $ ref_count k)) | (f,init) <- fs3]
+                                       @>>>@ inite fs1 j
+                         )]
+       , initH       = \i -> initE lsuper (withPath i in1 (et FirstS) (st FirstS))
+       , evalState_  = []
+       , pushLeftH    = push pushLeft
+       , pushRightH   = push pushRight
+       , nextSameH    = \i -> let j = i `withBase` "popped_estate"
+                             in do nS1 <- local (const FirstS)  $ inSeq nextSame i
+                                   nS2 <- local (const SecondS) $ inSeq nextSame i
+                                   nD1 <- local (const FirstS)  $ inSeq nextDiff i
+                                   nD2 <- local (const SecondS) $ inSeq nextDiff i
+                                   return $ IfThenElse (is_fst i) 
+                                                       (IfThenElse (is_fst j) nS1 nD1)
+                                                       (IfThenElse (is_fst j) nD2 nS2) 
+       , nextDiffH    = \i -> inSeq nextDiff i
+       , bodyH       = \i ->
+                         let f y z p = 
+                               let j = withPath i y (et p) (st p)
+                                 in dec_ref i >>= \deref -> bodyE z (j `onAbort` deref)
+			 in IfThenElse (is_fst i) @$ local (const FirstS)  (f in1 lsuper FirstS)
+                                                  @. local (const SecondS) (f in2 rsuper SecondS)
+       , addH        = inSeq $ addE
+       , failH       = \i -> inSeq failE i @>>>@ dec_ref i
+       , returnH     = \i -> 
+			     let j1 deref = (withPath i in1 (et FirstS) (st FirstS)) `onCommit` (comment "returnE-deref-j1" >>> deref >>> comment "end returnE-deref-j1")
+                                 j2 deref = (withPath i in2 (et SecondS) (st SecondS)) `onCommit` (comment "returnE-deref-j2" >>> deref >>> comment "end returnE-deref-j2")
+                             in seqSwitch (dec_ref1 i >>= returnE lsuper . j1)
+                                          (dec_ref2 (j2 Skip) >>= returnE rsuper . j2) 
+       , tryH        = \i -> 
+			  do  dr <- dec_ref i
+                              inSeq (\super j -> tryE super (j `onAbort` (comment "Combinator/Or tryH onAbort" >>> dr ))) i
+       , startTryH   = \i -> local (const FirstS) $ inSeq startTryE i
+       , tryLH       = \i -> inSeq tryE_ i @>>>@ dec_ref i
+       , boolArraysE  = boolArraysE lsuper ++ boolArraysE rsuper
+       , intArraysE  = intArraysE lsuper ++ intArraysE rsuper
+       , intVarsE    = intVarsE lsuper ++ intVarsE rsuper
+       , deleteH     = deleteMe
+       , canBranch   = return True
+       , complete    = \i -> do sid1 <- complete lsuper (withPath i in1 (et FirstS) (st FirstS))
+                                sid2 <- complete rsuper (withPath i in2 (et SecondS) (st SecondS))
+                                return $ (Cond (tstate i @-> "is_fst") sid1 sid2)
+
+--       , complete = const $ return false
+       }
+  where mystructs = ([s1,s2],[s3,s4])
+        s1 = xs1 uid lsuper rsuper
+        s2 = xs2 uid lsuper rsuper
+        s3 = xs3 uid lsuper rsuper
+        s4 = xs4 uid lsuper rsuper
+        fs1 = xfs1 uid lsuper rsuper
+        fs2 = xfs2 uid lsuper rsuper
+        fs3 = xfs3 uid lsuper rsuper
+        et = xet uid lsuper rsuper
+        st = xst uid lsuper rsuper
+        needSide = xneedSide uid lsuper rsuper
+        parent    = \i -> estate i @=> "parent"
+        withSeq f = seqSwitch (f lsuper in1 FirstS) (f rsuper in2 SecondS)
+        withSeq_ f = seqSwitch (f lsuper in1 FirstS) (f rsuper in2 SecondS)
+        inSeq f   = \i     -> withSeq_ $ \super ins pos -> f super (withPath i ins (et pos) (st pos))
+        dec_ref    = \i -> seqSwitch (dec_ref1 i) (dec_ref2 $ withPath i in2 (et SecondS) (st SecondS))
+        dec_ref1   = \i ->      let j1     = withPath i in1 (et FirstS) (st FirstS)
+                                    i'     = resetClone $ resetAbort $ resetCommit $ i `withBase` ("or_tstate" ++ show uid)
+                                    j2     = withPath i' in2 (et SecondS) (st SecondS)
+                                in (local (const SecondS) $
+                                    do stmt1 <- inits rsuper j2
+                                       stmt2 <- startTryE rsuper j2
+                                       ini <- inite fs2 j2
+                                       compl <- complete lsuper j1
+				       return (    dec (ref_count j1) 
+                                               >>> (ifthen (ref_count j1 @== 0) $
+                                                      (
+                                                      {- DebugValue ("or" ++ show uid ++ ": left finished with complete") (compl)
+                                                      >>> -} (ifthen (Not compl) $
+				                            (   SHook ("TreeState or_tstate" ++ show uid ++ ";")
+							    >>> (baseTstate j2 <== parent j1)
+                                                            >>> (is_fst i' <== false)
+                                                            >>> comment "orLoop-dec_ref1-Delete" >>> Delete (estate j1)
+                                                            >>> needSide SecondS (estate j2 <== New s2)  
+				                            >>> needSide SecondS (ref_count j2 <== 1)
+--				                            >>> (cont j2 <== true)
+  				                            >>> ini
+                                                            >>> stmt1 >>> stmt2
+                                                            )
+                                                          )
+                                                      )
+                                                   )
+                                              )
+                                   )
+        dec_ref2  = \j -> {- return (DebugValue ("or" ++ show uid ++ ": right dec_ref from") (ref_count j)) @>>>@ -} (complete rsuper (withPath (resetClone $ resetAbort $ resetCommit $ j `withBase` ("or_tstate" ++ show uid)) in2 (et SecondS) (st SecondS)) >>= \compl -> (return $ needSide SecondS $ dec (ref_count j) >>> ifthen (ref_count j @== 0) ({- DebugValue ("or" ++ show uid ++ ": right finished with complete") compl >>> -} comment "orLoop-dec_ref2-Delete" >>> Delete (estate j))))
+        push dir  = \i -> seqSwitch (push1 dir i) (push2 dir i)
+        push1 dir = \i -> 
+                           let j = withPath i in1 (et FirstS) (st FirstS)
+                           in  dir lsuper (j `onCommit` (   mkCopy i "is_fst"
+                                                        >>> mkCopy j "evalState"
+                                                        >>> inc (ref_count j)
+                                                        ))
+        push2 dir = \i -> 
+                           let j = withPath i in2 (et SecondS) (st SecondS)
+                           in  dir rsuper (j `onCommit` (   mkCopy i "is_fst"
+                                                        >>> needSide SecondS (mkCopy j "evalState")
+                                                        >>> needSide SecondS (inc (ref_count j))
+                                                       ))
+	in1       = \state -> state @-> "or_union" @-> "fst"
+	in2       = \state -> state @-> "or_union" @-> "snd"
+	is_fst    = \i -> tstate i @-> "is_fst"
+	deleteMe  = \i -> seqSwitch (deleteE lsuper (withPath i in1 (et FirstS) (st FirstS))) (deleteE rsuper (withPath i in2 (et SecondS) (st SecondS))) @>>>@ dec_ref i
+
+(<|>)
+  :: Search
+  -> Search
+  -> Search
+s1 <|> s2 = 
+  case s1 of
+    Search { mkeval = evals1, runsearch = runs1 } ->
+      case s2 of
+        Search { mkeval = evals2, runsearch = runs2 } ->
+	  Search {mkeval =
+	          \super -> do { s2' <- evals2 $ mapE (L . L . L . mmap (mmap runL . runL) . runL)  super
+	                       ; s1' <- evals1 $ mapE (L . L . mmap (mmap runL . runL) . runL) super
+			       ; uid <- get
+			       ; put (uid + 1)
+	                       ; return $ mapE (L . mmap L . runL) $ 
+			           	orLoop uid (mapE (L . mmap (mmap L) . runL . runL) s1')
+	                                               (mapE (L . mmap (mmap L) . runL . runL . runL) s2')
+	                       }
+	         , runsearch  = runs2 . runs1 . runL . rReaderT FirstS . runL
+	         }
+ where 	in1       = \state -> state @-> "or_union" @-> "fst"
+	in2       = \state -> state @-> "or_union" @-> "snd"
diff --git a/Control/Search/Combinator/OrRepeat.hs b/Control/Search/Combinator/OrRepeat.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/OrRepeat.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.OrRepeat (orRepeat) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.MemoReader
+import Control.Search.Memo
+import Control.Search.Stat
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+
+orRepeatLoop :: (Evalable m, ReaderM Bool m) => Stat -> Int -> Eval m -> Eval m
+orRepeatLoop cond uid super' = commentEval $
+    Eval 
+       { 
+         structs     = structs super @++@ mystructs 
+       , treeState_  = treeState_ super
+       , toString    = "orRepeat" ++ show uid ++ "(" ++ toString super' ++ ")"
+       , initH       = \i -> initE super i @>>>@ return (parent i <== baseTstate i) @>>>@ cachedClone i (cloneBase i)
+       , evalState_  = {- ("cont",Bool,const $ return true) : -} ("ref_count_orr" ++ show uid,Int,const $ return 1) : ("parent",THook "TreeState",const $ return Null) : evalState_ super
+       , pushLeftH    = push pushLeft
+       , pushRightH   = push pushRight
+       , nextSameH    = nextSame super
+       , nextDiffH    = nextDiff super 
+       , bodyH = \i -> dec_ref i >>= \deref -> bodyE super (i `onAbort` deref)
+       , addH        = addE super
+       , failH       = \i -> failE super i @>>>@ dec_ref i
+       , returnH     = \i -> let j deref = i `onCommit` deref
+                             in dec_ref i >>= returnE super . j
+       , tryH        = \i -> do deref <- dec_ref i
+                                tryE super (i `onAbort` deref)
+       , startTryH   = \i -> do deref <- dec_ref i
+                                startTryE super (i `onAbort` deref)
+       , tryLH       = \i -> tryE_ super i @>>>@ dec_ref i
+       , intArraysE  = intArraysE super
+       , boolArraysE  = boolArraysE super
+       , intVarsE    = intVarsE super
+       , deleteH     = error "orRepeatLoop.deleteE NOT YET IMPLEMENTED"
+       , canBranch   = return True
+       , complete    = complete super
+--       , complete = const $ return false
+       }
+  where mystructs = ([],[])
+        super     = evalStat cond super'
+        fs1       = [(field,init) | (field,ty,init) <- evalState_ super]
+        parent    = \i -> estate i @=> "parent"
+        dec_ref    = \i -> let i'     = resetAbort $ resetCommit $ i `withBase` ("orr_tstate" ++ show uid)
+                               ii     = resetAbort $ resetCommit $ i
+                           in do flag <- ask 
+                                 if flag 
+                                   then local (const False) $ do
+                                        stmt1 <- inits super i'
+                                        stmt2 <- startTryE super i'
+                                        r     <- readStat cond
+                                        ini   <- inite fs1 i'
+                                        -- let cc =  clone ii i'
+                                        -- cc  <- cachedClone (cloneBase ii) i'
+                                        cc1 <- cachedClone (i { baseTstate = parent ii} ) i'
+                                        -- cc2 <- cachedClone (i' ) i'
+                                        compl <- complete super ii
+                                        return (dec (ref_countx ii $ "orr" ++ show uid) 
+                                               >>> ifthen (ref_countx ii ("orr" ++ show uid) @== 0) 
+                                                     (ifthen (r i' &&& Not compl)
+                                                           (   SHook ("TreeState orr_tstate" ++ show uid ++ ";")
+                                                           >>> (baseTstate i' <== parent ii)
+                                                           -- >>> ((baseTstate i' @-> "space") <== (parent ii @-> "space"))
+                                                           -- >>> cc
+							   >>> cc1
+							   -- >>> cc2
+                                                           >>> (ref_countx i' ("orr" ++ show uid) <== 1)
+--                                                         >>> (cont i' <== true)
+                                                           >>> ini >>> stmt1 >>> stmt2)
+                                                     ))
+                                   else  return $ dec (ref_countx ii ("orr" ++ show uid)) >>> ifthen (ref_countx ii ("orr" ++ show uid) @== 0) (comment "orRepeatLoop-dec_ref-Delete" >>> Delete (space $ cloneBase ii))
+        push dir  = \i -> dir super (i `onCommit'` inc (ref_countx i $ "orr" ++ show uid))
+
+orRepeat
+  :: Stat
+  -> Search
+  -> Search
+orRepeat cond s  = 
+  case s of
+    Search { mkeval = evals, runsearch = runs } ->
+	  Search { mkeval =
+	           \super ->
+	           do { uid <- get
+	              ; put (uid + 1)
+	              ; s' <- evals $ mapE (L . L . mmap runL . runL) super
+	              ; return $ mapE (L . mmap L . runL) $ orRepeatLoop cond uid (mapE runL s')
+	              }
+	         , runsearch   = runs . rReaderT True . runL
+	         }
diff --git a/Control/Search/Combinator/Post.hs b/Control/Search/Combinator/Post.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Post.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.Post (post) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.Constraints
+
+postLoop :: VarInfoM m => ConstraintGen -> MkEval m -> MkEval m
+postLoop (ConstraintGen c l) par this = do
+  super <- par this
+  return $ commentEval $ super 
+    {   tryH = try tryE super
+      , startTryH = try startTryE super
+      , toString = "post(<CONSTRAINT>," ++ toString super ++ ")"
+      , intVarsE = l ++ intVarsE super
+    }
+ where try f super = \i -> -- failE super i >>= \fail -> -- XXX
+                        f super i >>= \body ->
+                          c i >>= \cc ->
+                            return $ Post (space i) cc >>> body
+--                                     (Var "status" <== VHook (rp 0 (space i) ++ "->status()")) >>>
+--                                     IfThenElse (Var "status" @== VHook "SS_FAILED") (fail >>> comment "Delete-postLoop-try" >>> Delete (space i)) body
+
+
+post :: ConstraintGen -> Search -> Search
+post c s =
+  case s of 
+    Search { mkeval = m, runsearch = r } ->
+      Search { mkeval = postLoop c m
+             , runsearch = r
+             }
diff --git a/Control/Search/Combinator/Print.hs b/Control/Search/Combinator/Print.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Print.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.Print (prt,dbg) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+
+import Control.Monatron.IdT
+
+printLoop :: [String] -> MkEval m
+printLoop lst super = return $ commentEval $ super
+                       { returnH = \i -> returnE super $ i `onCommit` Print (space i) lst
+                       , toString = "print(" ++ toString super ++ ")"
+                       }
+
+debugLoop :: Evalable m => String -> MkEval m
+debugLoop str super = return $ commentEval $ super
+                 { initH = \i -> return (DebugOutput str) @>>>@ initH super i
+                 , toString = "debug(" ++ show str ++ "," ++ toString super ++ ")"
+                 }
+
+prt :: [String] -> Search
+prt l = 
+  Search { mkeval     = printLoop l
+         , runsearch  = runIdT
+         }
+
+dbg :: String -> Search
+dbg str = 
+  Search { mkeval     = debugLoop str
+         , runsearch  = runIdT
+         }
diff --git a/Control/Search/Combinator/Repeat.hs b/Control/Search/Combinator/Repeat.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Repeat.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.Repeat (repeat) where
+
+import Prelude hiding (lex, until, init, repeat)
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.MemoReader
+import Control.Search.Memo
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+
+repeatLoop :: (ReaderM Bool m, Evalable m) => Int -> Eval m -> Eval m
+repeatLoop uid super = commentEval $
+    Eval 
+       { 
+         structs     = structs super @++@ mystructs 
+       , toString    = "repeat" ++ show uid ++ "(" ++ toString super ++ ")"
+       , treeState_  = ("dummy", Int, 
+				\i -> do cc <- cachedClone i (cloneBase i)
+                                         return ((parent i <== baseTstate i)
+                                                 >>> cc
+                                                )
+                       ) : treeState_ super -- `withClone` (\k -> inc $ ref_count k)
+       , initH       = \i -> initE super i
+       , evalState_   = {- ("cont",Bool,const $ return true) : -} ("ref_count",Int,const $ return 1) : ("parent",THook "TreeState",const $ return Null) : evalState_ super
+       , pushLeftH    = push pushLeft
+       , pushRightH   = push pushRight
+       , nextSameH    = nextSame super
+       , nextDiffH    = nextDiff super 
+       , bodyH = \i -> dec_ref i >>= \deref -> bodyE super (i `onAbort` deref)
+       , addH        = addE super
+       , failH       = \i -> failE super i @>>>@ dec_ref i
+       , returnH     = \i -> let j deref = i `onCommit` deref
+                             in dec_ref i >>= returnE super . j
+       , tryH        = tryE super
+       , startTryH   = startTryE super
+       , tryLH       = \i -> tryE_ super i @>>>@ dec_ref i
+       , boolArraysE  = boolArraysE super
+       , intArraysE  = intArraysE super
+       , intVarsE    = intVarsE super
+       , deleteH     = error "repeatLoop.deleteE NOT YET IMPLEMENTED"
+       , canBranch   = canBranch super
+       , complete    = const $ return true
+       }
+  where mystructs = ([],[])
+        fs1       = [(field,init) | (field,ty,init) <- evalState_ super]
+        parent    = \i -> estate i @=> "parent"
+        dec_ref    = \i -> let i'     = resetCommit $ i `withBase` ("repeat_tstate" ++ show uid)
+                           in do flag <- ask 
+                                 if flag 
+                                   then local (const False) $ do
+				 	stmt1 <- inits super i'
+                                 	stmt2 <- startTryE super i'
+                                        ini <- inite fs1 i'
+			         	return (dec (ref_count i) 
+                                               >>> ifthen (ref_count i @== 0) 
+			                           (   SHook ("TreeState repeat_tstate" ++ show uid ++ ";")
+			   			   >>> (baseTstate i' <== parent i)
+						   >>> clone (cloneBase i) i'
+			                           >>> (ref_count i' <== 1)
+--			                           >>> (cont i' <== true)
+  			                           >>> ini >>> stmt1 >>> stmt2))
+                                   else  return $dec (ref_count i) >>> ifthen (ref_count i @== 0) (comment "Delete-repeatLoop-dec_ref" >>> Delete (space $ cloneBase i))
+        push dir  = \i -> dir super (i `onCommit` inc (ref_count i))
+
+repeat 
+  :: Search
+  -> Search
+repeat s = 
+  case s of
+    Search { mkeval = evals, runsearch = runs } ->
+	  Search { mkeval =
+	            \super ->
+	           do { uid <- get
+	              ; put (uid + 1)
+	              ; s' <- evals $ mapE (L . L . mmap runL . runL) super
+	              ; return $ mapE (L . mmap L . runL) $ repeatLoop uid $ mapE runL s' 
+	              }
+	         , runsearch  =  runs . rReaderT True . runL
+	         } 
diff --git a/Control/Search/Combinator/Success.hs b/Control/Search/Combinator/Success.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Success.hs
@@ -0,0 +1,38 @@
+module Control.Search.Combinator.Success (dummy) where
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Generator
+import Control.Search.Memo
+
+import Control.Monatron.IdT
+
+successLoop :: Evalable m => Eval m -> Eval m
+successLoop this = commentEval $
+	    Eval { structs      = ([],[])
+                 , treeState_  = []
+                 , initH       = const $ return Skip
+                 , evalState_  = []
+		 , pushLeftH    = error "succesloop.tyE_"
+		 , pushRightH   = error "succesloop.tyE_"
+	         , nextSameH    = \i -> return Skip
+	         , nextDiffH    = \i -> return Skip
+		 , bodyH       = addE this . resetInfo -- XXX
+                 , addH        = \i -> tryE this (resetInfo i)
+	         , failH      = const $ return Skip
+                 , returnH    = \i -> cachedCommit i
+                                -- const $ return Skip
+--                 , continue   = \_ -> return true
+                 , tryH       = returnE this . resetInfo
+                 , startTryH  = \i -> (return $ comment "<startTryE success>") @>>>@ (returnE this . resetInfo) i @>>>@ (return $ comment "</startTryE succes>")
+                 , tryLH      = error "succesloop.tryE_"
+                 , intArraysE  = []
+                 , boolArraysE    = []
+                 , intVarsE    = []
+		 , deleteH     = \i -> return Skip
+                 , toString = "succeed"
+                 , canBranch   = return False
+                 , complete = const $ return true
+                 }
+
+dummy = Search { mkeval = return . successLoop, runsearch = runIdT }
diff --git a/Control/Search/Combinator/Until.hs b/Control/Search/Combinator/Until.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Combinator/Until.hs
@@ -0,0 +1,188 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.Search.Combinator.Until (until,limit,glimit) where
+
+import Prelude hiding (until)
+import Data.Int
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.MemoReader
+import Control.Search.Generator
+import Control.Search.Combinator.Failure
+import Control.Search.Stat
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+
+untilLoop :: (Evalable m, ReaderM SeqPos m) => Stat -> Int -> (Eval m) -> (Eval m) -> Eval m
+untilLoop cond uid lsuper' rsuper = commentEval c
+ where c = Eval { structs     = structs lsuper @++@ structs rsuper @++@ mystructs 
+                , toString    = "until" ++ show uid ++ "(" ++ show cond ++ "," ++ toString lsuper' ++ "," ++ toString rsuper ++ ")"
+                , treeState_   = [entry ("is_fst",Bool,assign true)
+                                ,("until_union", Union [(SType s3,"fst"),(SType s4,"snd")], 
+         				 \i -> 
+                                            let j = xpath i FirstS
+                                            in  initSubEvalState j s1 fs1 FirstS)
+                                ]
+                , initH       = \i -> inits lsuper (i `xpath` FirstS)
+                , evalState_  = [("until_complete",Bool,const $ return true)]
+                , pushLeftH    = push pushLeft
+                , pushRightH   = push pushRight
+                , nextSameH    = \i -> let j = i `withBase` "popped_estate"
+                                      in do let nS1 = local (const FirstS)  $ inSeq nextSame i
+                                            let nS2 = local (const SecondS) $ inSeq nextSame i
+                                            let nD1 = local (const FirstS)  $ inSeq nextDiff i
+                                            let nD2 = local (const SecondS) $ inSeq nextDiff i
+                                            swfst i (swfst j nS1 nD1) (swfst j nD2 nS2)
+                , nextDiffH    = inSeq nextDiff
+                , -- MAIN ENTRY POINT FOR NEW NODE
+                  --   if (fst) {
+                  --       if (seq_union.fst.evalState->cont) {
+                  --       } else {
+         	 --       }
+                  --   } else {
+                  --       if (seq_union.snd.evalState->cont) {
+                  --       } else {
+         	 --	  }
+                  --   }
+         	 bodyH       = \i -> 
+                                 let f y z iscomplete pos = 
+                                       do compl <- iscomplete (i `xpath` pos)
+                                          let j = i `xpath` pos `onAbort` (comment "untilLoop.bodyE" >>> dec_ref i j compl pos)
+                                          bodyE z j
+         			 in do let s1 = local (const FirstS)  $ f in1 lsuper liscomplete FirstS
+                                           s2 = local (const SecondS) $ f in2 rsuper riscomplete SecondS
+                                       swfst i s1 s2
+                , addH        = inSeq $ addE
+                , failH       = \i -> inSeq' (\super j iscomplete pos -> iscomplete j >>= \compl -> (failE super j @>>>@ return (dec_ref i j compl pos))) i
+                , returnH     = \i -> inSeq' (\super j iscomplete pos -> iscomplete j >>= \compl -> (returnE super (j `onCommit` dec_ref i j compl pos))) i
+--                , continue    = \_ -> return true
+                 -- IF THE CURRENT STATUS IS NOT FAILED
+         	 -- EITHER (is_fst)
+         	 --   if (<CONDITION>) {   // SWITCH TO NEW SEARCH
+         	 --   } else {
+         	 --       <TRY-REC>
+          	 --   }
+         	 -- OR      (!is_fst)
+                , tryH        = tryX tryE
+                , startTryH   = tryX startTryE
+                , tryLH       = \i -> inSeq' (\super j iscomplete pos -> iscomplete j >>= \compl -> (tryE_ super j @>>>@ return (dec_ref i j compl pos))) i
+                , boolArraysE  = boolArraysE lsuper ++ boolArraysE rsuper
+                , intArraysE  = intArraysE lsuper ++ intArraysE rsuper
+                , intVarsE    = intVarsE lsuper ++ intVarsE rsuper
+                , deleteH     = error "untilLoop.deleteE NOT YET IMPLEMENTED"
+                , canBranch   = canBranch lsuper >>= \l -> canBranch rsuper >>= \r -> return (l || r)
+                , complete = \i -> return $ estate i @=> "until_complete"
+--                , complete = const $ return false
+                }
+       needSide_ = \pos stmY stmN -> case pos of { FirstS -> if (length (evalState_ lsuper) == 0) then stmN else stmY;
+                                                   SecondS -> if (length (evalState_ rsuper) == 0) then stmN else stmY;
+                                                 }
+       needSide :: Monoid m => SeqPos -> m -> m
+       needSide = \pos stm -> needSide_ pos stm mempty
+       mystructs = ([s1,s2],[s3,s4])
+       s1        = Struct ("LeftEvalState"  ++ show uid)  $ needSide FirstS $ {- (Bool, "cont") : -} (Int, "ref_count_until" ++ show uid) : [(ty, field) | (field,ty,_) <- evalState_ lsuper]
+       fs1       = [(field,init) | (field,ty,init) <- evalState_ lsuper ]
+       s2        = Struct ("RightEvalState" ++ show uid) $ needSide SecondS $ {- (Bool, "cont") : -} (Int, "ref_count_until" ++ show uid) : [(ty, field) | (field,ty,_) <- evalState_ rsuper]
+       fs2       = [(field,init) | (field,ty,init) <- evalState_ rsuper ]
+       s3        = Struct ("LeftTreeState"  ++ show uid) $ needSide FirstS [(Pointer $ SType s1, "evalState")] ++ [(ty, field) | (field,ty,_) <- treeState_ lsuper]
+       fs3       = [(field,init) | (field,ty,init) <- treeState_ lsuper]
+       s4        = Struct ("RightTreeState" ++ show uid) $ needSide SecondS [(Pointer $ SType s2, "evalState")] ++ [(ty, field) | (field,ty,_) <- treeState_ rsuper]
+       xpath i FirstS  = withPath i in1 (Pointer $ SType s1) (Pointer $ SType s3)
+       xpath i SecondS  = withPath i in2 (Pointer $ SType s2) (Pointer $ SType s4)
+       in1       = \state -> state @-> "until_union" @-> "fst"
+       in2       = \state -> state @-> "until_union" @-> "snd"
+       is_fst    = \i -> tstate i @-> "is_fst"
+       withSeq f = seqSwitch (f lsuper in1) (f rsuper in2)
+       withSeq_ f = seqSwitch (f lsuper in1 FirstS) (f rsuper in2 SecondS)
+       inSeq  f  = \i -> withSeq_ $ \super ins pos -> f super (i `xpath` pos)
+       inSeq' f  = \i -> seqSwitch (f lsuper (i `xpath` FirstS) liscomplete FirstS)  
+                                   (f rsuper (i `xpath` SecondS) riscomplete SecondS)
+       dec_ref   = \i j iscomplete pos -> needSide_ pos (dec (ref_countx j $ "until" ++ show uid) >>>
+                                                         ifthen (ref_countx j ("until" ++ show uid) @== 0) (
+                                                        {-       DebugValue ("until" ++ show uid ++ ": left branch finished with complete") iscomplete
+                                                           >>> DebugValue ("until" ++ show uid ++ ": until's previous completeness was") (complet i)
+                                                           >>> -} (complet i <== (complet i &&& iscomplete)) >>> Delete (estate j)
+                                                         )
+                                                        ) (complet i <== (complet i &&& iscomplete))
+       push dir  = \i -> seqSwitch (push1 dir i) (push2 dir i)
+       push1 dir = \i -> 
+                          let j = i `xpath` FirstS
+                          in  dir lsuper (j `onCommit` (   mkCopy i "is_fst"
+                                                       >>> mkCopy j "evalState"
+                                                       >>> inc (ref_countx j $ "until" ++ show uid)
+                                                       ))
+       push2 dir = \i -> 
+                          let j = i `xpath` SecondS
+                          in  dir rsuper (j `onCommit` (    mkCopy i "is_fst"
+                                                       >>> mkCopy j "evalState"
+                                                       >>> inc (ref_countx j $ "until" ++ show uid)
+                                                      ))
+       lsuper = evalStat cond lsuper'
+       complet  = \i -> estate i @=> "until_complete"
+       liscomplete = complete lsuper'
+       riscomplete = complete rsuper
+       initSubEvalState = \j s fs pos -> return (needSide pos (    (estate j <== New s)  
+					                       >>> (ref_countx j ("until" ++ show uid) <== 1)
+--			                                       >>> (cont j <== true)
+                                                              )
+                                                )
+                                         @>>>@ inite fs j
+       tryX        = \x i -> do lc <- liscomplete (i `xpath` FirstS)
+                                rc <- riscomplete (i `xpath` SecondS)
+                                let j1  = i `xpath` FirstS `onAbort` (comment "untilLoop.tryE j1" >>> dec_ref i j1 lc FirstS)
+                                    j2  = i `xpath` SecondS `onAbort` (comment "untilLoop.tryE j2" >>> dec_ref i j2 rc SecondS)
+                                    j2b = i `xpath` SecondS `onAbort` (comment "untilLoop.tryE j2b" >>> dec_ref i j2b rc SecondS)
+                                seqSwitch (x       lsuper j1 >>= \try1 ->
+                                                   deleteE lsuper j1 >>= \delete1 ->
+                                                   (local (const SecondS) $
+                                                     do stmt1 <- inits rsuper j2b
+                                                        stmt2 <- startTryE rsuper j2b
+                                                        ini <- initSubEvalState j2b s2 fs2 SecondS
+                                                        return (   delete1
+         						      >>> dec_ref i j1 lc FirstS
+                                                     	      >>> (is_fst i <== false)
+         						      >>> ini
+                                                               >>> comment "initTreeState_ j2b rsuper" 
+         						      >>> stmt1 
+                                                               >>> comment "tryE rsuper j2b" 
+         						      >>> comment ("length: " ++ show (length (abort_ j2b)))
+         						      >>> stmt2)
+                                                   ) >>= \start2 -> readStat cond >>= \r -> return $ IfThenElse (r j1) ({- (DebugOutput $ "until" ++ show uid ++ " switches") >>> -} start2) try1
+                                                  )
+                                                  (x rsuper j2) 
+       swfst i t e = do  b1 <- canBranch lsuper
+                         b2 <- canBranch rsuper
+                         if (b1 && b2) then do { tt <- t; ee <- e; return $ IfThenElse (is_fst i) tt ee }
+                                       else if b1 then t
+                                                  else e
+
+
+limit :: Int32 -> Stat -> Search -> Search
+limit n stat s = until (stat #>= constStat (const (IVal n))) s failure
+
+glimit :: Stat -> Search -> Search
+glimit cond s = until (cond) s failure
+
+until 
+  :: Stat
+  -> Search
+  -> Search
+  -> Search
+until cond s1 s2 = 
+  case s1 of
+    Search { mkeval = evals1, runsearch = runs1 } ->
+      case s2 of
+        Search { mkeval = evals2, runsearch = runs2 } ->
+	  Search { mkeval =
+	          \super -> do { s2' <- evals2 $ mapE (L . L . L . mmap (mmap runL . runL) . runL)  super
+	                       ; s1' <- evals1 $ mapE (L . L . mmap (mmap runL . runL) . runL) super
+		   	       ; uid <- get
+		   	       ; put (uid + 1)
+	                       ; return $ mapE (L . mmap L . runL) $ memoLoop $
+		   			untilLoop cond uid (mapE ({- L . mmap (mmap L) . runL . runL-} mmap L . runL) s1')
+	                                                      (mapE ({- L . mmap (mmap L) . runL . runL . runL-} mmap L . runL . runL) s2')
+	                       }
+	         , runsearch  = runs2 . runs1 . runL . rReaderT FirstS . runL
+	         } 
diff --git a/Control/Search/Constraints.hs b/Control/Search/Constraints.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Constraints.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverlappingInstances #-}
+
+module Control.Search.Constraints
+  ( clvar, cvar, cvars, cbvars, cval, cop, ctrue, cfalse, cexprStatVal, cexprStatMed, cexprStatMin, cexprStatMax
+  , ConstraintExpr(..), ConstraintGen(..)
+  ) where
+
+import Text.PrettyPrint hiding (space)
+import List (sort, nub, sortBy)
+import Unsafe.Coerce
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Memo
+import Control.Search.Stat
+import Control.Search.Generator
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+import Control.Monatron.IdT
+
+import Data.Maybe (fromJust)
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Control.Search.SStateT
+
+data ConstraintExpr = ConstraintExpr (forall m. VarInfoM m => m IValue) Bool [String]
+
+data ConstraintGen = ConstraintGen (forall m. VarInfoM m => Info -> m Constraint) [String]
+
+cvars :: String -> Integer -> ConstraintExpr
+cvars v n = ConstraintExpr (return $ \i -> (AVarElem v (space i) (fromInteger n))) True [v]
+
+cbvars :: String -> Integer -> ConstraintExpr
+cbvars v n = ConstraintExpr (return $ \i -> (BAVarElem v (space i) (fromInteger n))) True [v]
+
+cvar :: String -> ConstraintExpr
+cvar v = ConstraintExpr (return $ \i -> (IVar v (space i))) True [v]
+
+cval :: Integer -> ConstraintExpr
+cval i = ConstraintExpr (return $ const $ fromInteger i) False []
+
+clvar :: VarId -> ConstraintExpr
+clvar v@(VarId n) = ConstraintExpr (do inf <- lookupVarInfo v
+                                       return $ const $ estate inf @=> ("var" ++ show n)
+                                   ) False []
+
+cop :: ConstraintExpr -> (Value -> Value -> Constraint) -> ConstraintExpr -> ConstraintGen
+cop (ConstraintExpr v1 _ l1) op (ConstraintExpr v2 _ l2) = ConstraintGen (\info -> (v1 >>= \x -> v2 >>= \y -> return (x info `op` y info))) (l1 ++ l2)
+
+ctrue :: ConstraintGen
+ctrue = ConstraintGen (const $ return TrueC) []
+
+cfalse :: ConstraintGen
+cfalse = ConstraintGen (const $ return FalseC) []
+
+cexprStat f (ConstraintExpr m c l) = Stat (\e -> e { intVarsE = l ++ intVarsE e }) (m >>= \iv -> return (\info -> (if c then iv info @-> (f ++ "()") else iv info)))
+cexprStatVal = cexprStat "val"
+cexprStatMin = cexprStat "min"
+cexprStatMax = cexprStat "max"
+cexprStatMed = cexprStat "med"
+
+
diff --git a/Control/Search/Generator.hs b/Control/Search/Generator.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Generator.hs
@@ -0,0 +1,855 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Control.Search.Generator
+  ( (<@>)
+  , mmap
+  , search
+  , ($==)
+  , ($/=)
+  , ($<) 
+  , ($<=)
+  , ($>) 
+  , ($>=)
+  , (@>)
+  , VarId(..)
+
+  , mapE, Eval(..), inite, seqSwitch, VarInfoM(..), MkEval, Evalable
+  , SeqPos(..), Search(..), (@.), (@$), (@>>>@)
+  , ref_count, ref_countx, ref_count_type, commentEval, (@++@)
+  , entry, numSwitch, SearchCombiner(..)
+  , buildCombiner, extractCombiners
+  , memo
+  , memoLoop {- ,MemoWrapper, runMemoWrapper-}
+  , rReaderT
+#ifndef NOMEMO
+  , cacheStatement
+#endif
+  , cloneBase
+  , mkCopy, mkUpdate, rp, inits, mseqs
+  , cachedCommit, cachedAbort, cachedClone
+  , nextSame, nextDiff, pushLeft, pushRight, bodyE, addE, returnE, initE, failE, tryE, startTryE, tryE_, deleteE
+  ) where
+
+import Debug.Trace
+
+import Text.PrettyPrint hiding (space)
+import List (sort, nub, sortBy)
+import Data.List (intercalate)
+import Data.Unique
+import Unsafe.Coerce
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+#ifndef NOMEMO
+import Control.Search.Memo
+import Control.Search.MemoReader
+#endif
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+import Control.Monatron.MonadInfo
+import Control.Monatron.IdT
+
+import Data.Maybe (fromJust)
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Control.Search.SStateT
+
+modify :: StateM s f => (s -> s) -> f ()
+modify f = get >>= put . f
+
+newtype GenModeT m a = GenModeT { unGenModeT :: ReaderT GenMode m a }
+  deriving (MonadT, ReaderM GenMode, FMonadT)
+
+class Monad m => GenModeM m where
+  getFlags :: m PrettyFlags
+  getMode :: m GenMode
+  getFlags = getMode >>= return . PrettyFlags
+
+instance MonadInfoT GenModeT where
+  tminfo x = miInc "GenModeT" $ minfo (runReaderT undefined (unGenModeT x))
+
+instance Monad m => GenModeM (GenModeT m) where
+  getMode = GenModeT ask
+
+instance (GenModeM m, FMonadT t) => GenModeM (t m) where
+  getMode = lift getMode
+
+runGenModeT :: GenMode -> GenModeT m a -> m a
+runGenModeT m (GenModeT r) = runReaderT m r
+
+type TreeState = Value
+
+newtype VarId = VarId Int
+  deriving (Ord, Eq, Show)
+
+type VarInfo = Map VarId Info
+
+newtype VarInfoT m a = VarInfoT { unVarInfoT :: SStateT VarInfo m a }
+  deriving (MonadT,StateM VarInfo, FMonadT)
+
+instance MonadInfoT VarInfoT where
+  tminfo x = miInc "VarInfoT" $ minfo (runSStateT undefined (unVarInfoT x))
+
+class Monad m => VarInfoM m where
+  lookupVarInfo :: VarId -> m Info
+  setVarInfo :: VarId -> Info -> m ()
+
+instance Monad m => VarInfoM (VarInfoT m) where
+  lookupVarInfo var = VarInfoT $ get >>= return . fromJust . Map.lookup var
+  setVarInfo var val = VarInfoT $ get >>= \tbl -> (put $ Map.insert var val tbl)
+
+instance (VarInfoM m, FMonadT t) => VarInfoM (t m) where
+  lookupVarInfo = lift . lookupVarInfo
+  setVarInfo var val = lift (setVarInfo var val)
+
+#ifdef NOMEMO
+class (VarInfoM m, HookStatsM m, MonadInfo m, GenModeM m, Functor m) => Evalable m
+instance (VarInfoM m, HookStatsM m, MonadInfo m, GenModeM m, Functor m) => Evalable m
+#else
+class (VarInfoM m, HookStatsM m, MonadInfo m, MemoM m, GenModeM m, Functor m) => Evalable m
+instance (VarInfoM m, HookStatsM m, MonadInfo m, MemoM m, GenModeM m, Functor m) => Evalable m
+#endif
+
+data Eval m = Eval 
+                 { structs    :: ([Struct],[Struct])                        -- auxiliary type declarations
+                 , treeState_ :: [(String,Type, Info -> m Statement)]        -- tree state fields (name, type, init)
+                 , evalState_  :: [(String,Type, Info -> m Value)]
+		 , nextSameH   :: Info -> m Statement
+		 , nextDiffH   :: Info -> m Statement
+                 , pushLeftH   :: Info -> m Statement
+                 , pushRightH  :: Info -> m Statement
+		 , bodyH      :: Info -> m Statement
+                 , initH      :: Info -> m Statement
+                 , addH       :: Info -> m Statement
+		 , returnH    :: Info -> m Statement
+	         , failH      :: Info -> m Statement
+                 , tryH       :: Info -> m Statement
+                 , tryLH      :: Info -> m Statement
+                 , startTryH  :: Info -> m Statement
+                 , intArraysE :: [String]
+                 , boolArraysE :: [String]
+                 , intVarsE   :: [String]
+ 		 , -- Free heap allocated memory for search heuristic associated to this node
+		   -- because it is being abandoned.
+		   --
+		   -- BE CAREFUL: deallocate memory only once in case of multiple references.
+		   --
+		   -- Example use case: untilLoop
+		   deleteH    :: Info -> m Statement
+                 , toString   :: String
+                 , canBranch  :: m Bool
+                 , complete   :: Info -> m Value
+                 }
+
+commentStatement :: (HookStatsM m) => String -> Eval m -> (Info -> m Statement) -> (Info -> m Statement)
+#ifdef OUTPUTCOMMENTS
+commentStatement c e f = \x -> (f x >>= \s -> return (DebugOutput ("begin: " ++ c ++ " @ " ++ toString e) >>> s >>> DebugOutput ("end:   " ++ c ++ " @ " ++ toString e)))
+#else 
+commentStatement c e f = \x -> (f x >>= \s -> return (comment ("begin: " ++ c ++ " @ " ++ toString e) >>> s >>> comment ("end:   " ++ c ++ " @ " ++ toString e)))
+#endif
+
+commentEval :: Evalable m => Eval m -> Eval m
+#ifdef COMMENTS
+commentEval e = 
+          e    { treeState_ = map (\(a,b,c) -> (a,b,commentStatement "treeState" e c)) (treeState_ e)
+               , nextSameH = commentStatement "nextSame" e (nextSame e)
+               , nextDiffH = commentStatement "nextDiff" e (nextDiff e)
+               , pushLeftH = commentStatement "pushLeft" e (pushLeft e)
+               , pushRightH = commentStatement "pushRight" e (pushRight e)
+               , bodyH = commentStatement "bodyE" e (bodyE e)
+               , initH = commentStatement "initE" e (initE e)
+               , addH = commentStatement "addE" e (addE e)
+               , returnH = commentStatement "returnE" e (returnE e)
+               , failH = commentStatement "failE" e (failE e)
+               , tryH = commentStatement "tryE" e (tryE e)
+               , tryLH = commentStatement "tryE_" e (tryE_ e)
+               , deleteH = commentStatement "deleteE" e (deleteE e)
+               , startTryH = commentStatement "startTryE" e (startTryE e)
+               }
+#else
+commentEval = id
+#endif
+
+entry :: Monad m => (String,Type,Value -> Statement) -> (String,Type,Info -> m Statement)
+entry (name,ty,up) = (name, ty, \i -> return (up $ (@->name) $ tstate i))
+
+rootEntry :: Monad m => [(String,Type,Info -> m Statement)]
+rootEntry = [ entry ("space",Pointer SpaceType,assign RootSpace)
+            ]
+
+inits :: Evalable m => Eval m -> Info -> m Statement
+inits e i = initTreeState_ i e @>>>@ initH e i
+
+inite :: Monad m => [(String,Info -> m Value)] -> Info -> m Statement
+inite fs i = mseqs [init i >>= \ini -> return (estate i @=> f <== ini) | (f,init) <- fs]
+
+mkCopy   i f   = (tstate i @-> f) <==   (tstate (old i) @-> f)
+mkUpdate i f g = (tstate i @-> f) <== g (tstate (old i) @-> f)
+
+mseqs lst = sequence lst >>= \s -> return (seqs s)
+
+mapE :: (HookStatsM m, HookStatsM n) => (forall x. m x -> n x) -> Eval m -> Eval n
+mapE x = mapE_ (const x)
+
+data HookStat = HookStat { nCalls :: Integer }
+
+newtype HookStatsT m a = HookStatsT { unHookStatsT :: StateT HookStat m a }
+  deriving (Monad, StateM HookStat, FMonadT, MonadT)
+
+runHookStatsT :: Monad m => HookStatsT m a -> m (a, Integer)
+runHookStatsT m = do
+  (a, s) <- runStateT (HookStat { nCalls = 0 }) $ unHookStatsT m
+  return (a, nCalls s)
+
+instance MonadInfoT HookStatsT where
+  tminfo = miInc "HookStatsT" . minfo . runHookStatsT
+
+class Monad m => HookStatsM m where
+  hookCalled :: m ()
+
+instance Monad m => HookStatsM (HookStatsT m) where
+  hookCalled = modify (\st -> st { nCalls = 1 + nCalls st })
+
+instance (MonadT t, HookStatsM m) => HookStatsM (t m) where
+  hookCalled = lift hookCalled
+
+callHook :: HookStatsM m => String -> Eval m -> Info -> m ()
+callHook s e i = hookCalled
+
+nextSame, nextDiff, pushLeft, pushRight, bodyE, addE, returnE, initE, failE, tryE, startTryE, tryE_, deleteE :: HookStatsM m => Eval m -> Info -> m Statement
+nextSame e i = callHook "nextSame" e i >> nextSameH e i
+nextDiff e i = callHook "nextDiff" e i >> nextDiffH e i
+pushLeft e i = callHook "pushLeft" e i  >> pushLeftH e i
+pushRight e i = callHook "pushRight" e i  >> pushRightH e i
+bodyE e i = callHook "body" e i  >> bodyH e i
+addE e i = callHook "add" e i  >> addH e i
+returnE e i = callHook "return" e i  >> returnH e i
+initE e i = callHook "init" e i >> initH e i
+failE e i = callHook "fail" e i >> failH e i
+tryE e i = callHook "try" e i >> tryH e i
+startTryE e i = callHook "startTry" e i  >> startTryH e i
+tryE_ e i = callHook "tryL" e i  >> tryLH e i
+deleteE e i = callHook "deleteH" e i  >> deleteH e i
+
+mapE_ :: (HookStatsM m, HookStatsM n) => (forall x. Maybe Info -> m x -> n x) -> Eval m -> Eval n
+mapE_ f e =
+  Eval { structs    = structs e
+       , treeState_  = map (\(s,t,m) -> (s,t,\i -> f (Just i) (m i))) (treeState_ e)
+       , evalState_ = map (\(s,t,m) -> (s,t,\i -> f (Just i) (m i))) (evalState_ e)
+       , nextSameH  = \i -> f (Just i) (nextSame e i)
+       , nextDiffH  = \i -> f (Just i) (nextDiff e i)
+       , pushLeftH  = \i -> f (Just i) (pushLeft e i)
+       , pushRightH = \i -> f (Just i) (pushRight e i)
+       , bodyH      = \i -> f (Just i) (bodyE e i)
+       , addH       = \i -> f (Just i) (addE e i)
+       , returnH    = \i -> f (Just i) (returnE e i)
+       , initH      = \i -> f (Just i) (initE e i)
+       , failH      = \i -> f (Just i) (failE e i)
+       , tryH       = \i -> f (Just i) (tryE e i)
+       , startTryH  = \i -> f (Just i) (startTryE e i)
+       , tryLH      = \i -> f (Just i) (tryE_ e i)
+       , boolArraysE = boolArraysE e
+       , intArraysE = intArraysE e
+       , intVarsE   = intVarsE e
+       , deleteH    = \i -> f (Just i) (deleteE e i)
+       , toString   = toString e
+       , canBranch  = f Nothing $ canBranch e
+       , complete   = \i -> f (Just i) (complete e i)
+       }  
+
+--------------------------------------------------------------------------------
+-- SEARCH TRANSFORMERS
+--------------------------------------------------------------------------------
+
+#ifndef NOMEMO
+buildMemoKey :: MemoM m => String -> Maybe (Eval m) -> Maybe Statement -> Info -> m MemoKey
+buildMemoKey fn (Just e) _ i = do 
+  t <- getMemo
+  return $ MemoKey { memoFn = fn, memoInfo = Just i , memoStack = Just (toString e), memoExtra = Just (memoRead t), memoStatement = Nothing, memoParams = map fst (stackField i) }
+buildMemoKey fn Nothing (Just s) i = do
+  return $ MemoKey { memoFn = fn, memoInfo = Nothing, memoStack = Nothing          , memoExtra = Nothing          , memoStatement = Just s , memoParams = map fst (stackField i)  }
+
+lookupMemo :: Evalable m => String -> Maybe (Eval m) -> Maybe Statement -> Info -> m (Maybe MemoValue)
+lookupMemo fn e s i = 
+  do t <- getMemo
+     key <- buildMemoKey fn e s i
+     let r = Map.lookup key $ memoMap t
+     case r of
+       Nothing -> return ()
+       Just k -> setMemo $ t { memoMap = Map.adjust (\x -> x { memoUsed = memoUsed x + 1 }) key (memoMap t) }
+     return r
+
+insertMemo :: Evalable m => String -> Maybe (Eval m) -> Statement -> (Int -> ([(String,Type,Value)], m Statement)) -> Info -> m MemoValue
+insertMemo fn e s sm i =
+  do t <- getMemo
+     fl <- getFlags
+     let n = memoCount t
+     let (lst,ss) = sm n
+     let ni = i { stackField = stackField i ++ (map (\(n,t,v) -> (rpx 0 fl t, n)) lst) }
+     key <- buildMemoKey fn e (Just s) ni
+     s2 <- ss
+     let val = MemoValue { memoId = n
+                         , memoCode = s2
+                         , memoUsed = 1
+                         , memoFields = stackField ni
+                         }
+     setMemo $ t { memoMap = Map.insert key val $ memoMap t
+                 , memoCount = n+1
+                 }
+     return val
+
+invokeMemo :: Evalable m => String -> Eval m -> (Eval m -> (Info -> m Statement)) -> (Info -> m Statement)
+invokeMemo fn e x i = 
+  do let def = x e
+     r <- lookupMemo fn (Just e) Nothing i
+     val <- case r of
+              Nothing -> do val <- def i
+                            case val of
+                              Skip -> return Nothing
+                              _ -> do num <- insertMemo fn (Just e) val (const ([],return val)) i
+                                      return $ Just num
+              Just val -> return $ Just val
+     case val of
+       Nothing -> return Skip
+       Just x -> cacheCall (fn ++ show (memoId x)) (stackField i) []
+
+-- cacheCall :: String -> Info -> Statement
+cacheCall :: Evalable m => String -> [(String,String)] -> [Value] -> m Statement
+cacheCall fn i lst = do
+  fl@(PrettyFlags pf) <- getFlags
+  return $ SHook (fn ++ "(" ++ intercalate "," (map snd (fixArgs pf) ++ (map snd i) ++ (map (rpx 0 fl) lst)) ++ ");")
+
+cacheStatement_ :: Evalable m => String -> (Int -> ([(String,Type,Value)], m Statement)) -> Info -> m Statement
+cacheStatement_ fn sm i = 
+  do let (olst,ss) = sm 0
+     fl <- getFlags
+     let ni = i { stackField = stackField i ++ (map (\(n,t,v) -> (rpx 0 fl t, n)) olst) }
+     s <- ss
+     x <- lookupMemo fn Nothing (Just s) ni
+     val <- case x of
+              Nothing -> do case s of
+                              Skip -> return Nothing
+                              _ -> do num <- insertMemo fn Nothing s sm i
+                                      return $ Just num
+              Just r -> return $ Just r
+     case val of
+       Nothing -> return Skip
+       Just x -> do let (lst,_) = sm (memoId x)
+                    cacheCall (fn ++ show (memoId x)) (stackField i) (map (\(n,t,v) -> v) lst)
+
+cacheStatement :: Evalable m => String -> Statement -> Info -> m Statement
+cacheStatement fn s i = cacheStatement_ fn (const ([],return s)) i
+
+{-
+newtype MemoWrapper m a = MemoWrapper { runMemoWrapper :: m a }
+
+instance MonadT MemoWrapper where
+  lift = MemoWrapper
+  treturn = MemoWrapper . return
+  tbind (MemoWrapper a) f = MemoWrapper (a >>= (\x -> runMemoWrapper (f x)))
+
+instance FMonadT MemoWrapper where
+  tmap' d1 _d2 g f       = MemoWrapper . f . fmapD d1 g . runMemoWrapper
+-}
+
+class Memoable m where
+  memox :: String -> Info -> (Int -> ([(String,Type,Value)],m)) -> m
+
+instance Memoable m => Memoable ((Type,Value) -> m) where
+  memox name info f = \(typ,val) -> 
+    case typ of 
+      THook "void" -> memox name info (\n -> let (lst,m) = f n in (lst,m (typ,Var "WTF??")))
+      _ ->            memox name info (\n -> let (lst,m) = f n in (((nam n lst,typ,val):lst),m (typ,Var $ nam n lst)))
+   where nam n lst = "arg_" ++ name ++ "_" ++ show n ++ "_" ++ show (length lst)
+
+{-
+instance Memoable m => Memoable (Value -> m) where
+  memox name info f = \val -> memox name info (\n -> let (lst,m) = f n in (((nam n lst,Pointer (THook "void"),val):lst),m (Var $ nam n lst)))
+    where nam n lst = "arg_" ++ name ++ "_" ++ show n ++ "_" ++ show (length lst)
+-}
+
+instance Evalable m => Memoable (m Statement) where
+  memox name info f = cacheStatement_ ("cached_" ++ name) f info
+
+memo :: Memoable m => String -> Info -> m -> m
+memo name info m = memox name info (const ([],m))
+-- memo name info m = m
+
+
+
+memoLoop super =
+  super { startTryH = invokeMemo "startTry" super startTryE 
+        , bodyH = invokeMemo "body" super bodyE 
+        , failH = invokeMemo "fail" super failE
+        , tryH = invokeMemo "try" super tryE 
+        , addH = invokeMemo "add" super addE 
+        , returnH = invokeMemo "ret" super returnE
+        , tryLH = invokeMemo "try_" super tryE_
+        , initH = invokeMemo "init" super initE
+        , pushLeftH = invokeMemo "pushL" super pushLeft
+        , pushRightH = invokeMemo "pushR" super pushRight
+        , deleteH = invokeMemo "delete" super deleteE
+        , nextSameH = invokeMemo "nextSame" super nextSame
+        , nextDiffH = invokeMemo "nextDiff" super nextDiff
+        }
+
+cachedCommit :: Evalable m => Info -> m Statement
+cachedCommit i = return (comment "begin commit") @>>>@ cacheStatement "commit" (commit i) i @>>>@ return (comment "end commit")
+
+cachedAbort :: Evalable m => Info -> m Statement
+cachedAbort i = return (comment "begin abort") @>>>@ cacheStatement "abort" (abort i) i @>>>@ return (comment "end abort")
+
+-- cachedClone :: MemoM m => Info -> Info -> m Statement
+cachedClone i j = return (comment "begin clone") @>>>@ cacheStatement "clone" (cloneIt i j) i @>>>@ return (comment "end clone")
+-- cachedClone i j = return $ clone i j
+
+rReaderT x m = runMemoReaderT x m
+#else
+
+cachedCommit x = return $ (comment "begin commit" >>> commit x >>> comment "end commit")
+cachedAbort x = return $ (comment "begin abort" >>> abort x >>> comment "end abort")
+cachedClone i j = return $ (comment "begin clone" >>> cloneIt i j >>> comment "end clone")
+memo :: String -> Info -> m -> m
+memo name info m = m
+memoLoop = id
+rReaderT = runReaderT
+#endif
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+data SeqPos = OutS | FirstS | SecondS
+  deriving (Show)
+
+seqSwitch :: ReaderM SeqPos m => m a -> m a -> m a
+seqSwitch l r = 
+                do flag <- ask
+                   case flag  of 
+                     FirstS  -> l
+                     SecondS -> r
+
+numSwitch n = 
+              do flag <- ask
+                 n flag
+
+(l1,l2) @++@ (l3,l4) = (l1 ++ l3, l2 ++ l4)
+
+
+ref_count = \i -> estate i @=> "ref_count"
+ref_countx = \i s -> estate i @=> ("ref_count_" ++ s)
+ref_count_type = THook "int"
+--------------------------------------------------------------------------------
+
+-- cloneBase i = resetClone $ info { baseTstate = estate i @=> "parent" }
+cloneBase i = i { baseTstate = estate i @=> "parent" }
+
+
+(@>>>@) :: Evalable m => m Statement -> m Statement -> m Statement
+(@>>>@) x y = do s1 <- x
+                 s2 <- y
+                 return (s1 >>> s2)
+
+f  @$ x = x >>= return . f
+mf @. x = mf >>= \f -> f @$ x
+
+--------------------------------------------------------------------------------
+-- PRINTING
+--------------------------------------------------------------------------------
+
+-- printTreeStateType :: Monad m => Eval m -> String
+printTreeStateType e =
+  {- render $ pretty $-} Struct "TreeState" [ (ty,name) | (name,ty,_) <- treeState_ e ]
+
+-- printEvalStateType :: Monad m => Eval m -> String
+printEvalStateType e =
+  {-render $ pretty $-} Struct "EvalState" [ (ty,name) | (name,ty,_) <- evalState_ e ]
+
+-- initEvalState :: Monad m => Info -> Eval m -> Doc
+initEvalState i e = mconcat $
+--  {-vcat-} [SHook ((rp 0 ty) ++ " " ++ name ++ ";") | (name,ty,_) <- evalState_ e]
+  [SHook "struct EvalState evalState;"]
+
+initTreeState_ :: Monad m => Info -> Eval m -> m Statement
+initTreeState_ i e = mseqs [ init i | (_,_,init) <- treeState_ e]
+
+
+-- initIntArrays :: Eval m -> Doc 
+initIntArrays eval =
+  mconcat [ doc arr | arr <- nub $ sort $ intArraysE eval]
+  where doc arr 
+         | [(_,"")] <- reads arr :: [(Int,String)]
+         = SHook ("vm->getSearchintVarArray(\"" ++ arr ++ "\", VAR_" ++ arr ++ ");")
+         | otherwise 
+         = SHook ("vm->getintVarArray(\"" ++ arr ++ "\", VAR_" ++ arr ++ ");")
+
+-- initBoolArrays :: Eval m -> Doc 
+initBoolArrays eval =
+  mconcat [ doc arr | arr <- nub $ sort $ boolArraysE eval]
+  where doc arr 
+         | [(_,"")] <- reads arr :: [(Int,String)]
+         = SHook ("vm->getSearchboolVarArray(\"" ++ arr ++ "\", VAR_" ++ arr ++ ");")
+         | otherwise 
+         = SHook ("vm->getboolVarArray(\"" ++ arr ++ "\", VAR_" ++ arr ++ ");")
+
+-- declIntArrays :: Eval m -> Doc 
+declIntArrays eval =
+  mconcat [ doc arr | arr <- nub $ sort $ intArraysE eval]
+  where doc arr 
+         | [(_,"")] <- reads arr :: [(Int,String)]
+         = SHook ("vector<int> VAR_" ++ arr ++ ";")
+         | otherwise 
+         = SHook ("vector<int> VAR_" ++ arr ++ ";")
+
+declBoolArrays eval =
+  mconcat [ doc arr | arr <- nub $ sort $ boolArraysE eval]
+  where doc arr 
+         | [(_,"")] <- reads arr :: [(Int,String)]
+         = SHook ("vector<int> VAR_" ++ arr ++ ";")
+         | otherwise 
+         = SHook ("vector<int> VAR_" ++ arr ++ ";")
+
+-- initIntVars :: Eval m -> Doc 
+initIntVars eval =
+  mconcat [ doc var | var <- nub $ sort $ intVarsE eval]
+  where doc var = SHook ("vm->getintVarIndex(\"" ++ var ++ "\", VAR_" ++ var ++ ");")
+
+-- declIntVars :: Eval m -> Doc 
+declIntVars eval =
+  mconcat [ doc var | var <- nub $ sort $ intVarsE eval]
+  where doc var = SHook ("int VAR_" ++ var ++ ";")
+
+corefn :: (Evalable m, WriterM ProgramString m) => Eval m -> m Statement
+corefn eval =
+  do fl <- getFlags
+     sInitE <- inite (map (\(a,_,b) -> (a,b)) (evalState_ eval)) info
+     sInitS <- inits eval info
+     sTry   <- startTryE eval info
+     sNext  <- nextSame eval info
+     sBody  <- bodyE eval info
+     return $ seqs [ -- SHook $ "\n  status = " ++ rpx 0 fl RootSpace ++ "->status();"
+                     SHook "\n"
+                   , SHook "  st->queue = new std::vector<TreeState>();"
+                   , sInitE
+                   , sInitS
+                   , sTry
+                   , Block (SHook "  while (!st->queue->empty())") $ seqs 
+                     [ SHook "    /* pop first element */" 
+                     , SHook "    TreeState popped_estate = st->queue->back();"
+                     , SHook "    st->queue->pop_back();"
+                     , sNext
+                     , SHook "    st->estate = popped_estate;"
+                     , sBody
+                     ]
+                   ]
+
+mainfn :: (Evalable m, WriterM ProgramString m) => Eval m -> m Statement
+mainfn eval =
+  do core <- corefn eval
+     return $ seqs [ SHook ("\n\nvoid eval(" ++ spacetype ModeFZ ++ "* root, VarMap* vm, Printer* p) {")
+                   , SHook "RootState rootState;"
+                   , SHook "RootState *st = &rootState;"
+                   , initIntVars eval
+                   , initBoolArrays eval
+                   , initIntArrays eval
+                   , core
+                   , SHook "}"
+                   ]
+
+cppfn :: (Evalable m, WriterM ProgramString m) => Eval m -> m Statement
+cppfn eval =
+  do core <- corefn eval
+     return $ seqs [ SHook ("\n\nvoid eval(" ++ spacetype ModeGecode ++ "* root, Printer *p) {")
+                   , SHook "RootState rootState;"
+                   , SHook "RootState *st = &rootState;"
+                   , SHook ("    mgr.root(*root);")
+                   , core
+                   , SHook "}"
+                   ]
+
+mcpfn :: (Evalable m, WriterM ProgramString m) => Eval m -> m Statement
+mcpfn eval =
+  do core <- corefn eval
+     return $ seqs [ SHook ("\n\nvoid eval(" ++ spacetype ModeMCP ++ "* root) {")
+                   , SHook "RootState rootState;"
+                   , SHook "RootState *st = &rootState;"
+                   , core
+                   , SHook "}"
+                   ]
+
+typedecls :: Evalable m => Eval m -> m Statement
+typedecls eval =
+  do fl <- getFlags
+     return $ seqs [ SHook ("struct EvalState;")
+                   , SHook (render $ vcat $ [text "struct" <+> text name <> semi | Struct name _ <- fst $ structs eval])
+                   , SHook (render $ vcat $ map (prettyX fl) $ snd $ structs eval)
+                   , SHook (rpx 1 fl $ printTreeStateType eval)
+                   , SHook (rpx 1 fl $ printEvalStateType eval)
+                   , SHook (render $ vcat $ map (prettyX fl) $ fst $ structs eval)
+                   ]
+
+declRootState :: Eval m -> Statement
+declRootState eval = seqs [ SHook "typedef struct {"
+                          , SHook "  TreeState estate;"
+                          , SHook "  std::vector<TreeState> *queue;"
+                          , initEvalState info eval
+                          , SHook "} RootState;"
+                          ]
+
+
+generate :: (Evalable m, WriterM ProgramString m) => Eval m -> m ()
+generate eval_ = 
+  do fl <- getFlags
+     types <- typedecls eval
+     let header = seqs [ types
+                       , declIntVars eval
+                       , declBoolArrays eval
+                       , declIntArrays eval
+                       , declRootState eval
+                       ]
+     main <- mainfn eval
+     tell $ mempty { main = Just main, header = header }
+ where eval = commentEval $ eval_ { treeState_ = rootEntry ++ treeState_ eval_ }
+
+generatemcp :: (Evalable m, WriterM ProgramString m) => Eval m -> m ()
+generatemcp eval_ = 
+  do fl <- getFlags
+     types <- typedecls eval
+     let header = seqs [ types
+                       , declRootState eval
+                       ]
+     main <- mcpfn eval
+     tell $ mempty { main = Just main, header = header }
+ where eval = commentEval $ eval_ { treeState_ = rootEntry ++ treeState_ eval_ }
+
+
+generatecpp :: (Evalable m, WriterM ProgramString m) => Eval m -> m ()
+generatecpp eval_ = 
+  do fl <- getFlags
+     types <- typedecls eval
+     let header = seqs [ SHook "#include \"statemgr/varaccessor.hh\""
+                       , types
+                       , declRootState eval
+                       , SHook "StateMgr mgr;"
+                       ]
+     main <- cppfn eval
+     tell $ mempty { main = Just main, header = header }
+ where eval = commentEval $ eval_ { treeState_ = rootEntry ++ treeState_ eval_ }
+
+rp n = render . nest n . pretty
+rpx n s = render . nest n . prettyX s
+
+--------------------------------------------------------------------------------
+-- COMPOSITION COMBINATORS
+--------------------------------------------------------------------------------
+
+-- def vars = label vars lbV minV minD ($==)
+
+type MkEval m = Evalable m => Eval m -> State Int (Eval m)
+
+fixall :: Evalable m => MkEval m -> Eval m
+fixall f = let this = fst $ runState 0 $ f this
+           in this
+
+data Search = forall t2. (FMonadT t2, MonadInfoT t2) =>
+  Search { mkeval     :: forall m t1. (HookStatsM m, MonadInfoT t1, FMonadT t1, Evalable m) => MkEval ((t1 :> t2) m)
+         , runsearch  :: forall m x. (Evalable m) => t2 m x -> m x
+         }
+
+#ifndef NOMEMO
+memoize :: Search
+memoize = 
+  Search { mkeval     = return . memoLoop
+         , runsearch  = runIdT
+         }
+#endif
+
+{-# RULES
+  	"L"                          L = unsafeCoerce
+  #-}
+{-# RULES
+        "runL"                       runL = unsafeCoerce
+  #-}
+{-# RULES
+        "unsafeCoerce/unsafeCoerce"  unsafeCoerce . unsafeCoerce = unsafeCoerce
+  #-}
+{-# RULES
+        "mmap/unsafeCoerce"          mmap unsafeCoerce = unsafeCoerce
+  #-}
+{-# RULES
+        "mapE/unsafeCoerce"          mapE unsafeCoerce = unsafeCoerce
+  #-}
+
+(<@>)
+  :: Search -> Search -> Search
+s1 <@> s2 = 
+  case s1 of
+    Search { mkeval = evals1, runsearch = runs1 } ->
+      case s2 of
+        Search { mkeval = evals2, runsearch = runs2 } ->
+	  Search {mkeval =
+	          \super -> do { s2' <- evals2 $ mapE (L . L . mmap runL . runL)  super
+	                       ; s1' <- evals1 (mapE runL s2')
+	                       ; return $ mapE (L . mmap L . runL) s1'
+	                       }
+	         , runsearch  = runs2 . runs1 . runL
+	         }
+
+
+data SearchCombiner = forall t1 t2. (FMonadT t1, FMonadT t2, MonadInfoT t1, MonadInfoT t2) =>
+  SearchCombiner { runner :: forall m x. Evalable m => ((t1 :> t2) m) x -> m x
+                 , elems :: [SearchCombinerElem t1 t2]
+                 }
+
+
+data SearchCombinerElem t1 t2 =
+  SearchCombinerElem { mapper :: forall t' m. (FMonadT t', MonadInfoT t', Evalable m) => Eval (t' ((t1 :> t2) m)) -> State Int (Eval (t' ((t1 :> t2) m)))
+                     }
+
+
+extractCombiners :: (Evalable m, FMonadT t', MonadInfoT t', FMonadT t1, MonadInfoT t1, FMonadT t2, MonadInfoT t2) => [SearchCombinerElem t1 t2] -> Eval (t' ((t1 :> t2) m)) -> State Int [(Eval (t' ((t1 :> t2) m)))]
+extractCombiners [] _ = return []
+extractCombiners (SearchCombinerElem { mapper=m }:b) super = 
+  do prev <- extractCombiners b super
+     next <- m super
+     return $ (next) : prev
+
+
+buildCombiner [s] =
+  case s of
+    Search { mkeval = evals, runsearch = runs } ->
+      SearchCombiner { runner = runIdT . runs . runL
+                     , elems = [SearchCombinerElem { mapper = liftM (mapE (mmap L . runL)) . evals . mapE (L . mmap runL)
+                                                   }]
+                     }
+buildCombiner (s:ss) =
+  case s of
+    Search { mkeval = evals, runsearch = runs } ->
+      case buildCombiner ss of
+        SearchCombiner { runner = runner, elems = elems } ->
+          SearchCombiner { runner = runner . runs . runL
+                         , elems = SearchCombinerElem { mapper = liftM (mapE (mmap L . runL)) . evals . mapE (L . mmap runL)
+                                                      } : liftSearchCombinerElems elems
+                         }
+
+
+
+liftSearchCombinerElems :: (FMonadT t1, FMonadT t0, FMonadT t2, MonadInfoT t1, MonadInfoT t0, MonadInfoT t2) => [SearchCombinerElem t1 t2] -> [SearchCombinerElem t0 (t1 :> t2)]
+liftSearchCombinerElems [] = []
+liftSearchCombinerElems (s:ss) = 
+  case s of 
+    SearchCombinerElem { mapper = m } ->
+      SearchCombinerElem { mapper = liftM (mapE (mmap L . runL)) . m . mapE (L . mmap runL)
+                         } : liftSearchCombinerElems ss
+
+mmap :: (FMonadT t, MonadInfoT t, Monad m, Monad n, MonadInfo m) => (forall x. m x -> n x) -> t m a -> t n a
+mmap f x = tmap' mfunctor mfunctor id f x
+
+mfunctor :: Monad m => FunctorD m
+mfunctor = FunctorD { fmapD = \f m -> m >>= return . f }
+
+evalSStateT m s = runSStateT m s >>= \t -> case t of { Tup2 a _ -> return a }
+
+data FunctionDef = FunctionDef { funName :: String, funArgs :: [(Type,String)], funBody :: Statement }
+
+genfun :: PrettyFlags -> FunctionDef -> String
+genfun fl f = rpx 0 fl $
+    Block 
+      (SHook ("void " ++ funName f ++ "(" ++ intercalate "," [ rpx 0 fl t ++ " " ++ an | (t,an) <- funArgs f ] ++ ")"))
+      (funBody f)
+
+data ProgramString = ProgramString { header :: Statement
+                                   , functions :: [FunctionDef]
+                                   , main :: Maybe Statement
+                                   , pcomment :: [String]
+                                   }
+
+transformProgram fn p = p { header = inliner fn (header p), functions = map (\f -> f { funBody = inliner fn (funBody f) }) (functions p), main = maybe Nothing (Just . inliner fn) (main p) }
+
+instance Monoid ProgramString where
+  mempty = ProgramString { header = Skip, functions = [], main = Nothing, pcomment = [] }
+  mappend p1 p2 = ProgramString { header = header p1 >>> header p2, functions = functions p1 ++ functions p2, main = maybe (main p2) Just (main p1), pcomment = pcomment p1 ++ pcomment p2 }
+
+genprog :: PrettyFlags -> ProgramString -> String
+genprog fl p = concatMap (\x -> "// " ++ x ++ "\n\n") (pcomment p) ++ rpx 0 fl (header p) ++ concatMap (\x -> "\n" ++ genfun fl x ++ "\n") (functions p) ++ maybe "" (rpx 0 fl) (main p)
+
+monadInfo :: MInfo -> (Int,Int,Int)
+monadInfo (MInfo x) = 
+  let total = sum $ map snd $ Map.toList x
+      identities = Map.findWithDefault 0 "Id" x + Map.findWithDefault 0 "IdT" x
+      zippers = Map.findWithDefault 0 ":>" x
+  in  (total - (identities+zippers),zippers,identities)
+
+getgen :: (Evalable m, WriterM ProgramString m) => Eval m -> m ()
+getgen x = do
+  fl <- getFlags
+  case genMode fl of
+    ModeFZ -> generate x
+    ModeMCP -> generatemcp x
+    ModeGecode -> generatecpp x
+    ModeUnk -> error "Unknown generator?"
+
+search' :: GenMode -> Search -> ProgramString
+#ifdef NOMEMO
+search' fl s  = 
+  case s of
+    Search { mkeval = evals, runsearch = runs } -> do
+       let fevals = fixall $ evals
+           in case runId $ runGenModeT fl $ runHookStatsT $ evalSStateT Map.empty $ unVarInfoT $ runs $ runWriterT $ getgen $ mapE runL $ fevals
+                   of (((_,eval)),n) -> let cmt = show $ monadInfo $ minfo $ canBranch $ fevals
+                                            in eval { pcomment = ["Combinator stats: " ++ cmt, "Hook calls: " ++ show n]}
+#else
+refType t n =
+  case t of
+    x | last x == '*' -> n
+    "int" -> n
+    "bool" -> n
+    _ -> '&' : n
+
+search' fl s  = 
+  case memoize <@> s of
+    Search { mkeval = evals, runsearch = runs } -> do
+       let fevals = fixall $ evals
+           in case runId $ runGenModeT fl $ runHookStatsT $ runMemoT $ evalSStateT Map.empty $ unVarInfoT $ runs $ runWriterT $ getgen $ mapE runL $ fevals
+                   of (((_,eval),t),n) -> let {- m = inlineMap t  -}
+                                              p = {- transformProgram m -} (mempty { functions = map toFun (filter (not . needInline) t) } `mappend` eval)
+                                              cmt = show $ monadInfo $ minfo $ canBranch $ fevals
+                                          in p { pcomment = ["Combinator stats: " ++ cmt, "Hook calls: " ++ show n]}
+  where toFun (key,val) = FunctionDef { funName = memoFn key ++ show (memoId val), funArgs = mm (map (\x -> (THook (fst x), refType (fst x) $ snd x)) (memoFields val)), funBody = simplify (memoCode val) }
+        mm = ((fixArgs fl) ++)
+
+fixArgs ModeMCP = [ -- (Pointer (THook "Gecode::SpaceStatus"), "status") 
+                    (Pointer (THook "RootState"), "st")
+                  ]
+fixArgs _       = [ -- (Pointer (THook "Gecode::SpaceStatus"), "status")
+                    (Pointer (THook "RootState"), "st"),
+                    (Pointer (THook "Printer"),"p") 
+                  ]
+
+needInline (key,val) = False {- (memoUsed val <= 1) -}
+{-needInline (key,val) = 
+  let code = simplify $ memoCode val
+      res = (memoUsed val <= 1) || (case code of { Seq _ _ -> False; Block _ _ -> False; Skip -> True; _ -> True })
+      in trace ("needInline? " ++ show code ++ " -> " ++ show res ++ "\n") res
+-}
+-- needInline _ = False
+
+inlineMap fl fns = do
+  lst <- mapM (\(key,val) -> cacheCall (memoFn key ++ show (memoId val)) (memoFields val) [] >>= \c -> return (c, memoCode val)) [ x | x <- fns, needInline x ]
+  return $ Map.fromList lst
+
+#endif
+
+
+search :: Search -> String
+search s = genprog (PrettyFlags ModeMCP) (search' ModeMCP s)
diff --git a/Control/Search/GeneratorInfo.hs b/Control/Search/GeneratorInfo.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/GeneratorInfo.hs
@@ -0,0 +1,120 @@
+module Control.Search.GeneratorInfo where 
+
+import Control.Search.Language
+
+type TreeState = Value
+type EvalState = Value
+space i      =  baseTstate i @-> "space"
+
+data Info = Info { baseTstate :: TreeState
+                 , path       :: TreeState -> TreeState
+                 , abort_     :: [Statement -> Statement] 
+	         , commit_    :: [Statement -> Statement]
+	         , old        :: Info
+                 , clone      :: Info -> Statement
+                 , field      :: String -> Value
+                 , stackField :: [(String,String)]
+                 , treeStateType :: Type
+                 , evalStateType :: Type
+                 }
+
+(@@) :: Ordering -> Ordering -> Ordering
+EQ @@ x = x
+x @@ _ = x
+
+instance Ord Info where
+  compare a b =    compare (baseTstate a) (baseTstate b) 
+                @@ compare (path a $ baseTstate a) (path b $ baseTstate b)
+                @@ compare (map ($ Skip) $ abort_ a) (map ($ Skip) $ abort_ b)
+                @@ compare (map ($ Skip) $ commit_ a) (map ($ Skip) $ commit_ b)
+                @@ compare (clone a (resetClone a)) (clone b (resetClone b))
+
+instance Eq Info where
+  a == b = case compare a b of { EQ -> True; _ -> False }
+
+type Field = String
+
+tstate i = path i (baseTstate i)
+tstate_type i = treeStateType i
+
+-- VHook ("/* " ++ show (estate_type i) ++ " */ null")
+estate i = case estate_type i of
+  Pointer (SType (Struct "EvalState" _)) -> Ref (Var $ "st->evalState")
+  Pointer (THook "EvalState") -> Ref (Var "st->evalState")
+  _ -> (tstate i) @-> "evalState"
+
+estate_type i = evalStateType i
+
+withCommit i f   = i { commit_ = f : commit_ i }
+onAbort  i stmt  = i { abort_  = (stmt >>>) : abort_ i  }
+onCommit i stmt  = i `withCommit` (stmt >>>)
+onCommit' i stmt  = i `withCommit` (>>> stmt)
+withPath i p e t = i { path   = p . path i
+                     , old    = withPath (old i) p e t
+                     , evalStateType = e
+                     , treeStateType = t
+                     }
+withBase i str   = i { baseTstate = Var str, stackField = ("TreeState",str):(stackField i) }
+
+withClone i stmt  = i { clone = \j -> clone i j >>> stmt (i { baseTstate = baseTstate j }) }
+withField i (f,g) = i { field = \f' -> if f' == f then g i else field i f' }
+
+resetPath   i     = i { path = id
+                      , old  = resetPath $ old i 
+                      , treeStateType = Pointer (THook "TreeState")
+                      , evalStateType = Pointer (THook "EvalState")
+                      }
+resetCommit i     = i { commit_ = [const $ comment "Delete-resetCommit" >>> (Delete $ space i)] }
+shiftCommit  i     = i { commit_  = tail $ commit_ i }
+resetAbort  i     = i { abort_  = [const $ comment "Delete-resetAbort" >>> (Delete $ space i)] }
+shiftAbort  i     = i { abort_  = tail $ abort_ i }
+resetClone  i     = i { clone = const Skip }
+
+resetInfo i = i { path    = id
+                , old     = resetInfo $ old i
+                , commit_ = [ const $ comment "Delete-resetInfo-commit_" >>> (Delete $ space i) ]
+                , abort_  = [ const $ comment "Delete-resetInfo-abort_" >>> (Delete $ space i), const (comment "reset")]
+                , clone   = const Skip
+                , treeStateType = Pointer (THook "TreeState")
+                , evalStateType = Pointer (THook "EvalState")
+	        }
+
+mkInfo name       =
+       let i = Info { baseTstate = Var name
+                    , path       = id
+                    , abort_     = [const $ comment "Delete-mkInfo-abort_" >>> (Delete $ space i)]
+                    , commit_    = [const $ comment "Delete-mkInfo-commit_" >>> (Delete $ space i)]
+                    , old        = i
+                    , clone      = const Skip
+                    , field      = \f -> error ("unknown field `" ++ f ++ "'")
+                    , stackField = []
+                    , treeStateType = Pointer (THook "TreeState")
+                    , evalStateType = Pointer (THook "EvalState")
+                    }
+       in i
+
+info = mkInfo "st->estate"
+
+newinfo i n = 
+       Info { baseTstate = Var $ "nstate" ++ n
+            , path       = id
+            , abort_     = [const Skip]
+	    , commit_    = [const Skip]
+            , old        = resetPath i
+            , clone      = const Skip
+            , field      = \f -> error ("unknown field `" ++ f ++ "'")
+            , stackField = [("TreeState","nstate" ++ n)]
+            , treeStateType = Pointer (THook "TreeState")
+            , evalStateType = Pointer (THook "EvalState")
+            }
+
+commit i = go $ commit_ i
+ where go []     = Skip
+       go (f:fs) = f (go fs)
+abort i = go $ abort_ i 
+ where go []     = Skip
+       go (f:fs) = f (go fs)
+
+primClone i = \j -> space j <== Clone (space i)
+
+cloneIt i j = primClone i j >>> clone i j
diff --git a/Control/Search/Language.hs b/Control/Search/Language.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Language.hs
@@ -0,0 +1,531 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module Control.Search.Language  where 
+
+import Text.PrettyPrint
+import Data.Monoid
+import Data.Int
+import qualified Data.Map as Map
+import Data.Map (Map)
+
+
+spacetype ModeFZ = "FlatZincSpace"
+spacetype ModeGecode = "State"
+spacetype ModeMCP = "MCPProgram"
+
+xsspace fl@(PrettyFlags ModeFZ) x str = prettyX fl (PField x str)
+xsspace fl@(PrettyFlags ModeMCP) x str = prettyX fl (PField x str)
+xsspace fl@(PrettyFlags ModeGecode) x str = text "((VarAccessorSpace*)msg.space(" <> prettyX fl x <> text "))->" <> text str
+
+instance Monoid Statement where
+  mempty  = Skip
+  mappend = (>>>)
+
+data GenMode = ModeUnk | ModeGecode | ModeFZ | ModeMCP
+  deriving Eq
+
+data PrettyFlags = PrettyFlags { genMode :: GenMode }
+  deriving Eq
+
+renderVar :: PrettyFlags -> Value -> Doc
+renderVar f@(PrettyFlags { genMode = ModeFZ }) x = case x of
+    (AVarElem vs s i)  ->  xsspace f s "iv" <> brackets (text "VAR_" <> text vs <> brackets (pr_ i))
+    (AVarSize vs s)    ->  text "VAR_" <> text vs <> text ".size()"
+    (BAVarElem vs s i)  ->  xsspace f s "bv" <> brackets (text "VAR_" <> text vs <> brackets (pr_ i))
+    (BAVarSize vs s)    ->  text "VAR_" <> text vs <> text ".size()"
+    (IVar vs s)        ->  xsspace f s "iv" <> brackets (text "VAR_" <> text vs)
+  where pr_ :: Value -> Doc
+        pr_ = prettyX f
+renderVar f@(PrettyFlags { genMode = ModeGecode }) x = case x of
+    (AVarElem vs s i)  ->  xsspace f s "va.iv" <> parens (text "idx" <> parens (xsspace f s "va.map()" <> text ",\"" <> text vs <> text "\"") <> text "+" <> pr_ i)
+    (AVarSize vs s)    ->  text "size" <> parens (xsspace f s "va.map()" <> text ",\"" <> text vs <> text "\"")
+    (BAVarElem vs s i)  ->  xsspace f s "va.bv" <> parens (text "idx" <> parens (xsspace f s "va.map()" <> text ",\"" <> text vs <> text "\"") <> text "+" <> pr_ i)
+    (BAVarSize vs s)    ->  text "size" <> parens (xsspace f s "va.map()" <> text ",\"" <> text vs <> text "\"")
+    (IVar vs s)        ->  xsspace f s "va.iv" <> parens (text "idx" <> parens (xsspace f s "va.map()" <> text ",\"" <> text vs <> text "\""))
+  where pr_ :: Value -> Doc
+        pr_ = prettyX f
+renderVar f@(PrettyFlags { genMode = ModeMCP }) x = case x of
+    (AVarElem vs s i) -> xsspace f s vs <> brackets (pretty i)
+    (AVarSize vs s) -> xsspace f s vs <> text ".size()"
+    (BAVarElem vs s i) -> xsspace f s vs <> brackets (pretty i)
+    (BAVarSize vs s) -> xsspace f s vs <> text ".size()"
+    (IVar vs s) -> xsspace f s vs
+
+renderVar f@(PrettyFlags { genMode = ModeUnk }) _ = error "Cannot generate variable without render mode!"
+
+
+class Pretty x where
+  prettyX :: PrettyFlags -> x -> Doc
+  pretty :: x -> Doc
+  prettyX _ = pretty
+  pretty = prettyX (PrettyFlags { genMode = ModeUnk })
+
+data Struct = Struct String [(Type,String)] deriving (Show, Eq, Ord)
+
+instance Pretty Struct where
+  prettyX x (Struct name fields) =
+    text "struct" <+> text name <+> text "{"
+    $+$ nest 2 (vcat [prettyX x ty <+> text f <> text ";" | (ty,f) <- fields])
+    $+$ text "};" 
+
+
+data Type = Pointer Type
+          | SpaceType
+          | Int
+          | Bool
+          | Union [(Type,String)]
+          | SType Struct
+          | THook String
+          deriving (Show, Eq, Ord)
+
+data Value = IVal Int32
+           | BVal Bool
+           | RootSpace
+           | Minus Value Value
+           | Plus Value Value
+           | Mult Value Value
+           | Div Value Value
+           | Mod Value Value
+           | Abs Value
+           | Var String
+           | Ref Value
+           | Deref Value
+           | Clone Value
+           | Field String String
+           | Field' Value String
+           | PField Value String
+           | Lt Value Value
+	   | Gq Value Value
+	   | Gt Value Value
+	   | Eq Value Value
+	   | BaseContinue
+	   | And Value Value
+	   | Or  Value Value
+           | Not Value
+           | VHook String
+           | Max Value Value
+           | AVarElem String Value Value
+           | AVarSize String Value
+           | BAVarElem String Value Value
+           | BAVarSize String Value
+           | IVar String Value
+           | MinDom Value
+           | MaxDom Value
+           | Degree Value
+           | WDegree Value
+           | UbRegret Value
+           | LbRegret Value
+	   | Median Value
+           | Random 
+	   | Null
+	   | New Struct
+           | Base
+           | Cond Value Value Value
+           | Assigned Value
+           | Dummy Int
+           | MaxVal
+           | MinVal
+           deriving (Show, Eq, Ord)
+
+instance Num Value where
+  (-)         = Minus
+  fromInteger = IVal . fromInteger
+  (+)    = Plus
+  (*)    = Mult
+  abs    = Abs
+  signum = error "signum is not defined for Value"
+
+divValue (IVal x) (IVal y) = IVal (x `div` y)
+divValue x y = Div x y
+
+true  = BVal True
+false = BVal False
+(&&&) = And
+(|||) = Or
+(@>)  = Gt
+(@>=) = Gq
+x @<= y = y `Gq` x
+(@==) = Eq
+(@->) = Field' 
+(@=>) = PField 
+(@<)  = Lt
+lex cmps l1 l2 = foldr (\(x,y,cmp) r -> (x `cmp` y) ||| ((x @== y) &&& r)) false (zip3 l1 l2 cmps)
+
+simplValue :: Value -> Value
+simplValue (Cond c t e) =
+  let c' = simplValue c
+      t' = simplValue t
+      e' = simplValue e
+  in case (c',t',e') of
+      (BVal True, _, _)  -> t'
+      (BVal False, _, _) -> e'
+      _  | t' == e'      -> t'
+      _                  -> Cond c' t' e'
+simplValue (Minus (IVal x) (IVal y)) = IVal (x - y)
+simplValue (Lt x y)  = Lt (simplValue x) (simplValue y)
+simplValue (Gq x y)  = Gq (simplValue x) (simplValue y)
+simplValue (And x y) =
+  let x' = simplValue x
+      y' = simplValue y
+  in case (x',y') of
+       (x, (BVal True))  -> x 
+       (x, (BVal False)) -> BVal False
+       _                 -> And x' y'
+simplValue (Not x)   =
+  let x' = simplValue x
+  in case x' of
+       (BVal True)   -> BVal False
+       (BVal False)  -> BVal True
+       _             -> Not x'
+simplValue (PField (Ref x) f) = Field' (simplValue x) f
+simplValue v = v
+
+instance Pretty Type where
+  prettyX x (Pointer t) = prettyX x t <> text "*"
+  prettyX x SpaceType      = text $ spacetype (genMode x)
+  prettyX x Int         = text "int"
+  prettyX x Bool        = text "bool"
+  prettyX x (Union fields)   = 
+    text "union" <+> text "{"
+     $+$ nest 2 (vcat [prettyX x ty <+> text f <> text ";" | (ty,f) <- fields])
+     $+$ text "}" 
+  prettyX x (SType (Struct name fields))  =
+    text name
+  prettyX x (THook str) = 
+    text str
+
+instance Pretty Value where
+  prettyX x = prettyX_ x . simplValue
+    where
+      prettyX_ :: PrettyFlags -> Value -> Doc
+      prettyX_ _ (Cond c t e)   = pr_ c <+> text "?" <+> pr_ t <+> text ":" <+> pr_ e
+      prettyX_ _ Base           = text "<BASE>"
+      prettyX_ _ Null           = text "NULL"
+      prettyX_ _ (IVal i)       = int $ fromInteger $ toInteger i
+      prettyX_ _ (BVal True)    = text "true" 
+      prettyX_ _ (BVal False)   = text "false" 
+      prettyX_ _ (Abs x)        = text "abs" <> parens (pr_ x)
+      prettyX_ fl RootSpace      = case (genMode fl) of
+                                     ModeFZ -> text "root"
+                                     ModeGecode -> text "mgr.root()"
+                                     ModeMCP -> text "root"
+      prettyX_ _ (Minus v1 v2)  = pr_ v1 <+> text "-" <+> pr_ v2
+      prettyX_ _ (Plus v1 v2)   = pr_ v1 <+> text "+" <+> pr_ v2
+      prettyX_ _ (Mult v1 v2)   = pr_ v1 <+> text "*" <+> pr_ v2
+      prettyX_ _ (Div v1 v2)    = parens (pr_ v1) <+> text "/" <+> parens (pr_ v2)
+      prettyX_ _ (Mod v1 v2)    = parens (pr_ v1) <+> text "%" <+> parens (pr_ v2)
+      prettyX_ _ (Ref x)        = parens $ text "&" <> parens (pr_ x)
+      prettyX_ _ (Deref x)      = parens $ text "*" <> parens (pr_ x)
+      prettyX_ _ (Var x)        = text x
+      prettyX_ f (Clone x)      = text ("static_cast<" ++ spacetype (genMode f) ++ "*>(") <> pr_ x <> text "->clone(true))"
+      -- prettyX_ (Clone x)      = text ("static_cast<" ++ spacetype ++ "*>(") <> pretty_ x <> text "->clone(false))"
+      prettyX_ _ (Field r f)    = text r <> text "." <> text f
+      prettyX_ _ (Field' r f)   = pr_ r <> text "." <> text f
+--      prettyX_ (PField (Field' (Var "estate") "evalState") f) = text f
+--      prettyX_ (PField (Field' (Var "nstate") "evalState") f) = text f
+--      prettyX_ (PField (Field' (Var _) "evalState") f) = text f
+      prettyX_ _ (PField r f)   = pr_ r <> text "->" <> text f
+      prettyX_ _ (Lt x y)       = parens (pr_ x) <+> text "<" <+> parens (pr_ y) 
+      prettyX_ _ (Gq x y)       = parens (pr_ x) <+> text ">=" <+> parens (pr_ y) 
+      prettyX_ _ (Gt x y)       = parens (pr_ x) <+> text ">" <+> parens (pr_ y) 
+      prettyX_ _ (Eq x y)       = parens (pr_ x) <+> text "==" <+> parens (pr_ y) 
+      prettyX_ _ BaseContinue   = text "!st->queue->empty()"
+      prettyX_ _ (And x y)      = parens (pr_ x) <+> text "&&" <+> parens (pr_ y) 
+      prettyX_ _ (Or  x y)      = parens (pr_ x) <+> text "||" <+> parens (pr_ y) 
+      prettyX_ _ (Not x)        = text "!" <> parens (pr_ x)
+      prettyX_ _ (VHook s)      = text s
+      prettyX_ _ (Max x y)      = text "max" <> parens (pr_ x <> text "," <> pr_ y)
+      prettyX_ e v@(AVarElem _ _ _)  = renderVar e v
+      prettyX_ e v@(AVarSize _ _)  = renderVar e v
+      prettyX_ e v@(BAVarElem _ _ _)  = renderVar e v
+      prettyX_ e v@(BAVarSize _ _)  = renderVar e v
+      prettyX_ e v@(IVar _ _)      = renderVar e v
+      prettyX_ _ (MinDom v)     = pr_ v <> text ".min()"
+      prettyX_ _ (MaxDom v)     = pr_ v <> text ".max()"
+      prettyX_ _ (Degree v)     = pr_ v <> text ".degree()"
+      prettyX_ _ (WDegree v)    = pr_ v <> text ".afc()" -- aka accumulated failure count
+      prettyX_ _ (UbRegret v)   = pr_ v <> text ".regret_max()"
+      prettyX_ _ (LbRegret v)   = pr_ v <> text ".regret_min()"
+      prettyX_ _ (Median v)     = pr_ v <> text ".med()"
+      prettyX_ _ MaxVal         = text "Gecode::Int::Limits::max"
+      prettyX_ _ MinVal         = text "Gecode::Int::Limits::min"
+      prettyX_ _ Random         = text "rand()"
+      prettyX_ _ (New (Struct name _)) = text "new" <+> text name
+      prettyX_ _ (Assigned var) = pr_ var <> text ".assigned()"
+      pr :: Value -> Doc
+      pr = prettyX x
+      pr_ :: Value -> Doc
+      pr_ = prettyX_ x
+
+data Constraint = EqC Value Value
+                | NqC Value Value
+                | LtC Value Value
+                | LqC Value Value
+                | GtC Value Value
+                | GqC Value Value
+                | TrueC
+                | FalseC
+                deriving (Eq, Ord, Show)
+
+($==) = EqC
+($/=) = NqC
+($<)  = LtC
+($<=) = LqC
+($>)  = GtC
+($>=) = GqC
+
+neg (EqC x y) = NqC x y
+neg (NqC x y) = EqC x y
+neg (LtC x y) = GqC x y
+neg (LqC x y) = GtC x y
+neg (GtC x y) = LqC x y
+neg (GqC x y) = LtC x y
+
+instance Pretty Constraint where
+  prettyX f (EqC x y) =
+    prettyX f x <> text "," <> text "IRT_EQ" <> text "," <> prettyX f y
+  prettyX f (NqC x y) =
+    prettyX f x <> text "," <> text "IRT_NQ" <> text "," <> prettyX f y
+  prettyX f (LtC x y) =
+    prettyX f x <> text "," <> text "IRT_LE" <> text "," <> prettyX f y
+  prettyX f (LqC x y) =
+    prettyX f x <> text "," <> text "IRT_LQ" <> text "," <> prettyX f y
+  prettyX f (GtC x y) =
+    prettyX f x <> text "," <> text "IRT_GR" <> text "," <> prettyX f y
+  prettyX f (GqC x y) =
+    prettyX f x <> text "," <> text "IRT_GQ" <> text "," <> prettyX f y
+  prettyX f TrueC = error "true constraint can't be posted directly"
+  prettyX f FalseC = error "false constraint can't be posted directly"
+
+
+data Statement = IfThenElse Value Statement Statement
+               | Push Value
+               | Skip
+               | Seq Statement Statement
+               | Assign Value Value
+	       | Abort
+	       | Print Value [String]
+               | SHook String
+               | Post Value Constraint
+               | Fold String Value Value Value (Value -> Value) (Value -> Value -> Value)
+               | IFold String Value Value Value (Value -> Value) (Value -> Value -> Value)
+               | BFold String Value Value Value (Value -> Value) (Value -> Value -> Value)
+               | BIFold String Value Value Value (Value -> Value) (Value -> Value -> Value)
+--	       | MFold String [(Value, Value->Value)] ([Value] -> [Value] -> Value)
+	       | Delete Value
+               | Block Statement Statement
+               | DebugOutput String
+               | DebugValue String Value
+  deriving (Eq,Ord,Show)
+
+inliner :: (Statement -> Maybe Statement) -> Statement -> Statement
+inliner f s =
+  case f s of
+    Just x -> inliner f x
+    Nothing -> case s of
+      IfThenElse v s1 s2 -> IfThenElse v (inliner f s1) (inliner f s2)
+      Seq s1 s2 -> Seq (inliner f s1) (inliner f s2)
+      Block s1 s2 -> Block s1 (inliner f s2)
+      _ -> s
+
+instance Ord (Value -> Value) where
+  compare a b = compare (a (Dummy 0)) (b (Dummy 0))
+
+instance Eq (Value -> Value) where
+  a == b = (a (Dummy 1)) == (b (Dummy 1))
+
+instance Show (Value -> Value) where
+  show a = show (a (Dummy 1))
+
+instance Ord (Value -> Value -> Value) where
+  compare a b = compare (a (Dummy 2) (Dummy 3)) (b (Dummy 2) (Dummy 3))
+
+instance Eq (Value -> Value -> Value) where
+  a == b = (a (Dummy 4) (Dummy 5)) == (b (Dummy 4) (Dummy 5))
+
+instance Show (Value -> Value -> Value) where
+  show a = show (a (Dummy 1) (Dummy 2))
+
+comment str = SHook ("// " ++ str)
+
+dec var = Assign var (var - 1)
+inc var = Assign var (var + 1)
+(>>>) = Seq
+(<==) = Assign
+assign = flip Assign
+ifthen c t = IfThenElse c t Skip
+seqs = foldr (>>>) Skip
+
+simplStmt :: Statement -> Statement
+simplStmt (IfThenElse c t e)
+  = let c' = simplValue c
+        t' = simplStmt t
+        e' = simplStmt e
+    in go c' t' e'
+    where go (BVal True)  t e   = t
+          go (BVal False) t e   = e 
+          go c t e | t == e     = t
+          go c Skip e           = simplStmt $ IfThenElse (Not c) e t
+          go c1 (IfThenElse c2 t2 e2) e1 
+            | e1 == e2          = simplStmt $ IfThenElse (c1 &&& c2) t2 e1 
+          go c t e              = IfThenElse c t e
+simplStmt (Assign x y) | x==y = Skip
+simplStmt (Seq Skip a) = simplStmt a
+simplStmt (Seq a Skip) = simplStmt a
+simplStmt s = s
+
+instance Pretty Statement where
+ prettyX x = prettyX_ . simplStmt
+  where
+        prettyX_ (Push tstate)      = 
+          text "st->queue->push_back" <> parens (pr tstate) <> text ";"
+        prettyX_ (IfThenElse c t Skip)  =  text "if" <+> parens (pr c) <+> text "{" $+$ nest 2 (pr t) $+$ text "}"
+	prettyX_ (IfThenElse c t e)     =  text "if" <+> parens (pr c) <+> text "{" $+$ nest 2 (pr t) $+$ text "} else {" $+$ nest 2 (pr_ e) $+$ text "}"
+        prettyX_ Skip =
+          empty
+        prettyX_ (Assign var (Minus val 1))
+          | var == val
+          = pr var <> text "--;"
+        prettyX_ (Assign var (Plus val 1))
+          | var == val
+          = pr var <> text "++;"
+        prettyX_ (Block s1 s2) = pr s1 <+> text "{" $+$ nest 2 (pr s2) $+$ text "}"
+        prettyX_ (Seq s1 s2)  =
+          pr s1 $+$ pr s2
+        prettyX_ (Assign x Null) = pr x <> text ";"
+        prettyX_ (Assign x y)  = let y' = simplValue y
+                               in if x == y' 
+                                       then pr Skip
+                                       else pr x <+> text "=" <+> pr y' <> text ";"
+        prettyX_ Abort =
+          text "break;"
+        prettyX_ (Print space vs) = 
+          (vcat $ map (\s -> text "std::cout << \"[\"; for (int i=0; i<" <> pr (AVarSize s space) <> text "; i++) { std::cout << " <> pr (AVarElem s space (Var "i")) <> text " << \" \"; }; std::cout << \"] \";") vs) <> text "std::cout << std::endl;"
+        prettyX_ (DebugOutput str) = 
+          text "cout << " <> text (show str) <> text " << endl;"
+        prettyX_ (DebugValue str val) = 
+          text "cout << " <> text (show $ str ++ ": ") <> text " << " <> pr val <> text " << endl;"
+        prettyX_ (SHook s) =
+          text s
+        prettyX_ (Post space FalseC) = pr space <> text "->fail();"
+        prettyX_ (Post space TrueC) = empty
+        prettyX_ (Post space c)  = 
+          text "rel(*" <> parens (pr space) <> text "," <> pr c <> text ");" 
+        prettyX_ (Fold vars state space m0 metric better) = 
+          let
+             pos   = Field' state "pos"
+             size  = AVarSize vars space
+          in
+            text "int best_pos = -1;" 
+            $+$ pr (Assign pos 0)
+            $+$ text "for (int metric = " <> pr m0 <> text "; " <> pr (pos @< size )  <> text "; "  <> pr pos  <>  text "++) {"
+            $+$ nest 2 (text "if" <+> parens (text "!" <> pr (AVarElem vars space pos) <> text ".assigned()") <+> text "{"
+                            $+$ nest 2 ( text "int current_metric = " <> pr (metric (AVarElem vars space pos)) <> text ";"
+                                         $+$ pr (IfThenElse (Var "current_metric" `better` Var "metric")
+                                                   (Assign (Var "metric") (Var "current_metric") >>> (Assign (Var "best_pos") pos))
+                                                    Skip
+                                                )
+                                       )
+                            $+$ text "}"
+                       )
+            $+$ text "}" 
+            $+$ pr (Assign pos (Var "best_pos"))  
+        prettyX_ (IFold vars state space m0 metric better) = 
+          let
+             pos   = Field' state "pos"
+             size  = AVarSize vars state
+          in
+            text "int best_pos = -1;" 
+            $+$ pr (Assign pos 0)
+            $+$ text "for (int metric = " <> pr m0 <> text "; " <> pr (pos @< size )  <> text "; "  <> pr pos  <>  text "++) {"
+            $+$ nest 2 (text "if" <+> parens (text "!" <> pr (AVarElem vars space pos) <> text ".assigned()") <+> text "{"
+                            $+$ nest 2 ( text "int current_metric = " <> pr (metric pos) <> text ";"
+                                         $+$ pr (IfThenElse (Var "current_metric" `better` Var "metric")
+                                                      (Assign (Var "metric") (Var "current_metric") >>> (Assign (Var "best_pos") pos))
+                                                      Skip
+                                                )
+                                       )
+                            $+$ text "}"
+                       )
+            $+$ text "}" 
+            $+$ pr (Assign pos (Var "best_pos"))  
+        prettyX_ (BFold vars state space m0 metric better) = 
+          let
+             pos   = Field' state "pos"
+             size  = BAVarSize vars space
+          in
+            text "int best_pos = -1;" 
+            $+$ pr (Assign pos 0)
+            $+$ text "for (int metric = " <> pr m0 <> text "; " <> pr (pos @< size )  <> text "; "  <> pr pos  <>  text "++) {"
+            $+$ nest 2 (text "if" <+> parens (text "!" <> pr (BAVarElem vars space pos) <> text ".assigned()") <+> text "{"
+                            $+$ nest 2 ( text "int current_metric = " <> pr (metric (BAVarElem vars space pos)) <> text ";"
+                                         $+$ pr (IfThenElse (Var "current_metric" `better` Var "metric")
+                                                   (Assign (Var "metric") (Var "current_metric") >>> (Assign (Var "best_pos") pos))
+                                                    Skip
+                                                )
+                                       )
+                            $+$ text "}"
+                       )
+            $+$ text "}" 
+            $+$ pr (Assign pos (Var "best_pos"))  
+        prettyX_ (BIFold vars state space m0 metric better) = 
+          let
+             pos   = Field' state "pos"
+             size  = BAVarSize vars space
+          in
+            text "int best_pos = -1;" 
+            $+$ pr (Assign pos 0)
+            $+$ text "for (int metric = " <> pr m0 <> text "; " <> pr (pos @< size )  <> text "; "  <> pr pos  <>  text "++) {"
+            $+$ nest 2 (text "if" <+> parens (text "!" <> pr (BAVarElem vars space pos) <> text ".assigned()") <+> text "{"
+                            $+$ nest 2 ( text "int current_metric = " <> pr (metric pos) <> text ";"
+                                         $+$ pr (IfThenElse (Var "current_metric" `better` Var "metric")
+                                                      (Assign (Var "metric") (Var "current_metric") >>> (Assign (Var "best_pos") pos))
+                                                      Skip
+                                                )
+                                       )
+                            $+$ text "}"
+                       )
+            $+$ text "}" 
+            $+$ pr (Assign pos (Var "best_pos"))  
+{-        prettyX_ (MFold state metrics better) = 
+          let
+             space         = Field "estate" "space"
+             pos           = Field state "pos"
+             cvar          = CVar "get" space pos
+             size          = VHook $ render $ pr space <> text "->" <> text "get" <> text "().size()" 
+             acc_vars      = [Var $ "metric"         ++ show i | i <- [1..length metrics]]
+             cur_vars      = [Var $ "current_metric" ++ show i | i <- [1..length metrics]]
+             init_list     = hcat $ punctuate comma [pr v <+> text "=" <+> pretty z | (v,(z,_)) <- zip acc_vars metrics]
+             computations  = vcat $ [text "int" <+> pr (Update var (f cvar))| (var,(_,f)) <- zip cur_vars metrics]
+             updates       = foldl (>>>) Skip [Update v1 v2 | (v1,v2) <- zip acc_vars cur_vars]
+          in
+            text "int best_pos = -1;" 
+            $+$ pr (Update pos 0)
+            $+$ text "for (int " <> init_list <> text "; " <> pr (pos @< size )  <> text "; "  <> pr pos  <>  text "++) {"
+            $+$ nest 2 (text "if" <+> parens (text "!" <> pr cvar <> text ".assigned()") <+> text "{"
+                            $+$ nest 2 ( computations
+                                         $+$ pr (IfThenElse (cur_vars `better` acc_vars)
+                                                       (updates >>> (Update (Var "best_pos") pos))
+                                                       Skip
+                                                     )
+                                       )
+                            $+$ text "}"
+                       )
+            $+$ text "}" 
+            $+$ pr (Update pos (Var "best_pos"))  -}
+        prettyX_ (Delete value)  =
+          text "delete" <+> pr value <> text ";" 
+        pr :: Pretty x => x -> Doc
+        pr = prettyX x
+        pr_ :: Statement -> Doc
+        pr_ = prettyX_
+
+
+class Simplifiable a where
+  simplify :: a -> a
+
+instance Simplifiable Statement where
+  simplify = simplStmt
+
+instance Simplifiable Value where
+  simplify = simplValue
diff --git a/Control/Search/Memo.hs b/Control/Search/Memo.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Memo.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverlappingInstances #-}
+
+
+module Control.Search.Memo where
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+import Control.Monatron.IdT
+import Control.Monatron.MonadInfo
+
+import List (sort, nub, sortBy)
+import Data.Maybe (fromJust)
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.SStateT
+
+data MemoKey  = MemoKey { memoFn :: String, memoInfo :: Maybe Info, memoStack :: Maybe String, memoExtra :: Maybe (Map Int String), memoStatement :: Maybe Statement, memoParams :: [String] }
+  deriving (Eq, Ord)
+
+data MemoValue = MemoValue { memoId :: Int, memoCode :: Statement, memoUsed :: Int, memoFields :: [(String,String)] }
+
+data MemoInfo = MemoInfo { memoMap :: Map MemoKey MemoValue 
+                         , memoCount :: Int
+                         , memoRead :: Map Int String
+                         }
+
+initMemoInfo = MemoInfo { memoMap = Map.empty
+                        , memoCount = 0
+                        , memoRead = Map.empty
+                        }
+
+newtype MemoT m a = MemoT { unMemoT :: SStateT MemoInfo m a }
+  deriving (MonadT,StateM MemoInfo,FMonadT)
+
+instance MonadInfoT MemoT where
+  tminfo x = miInc "MemoT" (minfo $ runMemoT x)
+
+-- runMemoT :: Monad m => MemoT m a -> m (a,[(String,Statement,[(String,String)])])
+runMemoT m = do (Tup2 a s) <- runSStateT initMemoInfo (unMemoT m)
+                return (a, {- map (\(key,val) -> ( memoFn key ++ show (memoId val)
+                                              , comment (" fn=" ++ memoFn key ++ " stack='" ++ show (memoStack key) ++ "' extra='" ++ show (memoExtra key) ++ "' used: " ++ show (memoUsed val)) >>> memoCode val
+                                              , memoFields key
+                                              )
+                                 ) $ -} sortBy (\(ka,va) (kb,vb) -> compare (memoId va) (memoId vb)) $ Map.toList (memoMap s)
+                       )
+
+-- runReaderMemoT :: (ReaderM r m, ReaderMemoM r (MemoT m)) => MemoT m a -> m (a,[(String,Statement,Info)])
+-- runReaderMemoT m = do val <- ask
+--                      runMemoT (memoLocal (const val) m)
+
+class Monad m => MemoM m where
+  getMemo :: m MemoInfo 
+  setMemo :: MemoInfo -> m ()
+
+instance Monad m => MemoM (MemoT m) where
+  getMemo  = MemoT $ get 
+  setMemo  = MemoT . put
+
+instance (MemoM m, FMonadT t) => MemoM (t m) where
+  getMemo = lift $ getMemo
+  setMemo = lift . setMemo
+
diff --git a/Control/Search/MemoReader.hs b/Control/Search/MemoReader.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/MemoReader.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Control.Search.MemoReader where
+
+import Control.Search.Memo
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Control.Monatron.Monatron hiding (Abort, L, state, cont)
+import Control.Monatron.Zipper hiding (i,r)
+import Control.Monatron.MonadInfo
+import Control.Monatron.IdT
+
+newtype MemoReaderT r m a = MemoReaderT { unMemoReaderT :: Int -> ReaderT r m a }
+
+instance MonadT (MemoReaderT r) where
+  lift m = MemoReaderT $ const $ lift m
+  tbind (MemoReaderT i) f = MemoReaderT (\n -> i n `tbind` (\r -> unMemoReaderT (f r) n))
+
+instance MonadInfoT (MemoReaderT r) where
+  tminfo x = miInc "MemoReaderT" (minfo $ runReaderT undefined (unMemoReaderT x 0))
+
+instance FMonadT (MemoReaderT s) where
+  tmap' d1 d2 g f (MemoReaderT m) = MemoReaderT (tmap' d1 d2 g f . m)
+
+memoReaderT :: MemoM m => (e -> Int -> m a) -> MemoReaderT e m a
+memoReaderT f = MemoReaderT (\n -> readerT (\e -> f e n))
+
+deMemoReaderT :: MemoM m => e -> Int -> MemoReaderT e m a -> m a
+deMemoReaderT e i (MemoReaderT f) = runReaderT e (f i)
+
+runMemoReaderT :: (MemoM m, Show s) => s -> MemoReaderT s m a -> m a
+runMemoReaderT s r = 
+  do x1 <- getMemo
+     let l = Map.size (memoRead x1)
+     setMemo x1 { memoRead = Map.insert l (show s) $ memoRead x1 }
+     r <- deMemoReaderT s l r
+     x2 <- getMemo
+     setMemo x2 { memoRead = Map.delete l $ memoRead x2 }
+     return r
+
+modelMemoReaderT :: (Show s, MemoM m) => Model (ReaderOp s) (MemoReaderT s m)
+modelMemoReaderT (Ask g)     = memoReaderT (\s n -> deMemoReaderT s n (g s))
+modelMemoReaderT (InEnv s a) = memoReaderT (\_ n -> deMemoReaderT s n (do { m1 <- getMemo
+                                                                          ; let oldVal = memoRead m1 Map.! n
+                                                                          ; setMemo m1 { memoRead = Map.insert n (show s) (memoRead m1) }
+                                                                          ; x <- a
+                                                                          ; m2 <- getMemo
+                                                                          ; setMemo m2 { memoRead = Map.insert n oldVal (memoRead m2) }
+                                                                          ; return x
+                                                                          }
+                                                                      )
+                                           )
+
+instance (MemoM m, Show s) => ReaderM s (MemoReaderT s m) where
+  readerModel = modelMemoReaderT
+
diff --git a/Control/Search/SStateT.hs b/Control/Search/SStateT.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/SStateT.hs
@@ -0,0 +1,47 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module Control.Search.SStateT (
+  SStateT, sstateT, runSStateT,
+  Tup2(..), snd2, fst2
+) where
+
+--import Monatron.Operations
+import Control.Monad.Fix
+import Control.Monatron.MonadT
+import Control.Monatron.AutoInstances ()
+import Control.Monatron.Operations
+import Control.Monatron.AutoLift
+
+data Tup2 a b = Tup2 a !b
+
+fst2 (Tup2 a _) = a
+snd2 (Tup2 _ b) = b
+
+newtype SStateT s m a = SS { unSS :: s -> m (Tup2 a s) }
+
+sstateT ::  (s -> m (Tup2 a s)) -> SStateT s m a
+sstateT = SS
+
+runSStateT :: s -> SStateT s m a -> m (Tup2 a s) 
+runSStateT s m = unSS m s
+
+instance MonadT (SStateT s) where
+    lift  m           = SS $ \s -> m >>= \a -> return (Tup2 a s)
+    m `tbind` k       = SS $ \s -> unSS m s >>= \ ~(Tup2 a s') -> unSS (k a) s'
+
+instance (MonadFix m) => MonadFix (SStateT s m) where
+  mfix f  = SS $ \s -> mfix (runSStateT s . f . fst2)
+
+instance FMonadT (SStateT s) where
+    tmap' d1 _d2 g f (SS m) = SS (f . fmapD d1 (\(Tup2 x s) -> (Tup2 (g x) s)) . m)
+
+instance MMonadT (SStateT s) where
+    flift t           = SS (\s -> fmap (\a -> (Tup2 a s)) t)
+    monoidalT (SS t)  = SS (\s -> Comp $ fmap (\(Tup2 (SS t') s') -> t' s') (t s))
+
+instance Monad m => StateM z (SStateT z m) where
+    stateModel = modelSStateT
+
+modelSStateT            :: Monad m => AlgModel (StateOp s) (SStateT s m)
+modelSStateT (Get g)    = sstateT (\s -> return (Tup2 (g s) s))
+modelSStateT (Put s a)  = sstateT (\_ -> return (Tup2 a s))
diff --git a/Control/Search/Stat.hs b/Control/Search/Stat.hs
new file mode 100644
--- /dev/null
+++ b/Control/Search/Stat.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Control.Search.Stat
+  ( appStat
+  , constStat
+  , depthStat
+  , nodesStat
+  , discrepancyStat
+  , solutionsStat
+  , failsStat
+  , timeStat
+  , notStat
+  , Stat(..), IValue, varStat
+  , (#>), (#<), (#>=), (#<=), (#=), (#/)
+  , readStat, evalStat
+  ) where
+
+import Text.PrettyPrint hiding (space)
+
+import Control.Search.Language
+import Control.Search.GeneratorInfo
+import Control.Search.Memo
+import Control.Search.Generator
+
+-- ========================================================================== --
+-- IVALUE
+-- ========================================================================== --
+
+type IValue = Info -> Value
+
+instance Show (Info -> Value) where
+  show x  = "<IValue>"
+instance Eq (Info -> Value) where
+  x == y  = False
+
+instance Num (Info -> Value) where
+  x - y          = \i -> x i - y i
+  fromInteger x  = \i -> IVal (fromInteger x)
+  x + y          = \i -> x i + y i
+  x * y          = \i -> x i * y i
+  abs x          = \i -> abs (x i)
+  signum x       = \i -> signum (x i)
+
+-- ========================================================================== --
+-- STATS
+-- ========================================================================== --
+
+data Stat =   Stat (forall m. Evalable m => Eval m -> Eval m) (forall m. Evalable m => m IValue)
+
+instance Show Stat where
+  show _  = "<Stat>"
+
+instance Eq Stat where
+  _ == _ = False
+
+readStat :: Evalable m => Stat -> m IValue
+readStat (Stat _ r) = r
+
+evalStat :: Evalable m => Stat -> Eval m -> Eval m
+evalStat (Stat e _) = e
+
+-- -------------------------------------------------------------------------- --
+
+instance Num Stat where
+  x - y          = liftStat (-) x y
+  fromInteger    = constStat . fromInteger
+  x + y          = liftStat (+) x y
+  x * y          = liftStat (*) x y
+  abs            = appStat abs
+  signum         = appStat signum
+
+instance Bounded Stat where
+  maxBound       = constStat $ const MaxVal
+  minBound       = constStat $ const MinVal
+
+appStat :: (Value -> Value) -> Stat -> Stat
+appStat f (Stat e r) = Stat e (r >>= \x -> return (\i -> f (x i)))
+
+liftStat :: (Value -> Value -> Value) -> Stat -> Stat -> Stat
+liftStat op (Stat e1 x) (Stat e2 y) = Stat (e1 . e2) (x >>= \xv -> y >>= \yv -> return (\i -> xv i `op` yv i))
+
+constStat :: IValue -> Stat
+constStat x = Stat id (return x)
+
+(#>) :: Stat -> Stat -> Stat
+(#>) = liftStat (@>)
+
+(#=) :: Stat -> Stat -> Stat
+(#=) = liftStat (@==)
+
+(#<) :: Stat -> Stat -> Stat
+(#<) = liftStat (@<)
+
+(#>=) :: Stat -> Stat -> Stat
+(#>=) = liftStat (@>=)
+
+(#<=) :: Stat -> Stat -> Stat
+(#<=)  = liftStat (@<=)
+
+(#/) :: Stat -> Stat -> Stat
+(#/)   = liftStat (divValue)
+
+notStat :: Stat -> Stat
+notStat = appStat Not
+-- -------------------------------------------------------------------------- --
+
+depthStat :: Stat
+depthStat = 
+  Stat (\super -> 
+               let push dir = \i -> dir super (i `onCommit` mkUpdate i "depth" (\x -> x + 1))
+	       in commentEval $ super
+                     { treeState_ = entry ("depth",Int,assign $ 0) : treeState_ super
+		     , pushLeftH   = push pushLeft
+                     , pushRightH  = push pushRight
+                     , toString   = "stat_depth:" ++ toString super
+                     })
+       (return (\info -> tstate info @-> "depth"))
+
+discrepancyStat :: Stat
+discrepancyStat = 
+  Stat 
+    (\super -> commentEval $
+       super
+         { treeState_ = entry ("discrepancy",Int,assign 0) : treeState_ super
+         , pushLeftH   = \i -> pushLeft  super (i `onCommit` mkCopy i "discrepancy")
+         , pushRightH  = \i -> pushRight super (i `onCommit` mkUpdate i "discrepancy" (\x -> x + 1))
+         , toString = "stat_discr:" ++ toString super
+         })
+    (return (\info -> tstate info @-> "discrepancy"))
+
+nodesStat :: Stat
+nodesStat = 
+  eStat ("nodes", Int, const 0) $
+          \super -> super { bodyH = \i -> return (inc (estate i @=> "nodes")) @>>>@ bodyE super i }
+
+solutionsStat :: Stat
+solutionsStat = 
+  eStat ("solutions", Int, const 0) $
+           \super -> super {returnH  = \i -> returnE super (i `onCommit` inc (solutions i))}
+  where solutions i = estate i @=> "solutions"
+
+varStat :: VarId -> Stat
+varStat v@(VarId i) = Stat id (do inf <- lookupVarInfo v
+                                  return (const $ estate inf @=> ("var" ++ show i))
+                              )
+
+failsStat :: Stat
+failsStat = 
+  eStat ("fails", Int, const 0) $
+          \super -> super { failH = \i -> returnH super i @>>>@ return (inc (fails i)) }
+  where fails i = estate i @=> "fails"
+
+eStat :: (String, Type, Info -> Value) -> (forall m. Evalable m => Eval m -> Eval m) -> Stat
+eStat (name,typ,val) f =
+   Stat (\super -> commentEval $ f $ super { evalState_ = (name,typ,\i -> return (val i)) : evalState_ super, toString = "stat_" ++ name ++ ":" ++ toString super })
+        (return (\i -> estate i @=> name))
+
+-- TIMER STATISTIC
+--
+-- Based on Gecode::Support::Timer.
+--
+--
+--
+timeStat :: Stat
+timeStat =
+   Stat (\super -> commentEval $
+		super { evalState_ = ("total",Int, const $ return 0) : 
+                                     ("timer",THook "Gecode::Support::Timer",const $ return Null) :
+                                     ("running",Bool,const $ return false) :
+                                     evalState_ super 
+		      , nextDiffH   = \i ->
+			return (ifthen (running i) 
+			               ((running i <== false) >>> 
+	                                (total i <== (total i + (VHook (render $ text "static_cast<int>" <> parens (pretty (timer i) <> text ".stop()"))))))) 
+	              , bodyH      = \i -> 
+			return (ifthen (Not $ running i) 
+			               ((running i <== true) >>> SHook ((render $ pretty $ timer i) ++ ".start();"))) 
+		        @>>>@ bodyE super i
+                      , toString = "stat_time:" ++ toString super
+                      })
+       (return (\i -> total i + Cond (running i) (VHook (render $ text "static_cast<int>" <> parens (pretty (timer i) <> text ".stop()"))) 0))
+  where running i = estate i @=> "running"
+        timer   i = estate i @=> "timer"
+        total   i = estate i @=> "total"
diff --git a/examples/Partition.hs b/examples/Partition.hs
--- a/examples/Partition.hs
+++ b/examples/Partition.hs
@@ -2,6 +2,9 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 import Control.CP.FD.Example
+import Control.CP.SearchTree
+import Control.CP.Solver
+import Control.CP.FD.Interface
 
 model :: ExampleModel ModelInt
 model n =
diff --git a/examples/Queens.hs b/examples/Queens.hs
--- a/examples/Queens.hs
+++ b/examples/Queens.hs
@@ -3,15 +3,19 @@
 
 import Control.CP.FD.Example
 
+noattack i j qi qj = do
+  qi        @/=  qj
+  qi  +  i  @/=  qj  +  j
+  qi  -  i  @/=  qj  -  j
+
 model :: ExampleModel ModelInt
 model n = exists $ \p -> do
   size p @= n
   p `allin` (cte 0,n-1)
   allDiff p
-  loopall (cte 0,n-2) $ \i -> do
-    loopall (i+1,n-1) $ \j -> do
-      (p!i) + i @/= (p!j) + j
-      (p!i) - i @/= (p!j) - j
+  loopall (cte 0,n-2) $ \i -> 
+    loopall (i+1,n-1) $ \j ->
+      noattack i j (p!i) (p!j)
   return p
 
 main = example_sat_main_single_expr model
diff --git a/lib/gecodeglue.cpp b/lib/gecodeglue.cpp
--- a/lib/gecodeglue.cpp
+++ b/lib/gecodeglue.cpp
@@ -821,7 +821,7 @@
 } gecode_search_data_t;
 
 gecode_search_data_t static *gecode_search_create(HaskellModel *model, gecode_search_type typ) {
-  Search::Options o = Search::Options::Options();
+  Search::Options o = Search::Options();
   o.c_d = 1;
   gecode_search_data_t *srch=new gecode_search_data_t;
 #ifndef NDEBUG
@@ -877,6 +877,8 @@
       res=srch->dat.bab->next();
       break;
     }
+    default:
+    res=NULL;
   }
 #ifndef NDEBUG
   cerr << "[search " << srch << "] requested next (" << res << ")\n";
diff --git a/monadiccp.cabal b/monadiccp.cabal
--- a/monadiccp.cabal
+++ b/monadiccp.cabal
@@ -1,5 +1,5 @@
 Name:			monadiccp
-Version:		0.7.1
+Version:		0.7.2
 Description:		Monadic Constraint Programming framework
 License:		BSD3
 License-file:		LICENSE
@@ -9,6 +9,7 @@
 Category:		control
 Synopsis:		Constraint Programming
 Homepage:		http://users.ugent.be/~tschrijv/MCP/
+Bug-reports:		http://trac.haskell.org/monadiccp/
 Cabal-Version:		>=1.6
 Extra-Source-Files: 	examples/*.hs lib/*.cpp lib/*.h
 
@@ -23,7 +24,7 @@
     Default:		False
 
 library
-    Build-Depends:	base >= 2, base < 5, containers, mtl, haskell98, random, pretty, Monatron >= 0.3
+    Build-Depends:	base >= 2, base < 5, containers, mtl, haskell98, random, pretty, parsec >= 3.0
     Exposed-Modules:	Data.Expr.Sugar
                         Control.CP.SearchTree
                         Control.CP.Transformers
@@ -39,21 +40,56 @@
                         Control.CP.FD.Gecode.CodegenSolver
                         Control.CP.FD.Model
                         Control.CP.FD.Example
+                        Control.CP.FD.FD
+                        Control.CP.FD.Gecode.Common
     Other-Modules:	Data.Expr.Data
                         Data.Expr.Util
                         Data.Linear
-                        Control.CP.FD.Gecode.Common
                         Control.CP.FD.OvertonFD.Domain
                         Control.CP.FD.SimpleFD
                         Control.CP.FD.Graph
                         Control.CP.FD.Decompose
-                        Control.CP.FD.FD
+                        Control.CP.FD.SearchSpec.Data
                         Control.CP.Debug
                         Control.Mixin.Mixin
-                        Control.CP.SearchSpec.Language
-                        Control.CP.SearchSpec.Generator
                         Language.CPP.Syntax.AST
                         Language.CPP.Pretty
+                        Control.Search.Language
+                        Control.Search.Stat
+                        Control.Search.Generator
+                        Control.Search.Combinator.For
+                        Control.Search.Combinator.Until
+                        Control.Search.Combinator.If
+                        Control.Search.Combinator.OrRepeat
+                        Control.Search.Combinator.Let
+                        Control.Search.Combinator.Success
+                        Control.Search.Combinator.Base
+                        Control.Search.Combinator.Failure
+                        Control.Search.Combinator.Once
+                        Control.Search.Combinator.And
+                        Control.Search.Combinator.Repeat
+                        Control.Search.Combinator.Or
+                        Control.Search.Combinator.Post
+                        Control.Search.Combinator.Misc
+                        Control.Search.Combinator.Print
+                        Control.Search.Memo
+                        Control.Search.GeneratorInfo
+                        Control.Search.Constraints
+                        Control.Search.MemoReader
+                        Control.Search.SStateT
+                        Control.Monatron.Monatron
+                        Control.Monatron.MonadInfo
+                        Control.Monatron.AutoLift
+                        Control.Monatron.Operations
+                        Control.Monatron.Zipper
+                        Control.Monatron.IdT
+                        Control.Monatron.Codensity
+                        Control.Monatron.Transformer
+                        Control.Monatron.Open
+                        Control.Monatron.AutoInstances
+                        Control.Monatron.MonadT
+                        Control.Monatron.Monad
+                        Control.Monatron.ZipperExamples
     GHC-Prof-Options:	-auto-all -caf-all
     Include-Dirs:	lib
     if flag(Debug)
@@ -66,6 +102,6 @@
         Extra-Libraries:	gecodesupport gecodeset gecodeint gecodekernel gecodesearch
         Exposed-Modules:	Control.CP.FD.Gecode.Runtime
                                 Control.CP.FD.Gecode.RuntimeSearch
-        Other-Modules:		Control.CP.FD.Gecode.Interface
+                                Control.CP.FD.Gecode.Interface
         CPP-Options:		-DRGECODE
         Frameworks:		gecode