diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (C) 2013 Maik Riechert
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+The names of its contributors may not be used to endorse or promote products
+derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/adp-multi-monadiccp.cabal b/adp-multi-monadiccp.cabal
new file mode 100644
--- /dev/null
+++ b/adp-multi-monadiccp.cabal
@@ -0,0 +1,40 @@
+name:           adp-multi-monadiccp
+version:        0.1
+cabal-version:  >=1.8
+build-type:     Simple
+author:         Maik Riechert
+stability:      experimental
+bug-reports:    https://github.com/neothemachine/adp-multi-monadiccp/issues
+homepage:       http://adp-multi.ruhoh.com
+copyright:      Maik Riechert, 2013
+license:        BSD3
+license-file:   LICENSE
+tested-with:    GHC==7.4.1
+maintainer:     Maik Riechert
+category:       Algorithms, Data Structures, Bioinformatics
+synopsis:       Subword construction in adp-multi using monadiccp
+description:    
+                This is an experimental subword construction algorithm
+                for the adp-multi package. It uses the constraint
+                programming framework monadiccp with the constraint solver
+                OvertonFD. It is slower than the built-in algorithm in
+                adp-multi and serves research purposes.
+                Use it by importing ADP.Multi.Constraint.All instead
+                of ADP.Multi.Rewriting.All in your grammar files.
+
+source-repository head
+  type:      git
+  location:  git://github.com/neothemachine/adp-multi-monadiccp.git
+
+library
+  hs-source-dirs:  src
+  build-depends:   base == 4.*,
+                   containers >= 0.4 && < 0.6,
+                   adp-multi == 0.2.*,
+                   monadiccp == 0.7.*
+  ghc-options:     -Wall
+  exposed-modules: 
+                   ADP.Multi.Constraint.All,
+                   ADP.Multi.Constraint.Combinators,
+                   ADP.Multi.Constraint.ConstraintSolver
+  other-modules:   ADP.Multi.Constraint.MonadicCpHelper
diff --git a/src/ADP/Multi/Constraint/All.hs b/src/ADP/Multi/Constraint/All.hs
new file mode 100644
--- /dev/null
+++ b/src/ADP/Multi/Constraint/All.hs
@@ -0,0 +1,6 @@
+-- | Convenience module to import the specific rewriting function model
+--   and combinator implementation known as /constraint solver/.
+module ADP.Multi.Constraint.All (module X) where
+
+import ADP.Multi.Rewriting.Model as X
+import ADP.Multi.Constraint.Combinators()
diff --git a/src/ADP/Multi/Constraint/Combinators.hs b/src/ADP/Multi/Constraint/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/ADP/Multi/Constraint/Combinators.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{- |
+Use this set of combinators instead of ADP.Multi.Rewriting.Combinators to
+use a constraint solver for constructing the subword ranges.
+
+Note: This is experimental and slow.
+-} 
+module ADP.Multi.Constraint.Combinators where
+
+import ADP.Multi.Combinators
+import ADP.Multi.Rewriting.YieldSize
+import ADP.Multi.Rewriting.Model
+import ADP.Multi.Constraint.ConstraintSolver
+
+instance Rewritable Dim1 a b where
+    (>>>) (infos,p) f = 
+      (determineYieldSize1 f infos, rewrite constructSubwords1 (infos,p) f)
+    
+instance Rewritable Dim2 a b where
+    (>>>) (infos,p) f = 
+      (determineYieldSize2 f infos, rewrite constructSubwords2 (infos,p) f)
diff --git a/src/ADP/Multi/Constraint/ConstraintSolver.hs b/src/ADP/Multi/Constraint/ConstraintSolver.hs
new file mode 100644
--- /dev/null
+++ b/src/ADP/Multi/Constraint/ConstraintSolver.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies      #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+{-
+Use monadiccp as a finite-domain constraint solver to construct
+subwords in a generic way.
+
+TODO It is slow as hell. Maybe it is possible to "compile" the two inequality
+     systems so that they can later be run faster.
+     see http://www.cs.washington.edu/research/constraints/solvers/cp97.html
+-}
+module ADP.Multi.Constraint.ConstraintSolver (
+        constructSubwords1,
+        constructSubwords2
+) where
+
+import Control.Exception 
+import qualified Data.Map as Map
+import Data.Maybe (fromJust, isNothing)
+
+import ADP.Debug
+import ADP.Multi.Parser
+import ADP.Multi.Rewriting
+import ADP.Multi.Rewriting.Model
+import ADP.Multi.Rewriting.YieldSize
+import ADP.Multi.Rewriting.RangesHelper
+import ADP.Multi.Constraint.MonadicCpHelper
+import Control.CP.FD.Interface
+
+
+constructSubwords1 :: SubwordConstructionAlgorithm Dim1
+constructSubwords1 _ _ b | trace ("constructSubwords1 " ++ show b) False = undefined
+constructSubwords1 f infos [i,j] =
+        assert (i <= j) $
+        let yieldSizeMap = buildYieldSizeMap infos
+            symbolIDs = Map.keys yieldSizeMap
+            rewritten = f symbolIDs
+            parserCount = length infos
+            remainingParsers = [parserCount,parserCount-1..1] `zip` infos
+            rangeDesc = [(i,j,rewritten)]
+            rangeDescFiltered = filterEmptyRanges rangeDesc
+        in trace ("f " ++ show symbolIDs ++ " = " ++ show rewritten) $
+           assert (length rewritten == Map.size yieldSizeMap && all (`elem` rewritten) symbolIDs) $
+           if any (\(m,n,d) -> null d && m /= n) rangeDesc then []
+           else constructSubwordsRec yieldSizeMap remainingParsers rangeDescFiltered
+
+constructSubwords2 :: SubwordConstructionAlgorithm Dim2
+constructSubwords2 _ _ b | trace ("constructSubwords2 " ++ show b) False = undefined
+constructSubwords2 f infos [i,j,k,l] =
+        assert (i <= j && j <= k && k <= l) $
+        let yieldSizeMap = buildYieldSizeMap infos
+            symbolIDs = Map.keys yieldSizeMap
+            (left,right) = f symbolIDs
+            parserCount = length infos
+            remainingParsers = [parserCount,parserCount-1..1] `zip` infos
+            rangeDesc = [(i,j,left),(k,l,right)]
+            rangeDescFiltered = filterEmptyRanges rangeDesc
+        in trace ("f " ++ show symbolIDs ++ " = (" ++ show left ++ "," ++ show right ++ ")") $
+           assert (length left + length right == Map.size yieldSizeMap && all (`elem` (left ++ right)) symbolIDs) $
+           if any (\(m,n,d) -> null d && m /= n) rangeDesc then []
+           else constructSubwordsRec yieldSizeMap remainingParsers rangeDescFiltered
+
+
+
+constructSubwordsRec :: YieldSizeMap -> [(Int,ParserInfo)] -> [RangeDesc] -> [SubwordTree]
+constructSubwordsRec a b c | trace ("constructRangesRec " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
+constructSubwordsRec _ [] [] = []
+constructSubwordsRec yieldSizeMap ((current,ParserInfo1 {}):rest) rangeDescs =
+        let symbolLoc = findSymbol1 current rangeDescs
+            subwords = calcSubwords1 yieldSizeMap symbolLoc
+        in trace ("calc subwords for dim1") $
+           trace ("subwords: " ++ show subwords) $
+           [ SubwordTree [i,j] restTrees |
+             (i,j) <- subwords,
+             let newDescs = constructNewRangeDescs1 rangeDescs symbolLoc (i,j),
+             let restTrees = constructSubwordsRec yieldSizeMap rest newDescs
+           ]
+constructSubwordsRec yieldSizeMap ((current,ParserInfo2 {}):rest) rangeDescs =
+        let symbolLocs = findSymbol2 current rangeDescs
+            subwords = calcSubwords2 yieldSizeMap symbolLocs
+        in trace ("calc subwords for dim2") $
+           trace ("subwords: " ++ show subwords) $
+           [ SubwordTree [i,j,k,l] restTrees |
+             (i,j,k,l) <- subwords,
+             let newDescs = constructNewRangeDescs2 rangeDescs symbolLocs (i,j,k,l),
+             let restTrees = constructSubwordsRec yieldSizeMap rest newDescs
+           ]
+constructSubwordsRec _ [] r@(_:_) = error ("programming error " ++ show r)
+
+
+calcSubwords2 :: YieldSizeMap -> ((RangeDesc,Int),(RangeDesc,Int)) -> [Subword2]
+calcSubwords2 a b | trace ("calcSubwords " ++ show a ++ " " ++ show b) False = undefined
+calcSubwords2 infoMap (left@((i,j,r),a1Idx),right@((_,_,r'),a2Idx))
+  | r == r' = calcSubwords2Dependent infoMap (i,j,r) a1Idx a2Idx
+  | otherwise = [ (i',j',k',l') |
+                  (i',j') <- calcSubwords1 infoMap left
+                , (k',l') <- calcSubwords1 infoMap right
+                ]
+
+-- assumes that other component is in a different part
+calcSubwords1 :: YieldSizeMap -> (RangeDesc,Int) -> [Subword1]
+calcSubwords1 _ b | trace ("calcSubwordsIndependent " ++ show b) False = undefined
+calcSubwords1 infoMap pos@((i,j,_),_) =
+        let (minY,maxY) = yieldSizeOf infoMap pos
+            (minYLeft,maxYLeft) = combinedYieldSizeLeftOf infoMap pos
+            (minYRight,maxYRight) = combinedYieldSizeRightOf infoMap pos
+            model :: FDModel
+            model = exists $ \col -> do
+                  let rangeLen = fromIntegral (j-i)
+                      [minY',minYLeft',minYRight'] = map fromIntegral [minY,minYLeft,minYRight]
+                      [maxY',maxYLeft',maxYRight'] = map (maybe rangeLen fromIntegral) [maxY,maxYLeft,maxYRight]
+                      -- TODO instead of using a safe default (rangeLen), it might be better not to
+                      --      include a new inequality at all (how?)
+                  [len1,len2,len3] <- colList col 3
+                  xsum col @= rangeLen
+                  len1 @>= minYLeft' 
+                  len2 @>= minY'
+                  len3 @>= minYRight'
+                  len1 @<= maxYLeft'
+                  len2 @<= maxY'
+                  len3 @<= maxYRight'
+                  rangeLen - maxYLeft'  @<= len2 + len3
+                  rangeLen - maxYRight' @<= len1 + len2
+                  rangeLen - maxY'      @<= len1 + len3
+                  return col
+        in map (\[len1,_,len3] -> (i+len1, j-len3)) $ solveModel model
+
+
+calcSubwords2Dependent :: YieldSizeMap -> RangeDesc -> Int -> Int -> [Subword2]
+calcSubwords2Dependent _ b c d | trace ("calcSubwordsDependent " ++ show b ++ " " ++ show c ++ " " ++ show d) False = undefined
+calcSubwords2Dependent infoMap desc a1Idx a2Idx =
+        let a1Idx' = if a1Idx < a2Idx then a1Idx else a2Idx
+            a2Idx' = if a1Idx < a2Idx then a2Idx else a1Idx
+            subs = doCalcSubwords2Dependent infoMap desc a1Idx' a2Idx'
+        in if a1Idx < a2Idx then subs
+           else [ (k,l,m,n) | (m,n,k,l) <- subs ]
+
+doCalcSubwords2Dependent :: YieldSizeMap -> RangeDesc -> Int -> Int -> [Subword2]
+doCalcSubwords2Dependent infoMap desc@(i,j,_) a1Idx a2Idx =
+        let (minY1,maxY1) = yieldSizeOf infoMap (desc,a1Idx)
+            (minY2,maxY2) = yieldSizeOf infoMap (desc,a2Idx)
+            (minYLeft1,maxYLeft1) = combinedYieldSizeLeftOf infoMap (desc,a1Idx)
+            (minYRight1,maxYRight1) = combinedYieldSizeRightOf infoMap (desc,a1Idx)
+            (minYRight2,maxYRight2) = combinedYieldSizeRightOf infoMap (desc,a2Idx)
+            minYBetween = minYRight1 - minYRight2 - minY2
+            maxYBetween | a1Idx + 1 == a2Idx = Just 0
+                        | isNothing maxYRight1 = Nothing
+                        | otherwise = Just $ fromJust maxYRight1 - fromJust maxYRight2 - fromJust maxY2
+            model :: FDModel
+            model = exists $ \col -> do
+                  let rangeLen = fromIntegral (j-i)
+                      [minYLeft1',minY1',minYBetween',minY2',minYRight2'] =
+                          map fromIntegral [minYLeft1,minY1,minYBetween,minY2,minYRight2]
+                      [maxYLeft1',maxY1',maxYBetween',maxY2',maxYRight2'] =
+                          map (maybe rangeLen fromIntegral) [maxYLeft1,maxY1,maxYBetween,maxY2,maxYRight2]
+
+                  [lenLeft1,len1,lenBetween,len2,lenRight2] <- colList col 5
+                  xsum col @= rangeLen
+                  lenLeft1   @>= minYLeft1'
+                  len1       @>= minY1'
+                  lenBetween @>= minYBetween'
+                  len2       @>= minY2'
+                  lenRight2  @>= minYRight2'
+                  lenLeft1   @<= maxYLeft1'
+                  len1       @<= maxY1'
+                  lenBetween @<= maxYBetween'
+                  len2       @<= maxY2'
+                  lenRight2  @<= maxYRight2'
+                  rangeLen - maxYLeft1'   @<= len1 + lenBetween + len2 + lenRight2
+                  rangeLen - maxY1'       @<= lenLeft1 + lenBetween + len2 + lenRight2
+                  rangeLen - maxYBetween' @<= lenLeft1 + len1 + len2 + lenRight2
+                  rangeLen - maxY2'       @<= lenLeft1 + len1 + lenBetween + lenRight2
+                  rangeLen - maxYRight2'  @<= lenLeft1 + len1 + lenBetween + len2
+                  return col
+        in map (\ [lenLeft1,len1,_,len2,lenRight2] ->
+                  ( i + lenLeft1
+                  , i + lenLeft1 + len1
+                  , j - lenRight2 - len2
+                  , j - lenRight2
+                  )
+               ) $ solveModel model
diff --git a/src/ADP/Multi/Constraint/MonadicCpHelper.hs b/src/ADP/Multi/Constraint/MonadicCpHelper.hs
new file mode 100644
--- /dev/null
+++ b/src/ADP/Multi/Constraint/MonadicCpHelper.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module ADP.Multi.Constraint.MonadicCpHelper (
+        FDModel
+      , solveModel
+) where
+
+import Control.CP.FD.OvertonFD.OvertonFD
+import Control.CP.FD.OvertonFD.Sugar()
+import Control.CP.FD.FD (FDIntTerm, getMinimizeVar)
+import Control.CP.FD.Model
+
+import Control.CP.FD.Interface
+import Control.CP.SearchTree
+import Control.CP.EnumTerm
+import Control.CP.ComposableTransformers
+import Control.CP.FD.Solvers
+
+import ADP.Debug
+
+type FDModel = 
+      forall s m. (Show (FDIntTerm s), FDSolver s, MonadTree m, TreeSolver m ~ FDInstance s) 
+      => m ModelCol
+
+solveModel :: Tree (FDInstance OvertonFD) ModelCol -> [[Int]]
+solveModel f = 
+        let (visitedNodes, result) = solve dfs it $ f >>= labeller
+        in trace ("FD model solved, nodes visited: " ++ show visitedNodes) result
+
+labeller :: forall s m.
+            (Show (FDIntTerm s), EnumTerm s (FDIntTerm s), FDSolver s, MonadTree m, TreeSolver m ~ FDInstance s)
+            => ModelCol -> m [TermBaseType s (FDIntTerm s)]
+labeller col =
+  label $ do
+    minVar <- getMinimizeVar
+    case minVar of
+      Nothing -> return $ labelCol col
+      Just v -> return $ do
+        enumerate [v]
+        labelCol col