diff --git a/.travis.yml b/.travis.yml
--- a/.travis.yml
+++ b/.travis.yml
@@ -10,26 +10,22 @@
 # - CABALVER=1.16 GHCVER=7.2.1
 # - CABALVER=1.16 GHCVER=7.2.2
 # - CABALVER=1.16 GHCVER=7.4.1
- - CABALVER=1.16 GHCVER=7.4.2
+# - CABALVER=1.16 GHCVER=7.4.2
 # - CABALVER=1.16 GHCVER=7.6.1
 # - CABALVER=1.16 GHCVER=7.6.2
  - CABALVER=1.18 GHCVER=7.6.3
 # - CABALVER=1.18 GHCVER=7.8.1  # see note about Alex/Happy for GHC >= 7.8
 # - CABALVER=1.18 GHCVER=7.8.2
- - CABALVER=1.18 GHCVER=7.8.3
- - CABALVER=1.22 GHCVER=7.10.1
+ - CABALVER=1.18 GHCVER=7.8.3 COVERAGE=1
+ - CABALVER=1.22 GHCVER=7.10.2
 # - CABALVER=head GHCVER=head   # see section about GHC HEAD snapshots
 
-matrix:
-  allow_failures:
-   - env: CABALVER=1.22 GHCVER=7.10.1
-
 # Note: the distinction between `before_install` and `install` is not important.
 before_install:
  - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
  - travis_retry sudo apt-get update
  - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex
- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH:$PATH
  - |
    if [ $GHCVER = "head" ] || [ ${GHCVER%.*} = "7.8" ] || [ ${GHCVER%.*} = "7.10" ]; then
      travis_retry sudo apt-get install happy-1.19.4 alex-3.1.3
@@ -43,11 +39,12 @@
  - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
  - travis_retry cabal update
  - cabal install --only-dependencies --enable-tests --enable-benchmarks --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+ - "[ -n \"$COVERAGE\" ] && cabal install hpc-coveralls --avoid-reinstalls || true"
 
 # Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.
 script:
  - if [ -f configure.ac ]; then autoreconf -i; fi
- - cabal configure --enable-tests --enable-benchmarks -v2 --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms # -v2 provides useful information for debugging
+ - cabal configure --enable-tests --enable-benchmarks -v2 --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms $([ "$COVERAGE" = "1" ] && echo "--enable-library-coverage") # -v2 provides useful information for debugging
  - cabal build   # this builds all libraries and executables (including tests/benchmarks)
  - cabal test
  - cabal check
@@ -61,4 +58,8 @@
    else
       echo "expected '$SRC_TGZ' not found";
       exit 1;
-   fi
+   fi ;
+   cd ..
+
+after_script:
+ - "[ -n \"$COVERAGE\" ] && hpc-coveralls TestSAT TestSimplex TestSimplex2 TestMIPSolver2 TestPolynomial TestAReal TestArith TestContiTraverso TestCongruenceClosure TestLPFile TestMPSFile TestPBFile TestSDPFile TestUtil --exclude-dir=test || true"
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
 toysolver
 =========
 
-[![Build Status](https://secure.travis-ci.org/msakai/toysolver.png?branch=master)](http://travis-ci.org/msakai/toysolver) [![Hackage](https://budueba.com/hackage/toysolver)](https://hackage.haskell.org/package/toysolver)
+[![Build Status](https://secure.travis-ci.org/msakai/toysolver.png?branch=master)](http://travis-ci.org/msakai/toysolver) [![Coverage Status](https://coveralls.io/repos/msakai/toysolver/badge.svg)](https://coveralls.io/r/msakai/toysolver) [![Hackage](https://budueba.com/hackage/toysolver)](https://hackage.haskell.org/package/toysolver)
 
 Assorted decision procedures for SAT, Max-SAT, PB, MIP, etc.
 
diff --git a/build_bdist_linux-i386.sh b/build_bdist_linux-i386.sh
new file mode 100644
--- /dev/null
+++ b/build_bdist_linux-i386.sh
@@ -0,0 +1,27 @@
+#!/bin/bash
+export CABALVER=1.18
+export GHCVER=7.8.4
+
+sudo add-apt-repository -y ppa:hvr/ghc
+sudo apt-get update
+
+sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
+export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH
+
+sudo apt-get install happy-1.19.4 alex-3.1.3
+export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH
+
+cabal sandbox init
+cabal update
+cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+cabal configure --disable-shared --ghc-options="-static -optl-static -optl-pthread" --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+cabal build
+
+VER=`ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'`
+
+PKG=toysolver-$VER-linux-i386
+
+rm -r $PKG
+mkdir $PKG
+cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysolver/toysolver $PKG/
+tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai
diff --git a/build_bdist_linux-x86_64.sh b/build_bdist_linux-x86_64.sh
new file mode 100644
--- /dev/null
+++ b/build_bdist_linux-x86_64.sh
@@ -0,0 +1,27 @@
+#!/bin/bash
+export CABALVER=1.18
+export GHCVER=7.8.4
+
+sudo add-apt-repository -y ppa:hvr/ghc
+sudo apt-get update
+
+sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
+export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH
+
+sudo apt-get install happy-1.19.4 alex-3.1.3
+export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH
+
+cabal sandbox init
+cabal update
+cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+cabal configure --disable-shared --ghc-options="-static -optl-static -optl-pthread" --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+cabal build
+
+VER=`ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'`
+
+PKG=toysolver-$VER-linux-x86_64
+
+rm -r $PKG
+mkdir $PKG
+cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysolver/toysolver $PKG/
+tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai
diff --git a/build_bdist_macos.sh b/build_bdist_macos.sh
new file mode 100644
--- /dev/null
+++ b/build_bdist_macos.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+
+cabal sandbox init
+cabal update
+cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+cabal configure --ghc-options="-optl-mmacosx-version-min=10.6" --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+cabal build
+
+VER=`ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'`
+
+PKG=toysolver-$VER-macos
+
+rm -r $PKG
+mkdir $PKG
+cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysolver/toysolver $PKG/
+zip -r $PKG.zip $PKG
diff --git a/build_bdist_win32.sh b/build_bdist_win32.sh
new file mode 100644
--- /dev/null
+++ b/build_bdist_win32.sh
@@ -0,0 +1,25 @@
+#!/bin/bash
+sudo apt-get update
+sudo apt-get install wine wget cabal-install
+
+wget https://www.haskell.org/platform/download/2014.2.0.0/HaskellPlatform-2014.2.0.0-i386-setup.exe
+wine HaskellPlatform-2014.2.0.0-i386-setup.exe
+
+# https://plus.google.com/+MasahiroSakai/posts/RTXUt5MkVPt
+#wine cabal update
+cabal update
+cp -a ~/.cabal/packages ~/.wine/drive_c/users/`whoami`/Application\ Data/cabal/
+
+wine cabal sandbox init
+wine cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+wine cabal configure --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+wine cabal build
+
+VER=`wine ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version System.IO" -e "hSetBinaryMode stdout True" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'`
+
+PKG=toysolver-$VER-win32
+
+rm -r $PKG
+mkdir $PKG
+cp dist/build/htc/htc.exe dist/build/knapsack/knapsack.exe dist/build/lpconvert/lpconvert.exe dist/build/nqueens/nqueens.exe dist/build/pbconvert/pbconvert.exe dist/build/sudoku/sudoku.exe dist/build/toyfmf/toyfmf.exe dist/build/toysat/toysat.exe dist/build/ToySolver/toysolver.exe $PKG/
+zip -r $PKG.zip $PKG
diff --git a/build_bdist_win64.sh b/build_bdist_win64.sh
new file mode 100644
--- /dev/null
+++ b/build_bdist_win64.sh
@@ -0,0 +1,25 @@
+#!/bin/bash
+sudo apt-get update
+sudo apt-get install wine wget cabal-install
+
+wget https://www.haskell.org/platform/download/2014.2.0.0/HaskellPlatform-2014.2.0.0-x86_64-setup.exe
+wine HaskellPlatform-2014.2.0.0-x86_64-setup.exe
+
+# https://plus.google.com/+MasahiroSakai/posts/RTXUt5MkVPt
+#wine cabal update
+cabal update
+cp -a ~/.cabal/packages ~/.wine/drive_c/users/`whoami`/Application\ Data/cabal/
+
+wine cabal sandbox init
+wine cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+wine cabal configure --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms
+wine cabal build
+
+VER=`wine ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version System.IO" -e "hSetBinaryMode stdout True" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'`
+
+PKG=toysolver-$VER-win64
+
+rm -r $PKG
+mkdir $PKG
+cp dist/build/htc/htc.exe dist/build/knapsack/knapsack.exe dist/build/lpconvert/lpconvert.exe dist/build/nqueens/nqueens.exe dist/build/pbconvert/pbconvert.exe dist/build/sudoku/sudoku.exe dist/build/toyfmf/toyfmf.exe dist/build/toysat/toysat.exe dist/build/ToySolver/toysolver.exe $PKG/
+zip -r $PKG.zip $PKG
diff --git a/lpconvert/lpconvert.hs b/lpconvert/lpconvert.hs
--- a/lpconvert/lpconvert.hs
+++ b/lpconvert/lpconvert.hs
@@ -23,10 +23,10 @@
 import System.Console.GetOpt
 import qualified Language.CNF.Parse.ParseDIMACS as DIMACS
 
+import qualified Data.PseudoBoolean as PBFile
+
 import qualified ToySolver.Data.MIP as MIP
-import qualified ToySolver.Text.LPFile as LPFile
 import qualified ToySolver.Text.MaxSAT as MaxSAT
-import qualified ToySolver.Text.PBFile as PBFile
 import ToySolver.Converter.ObjType
 import qualified ToySolver.Converter.MIP2SMT as MIP2SMT
 import qualified ToySolver.Converter.MaxSAT2IP as MaxSAT2IP
@@ -159,7 +159,7 @@
 
   case head ([Just fname | Output fname <- o] ++ [Nothing]) of
     Nothing -> 
-      case LPFile.render mip of
+      case MIP.toLPString mip of
         Left err -> hPutStrLn stderr ("conversion failure: " ++ err) >> exitFailure
         Right s -> putStr s
     Just fname -> do
diff --git a/pbconvert/pbconvert.hs b/pbconvert/pbconvert.hs
--- a/pbconvert/pbconvert.hs
+++ b/pbconvert/pbconvert.hs
@@ -23,9 +23,11 @@
 import System.Console.GetOpt
 import qualified Language.CNF.Parse.ParseDIMACS as DIMACS
 
+import qualified Data.PseudoBoolean as PBFile
+import qualified Data.PseudoBoolean.Attoparsec as PBFileAttoparsec
+
 import qualified ToySolver.Data.MIP as MIP
 import qualified ToySolver.Text.MaxSAT as MaxSAT
-import qualified ToySolver.Text.PBFile as PBFile
 import ToySolver.Converter.ObjType
 import qualified ToySolver.Converter.SAT2PB as SAT2PB
 import qualified ToySolver.Converter.MIP2SMT as MIP2SMT
@@ -101,14 +103,14 @@
             Right cnf -> return $ Left $ SAT2PB.convert cnf
     ".wcnf" -> readWCNF
     ".opb"  -> do
-      ret <- PBFile.parseOPBFile fname
+      ret <- PBFileAttoparsec.parseOPBFile fname
       case ret of
-        Left err -> hPrint stderr err >> exitFailure
+        Left err -> hPutStrLn stderr err >> exitFailure
         Right opb -> return $ Left opb
     ".wbo"  -> do
-      ret <- PBFile.parseWBOFile fname
+      ret <- PBFileAttoparsec.parseWBOFile fname
       case ret of
-        Left err -> hPrint stderr err >> exitFailure
+        Left err -> hPutStrLn stderr err >> exitFailure
         Right wbo -> return $ Right wbo
     ext ->
       error $ "unknown file extension: " ++ show ext
@@ -140,9 +142,11 @@
         }
   case head ([Just fname | Output fname <- o] ++ [Nothing]) of
     Nothing -> do
+      hSetBinaryMode stdout True
+      hSetBuffering stdout (BlockBuffering Nothing)
       case pb of
-        Left opb  -> putStr $ PBFile.renderOPB opb
-        Right wbo -> putStr $ PBFile.renderWBO wbo
+        Left opb  -> PBFile.hPutOPB stdout opb
+        Right wbo -> PBFile.hPutWBO stdout wbo
     Just fname -> do
       let opb = case pb of
                   Left opb  -> opb
@@ -157,8 +161,8 @@
                   Left opb  -> PB2LSP.convert opb
                   Right wbo -> PB2LSP.convertWBO wbo
       case map toLower (takeExtension fname) of
-        ".opb" -> writeFile fname $ PBFile.renderOPB opb
-        ".wbo" -> writeFile fname $ PBFile.renderWBO wbo
+        ".opb" -> PBFile.writeOPBFile fname opb
+        ".wbo" -> PBFile.writeWBOFile fname wbo
         ".lsp" -> writeFile fname (lsp "")
         ".lp" -> MIP.writeLPFile fname lp
         ".mps" -> MIP.writeMPSFile fname lp
diff --git a/pbverify/pbverify.hs b/pbverify/pbverify.hs
--- a/pbverify/pbverify.hs
+++ b/pbverify/pbverify.hs
@@ -4,13 +4,14 @@
 import Data.Array.IArray
 import System.Environment
 import Text.Printf
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
+import qualified Data.PseudoBoolean.Attoparsec as PBFileAttoparsec
 import ToySolver.SAT.Types
 
 main :: IO ()
 main = do
   [problemFile, modelFile] <- getArgs
-  Right formula <- PBFile.parseOPBFile problemFile
+  Right formula <- PBFileAttoparsec.parseOPBFile problemFile
   model <- liftM readModel (readFile modelFile)
   forM_ (PBFile.pbConstraints formula) $ \c ->
     unless (eval model c) $
diff --git a/pigeonhole/pigeonhole.hs b/pigeonhole/pigeonhole.hs
--- a/pigeonhole/pigeonhole.hs
+++ b/pigeonhole/pigeonhole.hs
@@ -6,7 +6,7 @@
 import System.Environment
 import System.Exit
 import System.IO
-import ToySolver.Text.PBFile as PBFile
+import Data.PseudoBoolean as PBFile
 
 pigeonHole :: Integer -> Integer -> Formula
 pigeonHole p h =
@@ -35,7 +35,7 @@
   case xs of
     [p,h] -> do
       let opb = pigeonHole (read p) (read h)
-      putStr $ renderOPB opb
+      hPutOPB stdout opb
     _ -> do
       hPutStrLn stderr "Usage: pigeonhole number_of_pigeons number_of_holes"
       exitFailure
diff --git a/samples/gcnf/edn_20403_8.cnf_0.03000000.unsat.gcnf b/samples/gcnf/edn_20403_8.cnf_0.03000000.unsat.gcnf
new file mode 100644
# file too large to diff: samples/gcnf/edn_20403_8.cnf_0.03000000.unsat.gcnf
diff --git a/samples/lp/test_utf-8.lp b/samples/lp/test_utf-8.lp
new file mode 100644
--- /dev/null
+++ b/samples/lp/test_utf-8.lp
@@ -0,0 +1,13 @@
+\...
+Maximize
+ obj: ほげ + 2 x2 + 3 x3 + x4
+Subject To
+ c1: - ほげ + x2 + x3 + 10 x4 <= 20
+ c2: ほげ - 3 x2 + x3 <= 30
+ c3: x2 - 3.5 x4 = 0
+Bounds
+ 0 <= ほげ <= 40
+ 2 <= x4 <= 3
+General
+ x4
+End
diff --git a/samples/maxsat/ram_k3_n10.ra1.wcnf b/samples/maxsat/ram_k3_n10.ra1.wcnf
new file mode 100644
--- /dev/null
+++ b/samples/maxsat/ram_k3_n10.ra1.wcnf
@@ -0,0 +1,331 @@
+p wcnf 45 330
+ 890 1 2 10 0
+ 238 1 3 11 0
+ 352 2 3 18 0
+ 853 10 11 18 0
+ 319 1 4 12 0
+ 129 2 4 19 0
+ 656 10 12 19 0
+ 870 3 4 25 0
+ 88 11 12 25 0
+ 705 18 19 25 0
+ 415 1 5 13 0
+ 955 2 5 20 0
+ 56 10 13 20 0
+ 178 3 5 26 0
+ 610 11 13 26 0
+ 81 18 20 26 0
+ 239 4 5 31 0
+ 830 12 13 31 0
+ 393 19 20 31 0
+ 433 25 26 31 0
+ 124 1 6 14 0
+ 385 2 6 21 0
+ 605 10 14 21 0
+ 525 3 6 27 0
+ 793 11 14 27 0
+ 657 18 21 27 0
+ 177 4 6 32 0
+ 423 12 14 32 0
+ 509 19 21 32 0
+ 616 25 27 32 0
+ 40 5 6 36 0
+ 183 13 14 36 0
+ 356 20 21 36 0
+ 996 26 27 36 0
+ 163 31 32 36 0
+ 658 1 7 15 0
+ 582 2 7 22 0
+ 566 10 15 22 0
+ 357 3 7 28 0
+ 764 11 15 28 0
+ 267 18 22 28 0
+ 187 4 7 33 0
+ 454 12 15 33 0
+ 359 19 22 33 0
+ 923 25 28 33 0
+ 784 5 7 37 0
+ 497 13 15 37 0
+ 846 20 22 37 0
+ 680 26 28 37 0
+ 363 31 33 37 0
+ 563 6 7 40 0
+ 623 14 15 40 0
+ 653 21 22 40 0
+ 183 27 28 40 0
+ 847 32 33 40 0
+ 519 36 37 40 0
+ 140 1 8 16 0
+ 221 2 8 23 0
+ 618 10 16 23 0
+ 317 3 8 29 0
+ 260 11 16 29 0
+ 56 18 23 29 0
+ 698 4 8 34 0
+ 522 12 16 34 0
+ 661 19 23 34 0
+ 283 25 29 34 0
+ 62 5 8 38 0
+ 464 13 16 38 0
+ 928 20 23 38 0
+ 597 26 29 38 0
+ 200 31 34 38 0
+ 888 6 8 41 0
+ 304 14 16 41 0
+ 664 21 23 41 0
+ 860 27 29 41 0
+ 139 32 34 41 0
+ 365 36 38 41 0
+ 908 7 8 43 0
+ 807 15 16 43 0
+ 80 22 23 43 0
+ 256 28 29 43 0
+ 336 33 34 43 0
+ 200 37 38 43 0
+ 855 40 41 43 0
+ 131 1 9 17 0
+ 523 2 9 24 0
+ 239 10 17 24 0
+ 634 3 9 30 0
+ 407 11 17 30 0
+ 895 18 24 30 0
+ 694 4 9 35 0
+ 456 12 17 35 0
+ 466 19 24 35 0
+ 417 25 30 35 0
+ 931 5 9 39 0
+ 300 13 17 39 0
+ 429 20 24 39 0
+ 826 26 30 39 0
+ 85 31 35 39 0
+ 508 6 9 42 0
+ 619 14 17 42 0
+ 526 21 24 42 0
+ 984 27 30 42 0
+ 682 32 35 42 0
+ 354 36 39 42 0
+ 271 7 9 44 0
+ 450 15 17 44 0
+ 187 22 24 44 0
+ 675 28 30 44 0
+ 762 33 35 44 0
+ 623 37 39 44 0
+ 378 40 42 44 0
+ 652 8 9 45 0
+ 288 16 17 45 0
+ 900 23 24 45 0
+ 675 29 30 45 0
+ 883 34 35 45 0
+ 524 38 39 45 0
+ 147 41 42 45 0
+ 622 43 44 45 0
+ 809 -1 -2 -3 -10 -11 -18 0
+ 624 -1 -2 -4 -10 -12 -19 0
+ 784 -1 -3 -4 -11 -12 -25 0
+ 43 -2 -3 -4 -18 -19 -25 0
+ 485 -10 -11 -12 -18 -19 -25 0
+ 722 -1 -2 -5 -10 -13 -20 0
+ 382 -1 -3 -5 -11 -13 -26 0
+ 424 -2 -3 -5 -18 -20 -26 0
+ 406 -10 -11 -13 -18 -20 -26 0
+ 979 -1 -4 -5 -12 -13 -31 0
+ 394 -2 -4 -5 -19 -20 -31 0
+ 648 -10 -12 -13 -19 -20 -31 0
+ 44 -3 -4 -5 -25 -26 -31 0
+ 286 -11 -12 -13 -25 -26 -31 0
+ 637 -18 -19 -20 -25 -26 -31 0
+ 209 -1 -2 -6 -10 -14 -21 0
+ 694 -1 -3 -6 -11 -14 -27 0
+ 766 -2 -3 -6 -18 -21 -27 0
+ 167 -10 -11 -14 -18 -21 -27 0
+ 20 -1 -4 -6 -12 -14 -32 0
+ 272 -2 -4 -6 -19 -21 -32 0
+ 181 -10 -12 -14 -19 -21 -32 0
+ 153 -3 -4 -6 -25 -27 -32 0
+ 960 -11 -12 -14 -25 -27 -32 0
+ 678 -18 -19 -21 -25 -27 -32 0
+ 384 -1 -5 -6 -13 -14 -36 0
+ 388 -2 -5 -6 -20 -21 -36 0
+ 257 -10 -13 -14 -20 -21 -36 0
+ 358 -3 -5 -6 -26 -27 -36 0
+ 930 -11 -13 -14 -26 -27 -36 0
+ 59 -18 -20 -21 -26 -27 -36 0
+ 859 -4 -5 -6 -31 -32 -36 0
+ 688 -12 -13 -14 -31 -32 -36 0
+ 981 -19 -20 -21 -31 -32 -36 0
+ 393 -25 -26 -27 -31 -32 -36 0
+ 907 -1 -2 -7 -10 -15 -22 0
+ 796 -1 -3 -7 -11 -15 -28 0
+ 622 -2 -3 -7 -18 -22 -28 0
+ 824 -10 -11 -15 -18 -22 -28 0
+ 425 -1 -4 -7 -12 -15 -33 0
+ 464 -2 -4 -7 -19 -22 -33 0
+ 717 -10 -12 -15 -19 -22 -33 0
+ 274 -3 -4 -7 -25 -28 -33 0
+ 370 -11 -12 -15 -25 -28 -33 0
+ 714 -18 -19 -22 -25 -28 -33 0
+ 430 -1 -5 -7 -13 -15 -37 0
+ 211 -2 -5 -7 -20 -22 -37 0
+ 157 -10 -13 -15 -20 -22 -37 0
+ 728 -3 -5 -7 -26 -28 -37 0
+ 533 -11 -13 -15 -26 -28 -37 0
+ 77 -18 -20 -22 -26 -28 -37 0
+ 780 -4 -5 -7 -31 -33 -37 0
+ 700 -12 -13 -15 -31 -33 -37 0
+ 629 -19 -20 -22 -31 -33 -37 0
+ 729 -25 -26 -28 -31 -33 -37 0
+ 671 -1 -6 -7 -14 -15 -40 0
+ 267 -2 -6 -7 -21 -22 -40 0
+ 416 -10 -14 -15 -21 -22 -40 0
+ 512 -3 -6 -7 -27 -28 -40 0
+ 398 -11 -14 -15 -27 -28 -40 0
+ 133 -18 -21 -22 -27 -28 -40 0
+ 109 -4 -6 -7 -32 -33 -40 0
+ 589 -12 -14 -15 -32 -33 -40 0
+ 347 -19 -21 -22 -32 -33 -40 0
+ 509 -25 -27 -28 -32 -33 -40 0
+ 161 -5 -6 -7 -36 -37 -40 0
+ 152 -13 -14 -15 -36 -37 -40 0
+ 503 -20 -21 -22 -36 -37 -40 0
+ 8 -26 -27 -28 -36 -37 -40 0
+ 390 -31 -32 -33 -36 -37 -40 0
+ 150 -1 -2 -8 -10 -16 -23 0
+ 463 -1 -3 -8 -11 -16 -29 0
+ 600 -2 -3 -8 -18 -23 -29 0
+ 645 -10 -11 -16 -18 -23 -29 0
+ 136 -1 -4 -8 -12 -16 -34 0
+ 786 -2 -4 -8 -19 -23 -34 0
+ 268 -10 -12 -16 -19 -23 -34 0
+ 141 -3 -4 -8 -25 -29 -34 0
+ 882 -11 -12 -16 -25 -29 -34 0
+ 839 -18 -19 -23 -25 -29 -34 0
+ 984 -1 -5 -8 -13 -16 -38 0
+ 582 -2 -5 -8 -20 -23 -38 0
+ 373 -10 -13 -16 -20 -23 -38 0
+ 232 -3 -5 -8 -26 -29 -38 0
+ 628 -11 -13 -16 -26 -29 -38 0
+ 192 -18 -20 -23 -26 -29 -38 0
+ 811 -4 -5 -8 -31 -34 -38 0
+ 980 -12 -13 -16 -31 -34 -38 0
+ 480 -19 -20 -23 -31 -34 -38 0
+ 796 -25 -26 -29 -31 -34 -38 0
+ 247 -1 -6 -8 -14 -16 -41 0
+ 521 -2 -6 -8 -21 -23 -41 0
+ 906 -10 -14 -16 -21 -23 -41 0
+ 53 -3 -6 -8 -27 -29 -41 0
+ 476 -11 -14 -16 -27 -29 -41 0
+ 710 -18 -21 -23 -27 -29 -41 0
+ 863 -4 -6 -8 -32 -34 -41 0
+ 987 -12 -14 -16 -32 -34 -41 0
+ 815 -19 -21 -23 -32 -34 -41 0
+ 910 -25 -27 -29 -32 -34 -41 0
+ 851 -5 -6 -8 -36 -38 -41 0
+ 926 -13 -14 -16 -36 -38 -41 0
+ 383 -20 -21 -23 -36 -38 -41 0
+ 317 -26 -27 -29 -36 -38 -41 0
+ 936 -31 -32 -34 -36 -38 -41 0
+ 989 -1 -7 -8 -15 -16 -43 0
+ 517 -2 -7 -8 -22 -23 -43 0
+ 629 -10 -15 -16 -22 -23 -43 0
+ 468 -3 -7 -8 -28 -29 -43 0
+ 224 -11 -15 -16 -28 -29 -43 0
+ 952 -18 -22 -23 -28 -29 -43 0
+ 196 -4 -7 -8 -33 -34 -43 0
+ 115 -12 -15 -16 -33 -34 -43 0
+ 545 -19 -22 -23 -33 -34 -43 0
+ 373 -25 -28 -29 -33 -34 -43 0
+ 769 -5 -7 -8 -37 -38 -43 0
+ 850 -13 -15 -16 -37 -38 -43 0
+ 583 -20 -22 -23 -37 -38 -43 0
+ 981 -26 -28 -29 -37 -38 -43 0
+ 982 -31 -33 -34 -37 -38 -43 0
+ 502 -6 -7 -8 -40 -41 -43 0
+ 567 -14 -15 -16 -40 -41 -43 0
+ 690 -21 -22 -23 -40 -41 -43 0
+ 675 -27 -28 -29 -40 -41 -43 0
+ 504 -32 -33 -34 -40 -41 -43 0
+ 382 -36 -37 -38 -40 -41 -43 0
+ 586 -1 -2 -9 -10 -17 -24 0
+ 200 -1 -3 -9 -11 -17 -30 0
+ 466 -2 -3 -9 -18 -24 -30 0
+ 903 -10 -11 -17 -18 -24 -30 0
+ 262 -1 -4 -9 -12 -17 -35 0
+ 832 -2 -4 -9 -19 -24 -35 0
+ 181 -10 -12 -17 -19 -24 -35 0
+ 755 -3 -4 -9 -25 -30 -35 0
+ 666 -11 -12 -17 -25 -30 -35 0
+ 397 -18 -19 -24 -25 -30 -35 0
+ 720 -1 -5 -9 -13 -17 -39 0
+ 602 -2 -5 -9 -20 -24 -39 0
+ 78 -10 -13 -17 -20 -24 -39 0
+ 261 -3 -5 -9 -26 -30 -39 0
+ 201 -11 -13 -17 -26 -30 -39 0
+ 109 -18 -20 -24 -26 -30 -39 0
+ 849 -4 -5 -9 -31 -35 -39 0
+ 789 -12 -13 -17 -31 -35 -39 0
+ 899 -19 -20 -24 -31 -35 -39 0
+ 682 -25 -26 -30 -31 -35 -39 0
+ 519 -1 -6 -9 -14 -17 -42 0
+ 408 -2 -6 -9 -21 -24 -42 0
+ 284 -10 -14 -17 -21 -24 -42 0
+ 137 -3 -6 -9 -27 -30 -42 0
+ 946 -11 -14 -17 -27 -30 -42 0
+ 397 -18 -21 -24 -27 -30 -42 0
+ 641 -4 -6 -9 -32 -35 -42 0
+ 392 -12 -14 -17 -32 -35 -42 0
+ 65 -19 -21 -24 -32 -35 -42 0
+ 531 -25 -27 -30 -32 -35 -42 0
+ 877 -5 -6 -9 -36 -39 -42 0
+ 337 -13 -14 -17 -36 -39 -42 0
+ 907 -20 -21 -24 -36 -39 -42 0
+ 693 -26 -27 -30 -36 -39 -42 0
+ 158 -31 -32 -35 -36 -39 -42 0
+ 982 -1 -7 -9 -15 -17 -44 0
+ 499 -2 -7 -9 -22 -24 -44 0
+ 597 -10 -15 -17 -22 -24 -44 0
+ 981 -3 -7 -9 -28 -30 -44 0
+ 25 -11 -15 -17 -28 -30 -44 0
+ 272 -18 -22 -24 -28 -30 -44 0
+ 734 -4 -7 -9 -33 -35 -44 0
+ 323 -12 -15 -17 -33 -35 -44 0
+ 962 -19 -22 -24 -33 -35 -44 0
+ 605 -25 -28 -30 -33 -35 -44 0
+ 667 -5 -7 -9 -37 -39 -44 0
+ 482 -13 -15 -17 -37 -39 -44 0
+ 852 -20 -22 -24 -37 -39 -44 0
+ 123 -26 -28 -30 -37 -39 -44 0
+ 807 -31 -33 -35 -37 -39 -44 0
+ 241 -6 -7 -9 -40 -42 -44 0
+ 876 -14 -15 -17 -40 -42 -44 0
+ 378 -21 -22 -24 -40 -42 -44 0
+ 789 -27 -28 -30 -40 -42 -44 0
+ 976 -32 -33 -35 -40 -42 -44 0
+ 817 -36 -37 -39 -40 -42 -44 0
+ 540 -1 -8 -9 -16 -17 -45 0
+ 570 -2 -8 -9 -23 -24 -45 0
+ 332 -10 -16 -17 -23 -24 -45 0
+ 562 -3 -8 -9 -29 -30 -45 0
+ 721 -11 -16 -17 -29 -30 -45 0
+ 388 -18 -23 -24 -29 -30 -45 0
+ 99 -4 -8 -9 -34 -35 -45 0
+ 788 -12 -16 -17 -34 -35 -45 0
+ 553 -19 -23 -24 -34 -35 -45 0
+ 690 -25 -29 -30 -34 -35 -45 0
+ 906 -5 -8 -9 -38 -39 -45 0
+ 919 -13 -16 -17 -38 -39 -45 0
+ 654 -20 -23 -24 -38 -39 -45 0
+ 160 -26 -29 -30 -38 -39 -45 0
+ 356 -31 -34 -35 -38 -39 -45 0
+ 512 -6 -8 -9 -41 -42 -45 0
+ 594 -14 -16 -17 -41 -42 -45 0
+ 985 -21 -23 -24 -41 -42 -45 0
+ 242 -27 -29 -30 -41 -42 -45 0
+ 171 -32 -34 -35 -41 -42 -45 0
+ 9 -36 -38 -39 -41 -42 -45 0
+ 456 -7 -8 -9 -43 -44 -45 0
+ 446 -15 -16 -17 -43 -44 -45 0
+ 133 -22 -23 -24 -43 -44 -45 0
+ 451 -28 -29 -30 -43 -44 -45 0
+ 64 -33 -34 -35 -43 -44 -45 0
+ 168 -37 -38 -39 -43 -44 -45 0
+ 637 -40 -41 -42 -43 -44 -45 0
diff --git a/samples/maxsat/t3pm3-5555.spn.cnf b/samples/maxsat/t3pm3-5555.spn.cnf
new file mode 100644
--- /dev/null
+++ b/samples/maxsat/t3pm3-5555.spn.cnf
@@ -0,0 +1,163 @@
+p cnf 27 162
+-1 2 0
+-2 0
+-2 3 0
+2 -3 0
+-3 1 0
+3 -1 0
+4 5 0
+-4 -5 0
+5 6 0
+-5 -6 0
+-6 4 0
+6 -4 0
+7 8 0
+-7 -8 0
+8 9 0
+-8 -9 0
+9 7 0
+-9 -7 0
+-1 4 0
+-4 0
+-2 5 0
+2 -5 0
+3 6 0
+-3 -6 0
+-4 7 0
+4 -7 0
+-5 8 0
+5 -8 0
+6 9 0
+-6 -9 0
+-7 1 0
+7 -1 0
+-8 2 0
+8 -2 0
+-9 3 0
+9 -3 0
+10 0
+-1 -10 0
+-2 11 0
+2 -11 0
+-3 12 0
+3 -12 0
+4 13 0
+-4 -13 0
+5 14 0
+-5 -14 0
+-6 15 0
+6 -15 0
+7 16 0
+-7 -16 0
+8 17 0
+-8 -17 0
+9 18 0
+-9 -18 0
+-10 11 0
+10 -11 0
+11 12 0
+-11 -12 0
+12 10 0
+-12 -10 0
+-13 14 0
+13 -14 0
+14 15 0
+-14 -15 0
+15 13 0
+-15 -13 0
+16 17 0
+-16 -17 0
+17 18 0
+-17 -18 0
+-18 16 0
+18 -16 0
+-10 13 0
+10 -13 0
+11 14 0
+-11 -14 0
+-12 15 0
+12 -15 0
+13 16 0
+-13 -16 0
+-14 17 0
+14 -17 0
+-15 18 0
+15 -18 0
+16 10 0
+-16 -10 0
+-17 11 0
+17 -11 0
+18 12 0
+-18 -12 0
+10 19 0
+-10 -19 0
+11 20 0
+-11 -20 0
+-12 21 0
+12 -21 0
+13 22 0
+-13 -22 0
+14 23 0
+-14 -23 0
+-15 24 0
+15 -24 0
+16 25 0
+-16 -25 0
+-17 26 0
+17 -26 0
+-18 27 0
+18 -27 0
+-19 20 0
+19 -20 0
+-20 21 0
+20 -21 0
+21 19 0
+-21 -19 0
+-22 23 0
+22 -23 0
+23 24 0
+-23 -24 0
+-24 22 0
+24 -22 0
+-25 26 0
+25 -26 0
+-26 27 0
+26 -27 0
+-27 25 0
+27 -25 0
+19 22 0
+-19 -22 0
+-20 23 0
+20 -23 0
+-21 24 0
+21 -24 0
+22 25 0
+-22 -25 0
+23 26 0
+-23 -26 0
+24 27 0
+-24 -27 0
+25 19 0
+-25 -19 0
+26 20 0
+-26 -20 0
+-27 21 0
+27 -21 0
+-19 1 0
+19 -1 0
+20 2 0
+-20 -2 0
+21 3 0
+-21 -3 0
+-22 4 0
+22 -4 0
+-23 5 0
+23 -5 0
+-24 6 0
+24 -6 0
+25 7 0
+-25 -7 0
+26 8 0
+-26 -8 0
+27 9 0
+-27 -9 0
diff --git a/samples/pbs/normalized-1096.cudf.paranoid.opb b/samples/pbs/normalized-1096.cudf.paranoid.opb
new file mode 100644
--- /dev/null
+++ b/samples/pbs/normalized-1096.cudf.paranoid.opb
@@ -0,0 +1,7 @@
+* #variable= 1 #constraint= 1
+****************************************
+* begin normalizer comments
+* category= DEC-SMALLINT-LIN
+* end normalizer comments
+****************************************
++1 x1 >= 1 ;
diff --git a/samples/programs/htc/htc.hs b/samples/programs/htc/htc.hs
--- a/samples/programs/htc/htc.hs
+++ b/samples/programs/htc/htc.hs
@@ -3,17 +3,43 @@
 module Main where
 
 import Control.Monad
+import Data.Char
 import Data.List
 import qualified Data.IntSet as IntSet
+import qualified Data.Set as Set
 import System.Environment
+import System.Exit
+import System.IO
 import qualified ToySolver.Combinatorial.HittingSet.Simple as HittingSet
+import qualified ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999 as GurvichKhachiyan1999
 
 main :: IO ()
 main = do
   args <- getArgs
   case args of
-    [fname] -> do
-      s <- readFile fname
-      let xss = filter (not . IntSet.null) . fmap (IntSet.fromList . fmap read . words) . lines $ s
-      forM_ (HittingSet.minimalHittingSets xss) $ \ys -> do
-        putStrLn $ intercalate " " $ map show $ IntSet.toList ys
+    [] -> do
+      hPutStrLn stderr "USAGE: htc [METHOD] FILENAME"
+      hPutStrLn stderr ""
+      hPutStrLn stderr "Supported METHODs:"
+      hPutStrLn stderr "  simple"
+      hPutStrLn stderr "  gurvichkhachiyan1999"
+    [method, fname] -> f (Just method) fname
+    [fname] -> f Nothing fname
+
+f :: Maybe String -> FilePath -> IO ()
+f method fname = do
+  s <- readFile fname
+  let xss = Set.fromList . filter (not . IntSet.null) . fmap (IntSet.fromList . fmap read . words) . lines $ s
+  yss <-
+    case method of
+      Nothing -> return $ HittingSet.minimalHittingSets xss
+      Just s ->
+        case filter (not . (`elem` ['-', '_'])) (map toLower s) of
+          "simple" -> return $ HittingSet.minimalHittingSets xss
+          "gurvichkhachiyan1999" -> return $ GurvichKhachiyan1999.minimalHittingSets xss
+          "gurvichkhachiyan" -> return $ GurvichKhachiyan1999.minimalHittingSets xss
+          _ -> do
+            hPutStrLn stderr ("unknown method: " ++ s)
+            exitFailure
+  forM_ (Set.toList yss) $ \ys -> do
+    putStrLn $ intercalate " " $ map show $ IntSet.toList ys
diff --git a/src/ToySolver/Arith/MIPSolverHL.hs b/src/ToySolver/Arith/MIPSolverHL.hs
--- a/src/ToySolver/Arith/MIPSolverHL.hs
+++ b/src/ToySolver/Arith/MIPSolverHL.hs
@@ -99,7 +99,7 @@
               Nothing -> OptUnsat
               Just _ -> Unbounded        
     Right (node0, ivs2) -> 
-      case traverse optdir obj ivs2 node0 of
+      case traverseBBTree optdir obj ivs2 node0 of
         Left ErrUnbounded -> error "shoud not happen"
         Left ErrUnsat -> OptUnsat
         Right node -> flip evalState (ndSolver node) $ do
@@ -147,8 +147,8 @@
 isStrictlyBetter :: RealFrac r => OptDir -> r -> r -> Bool
 isStrictlyBetter optdir = if optdir==OptMin then (<) else (>)
 
-traverse :: forall r. RealFrac r => OptDir -> LA.Expr r -> VarSet -> Node r -> Either Err (Node r)
-traverse optdir obj ivs node0 = loop [node0] Nothing
+traverseBBTree :: forall r. RealFrac r => OptDir -> LA.Expr r -> VarSet -> Node r -> Either Err (Node r)
+traverseBBTree optdir obj ivs node0 = loop [node0] Nothing
   where
     loop :: [Node r] -> Maybe (Node r) -> Either Err (Node r)
     loop [] (Just best) = Right best
diff --git a/src/ToySolver/Arith/OmegaTest/Base.hs b/src/ToySolver/Arith/OmegaTest/Base.hs
--- a/src/ToySolver/Arith/OmegaTest/Base.hs
+++ b/src/ToySolver/Arith/OmegaTest/Base.hs
@@ -55,7 +55,6 @@
 import ToySolver.Data.Var
 import ToySolver.Internal.Util (combineMaybe)
 import qualified ToySolver.Arith.FourierMotzkin as FM
-import ToySolver.Arith.FourierMotzkin.Base (Constr (..), toLAAtom)
 
 -- ---------------------------------------------------------------------------
 
@@ -90,13 +89,24 @@
 
 type ExprZ = LA.Expr Integer
 
+-- | Atomic constraint
+data Constr
+  = IsNonneg ExprZ
+  -- ^ e ≥ 0
+  | IsZero ExprZ
+  -- ^ e = 0
+  deriving (Show, Eq, Ord)
+
+instance Variables Constr where
+  vars (IsNonneg t) = vars t
+  vars (IsZero t) = vars t
+
 -- 制約集合の単純化
 -- It returns Nothing when a inconsistency is detected.
 simplify :: [Constr] -> Maybe [Constr]
 simplify = fmap concat . mapM f
   where
     f :: Constr -> Maybe [Constr]
-    f (IsPos e) = f (IsNonneg (e ^-^ LA.constant 1))
     f constr@(IsNonneg e) =
       case LA.asConst e of
         Just x -> guard (x >= 0) >> return []
@@ -129,12 +139,10 @@
     d = abs $ gcd' [c | (c,v) <- LA.terms e, v /= LA.unitVar]
 
 applySubst1Constr :: Var -> ExprZ -> Constr -> Constr
-applySubst1Constr v e (IsPos e2)    = LA.applySubst1 v e e2 `gtZ` LA.constant 0
 applySubst1Constr v e (IsNonneg e2) = LA.applySubst1 v e e2 `geZ` LA.constant 0
 applySubst1Constr v e (IsZero e2)   = LA.applySubst1 v e e2 `eqZ` LA.constant 0
 
 evalConstr :: Model Integer -> Constr -> Bool
-evalConstr m (IsPos t)    = LA.evalExpr m t > 0
 evalConstr m (IsNonneg t) = LA.evalExpr m t >= 0
 evalConstr m (IsZero t)   = LA.evalExpr m t == 0
 
@@ -159,7 +167,6 @@
 collectBoundsZ v = foldr phi (([],[]),[])
   where
     phi :: Constr -> (BoundsZ,[Constr]) -> (BoundsZ,[Constr])
-    phi (IsPos t) x = phi (IsNonneg (t ^-^ LA.constant 1)) x
     phi constr@(IsNonneg t) ((ls,us),xs) =
       case LA.extract v t of
         (c,t') -> 
@@ -212,6 +219,10 @@
 
 isExact :: BoundsZ -> Bool
 isExact (ls,us) = and [a==1 || b==1 | (_,a)<-ls , (_,b)<-us]
+
+toLAAtom :: Constr -> LA.Atom Rational
+toLAAtom (IsNonneg e) = LA.mapCoeff fromInteger e .>=. LA.constant 0
+toLAAtom (IsZero e)   = LA.mapCoeff fromInteger e .==. LA.constant 0
 
 chooseVariable :: VarSet -> [Constr] -> (Var, VarSet, BoundsZ, [Constr])
 chooseVariable vs xs = head $ [e | e@(_,_,bnd,_) <- table, isExact bnd] ++ table
diff --git a/src/ToySolver/Arith/Simplex2.hs b/src/ToySolver/Arith/Simplex2.hs
--- a/src/ToySolver/Arith/Simplex2.hs
+++ b/src/ToySolver/Arith/Simplex2.hs
@@ -53,6 +53,8 @@
 
   -- * Solving
   , check
+  , pushBacktrackPoint
+  , popBacktrackPoint
   , Options (..)
   , defaultOptions
   , OptResult (..)
@@ -136,6 +138,8 @@
   , svLogger :: !(IORef (Maybe (String -> IO ())))
   , svPivotStrategy :: !(IORef PivotStrategy)
   , svNPivot  :: !(IORef Int)
+
+  , svBacktrackPoints :: !(IORef [BacktrackPoint v])
   }
 
 type Solver = GenericSolver Rational
@@ -157,6 +161,7 @@
   logger <- newIORef Nothing
   pivot <- newIORef PivotStrategyBlandRule
   npivot <- newIORef 0
+  bps <- newIORef []
   return $
     GenericSolver
     { svTableau = t
@@ -170,6 +175,7 @@
     , svLogger  = logger
     , svNPivot  = npivot
     , svPivotStrategy = pivot
+    , svBacktrackPoints = bps
     }
 
 cloneSolver :: GenericSolver v -> IO (GenericSolver v)
@@ -185,6 +191,7 @@
   logger <- newIORef =<< readIORef (svLogger solver)
   pivot  <- newIORef =<< readIORef (svPivotStrategy solver)
   npivot <- newIORef =<< readIORef (svNPivot solver)
+  bps    <- newIORef =<< mapM cloneBacktrackPoint =<< readIORef (svBacktrackPoints solver)
   return $
     GenericSolver
     { svTableau = t
@@ -198,6 +205,7 @@
     , svLogger  = logger
     , svNPivot  = npivot
     , svPivotStrategy = pivot
+    , svBacktrackPoints = bps
     }  
 
 class (VectorSpace v, Scalar v ~ Rational, Ord v) => SolverValue v where
@@ -249,6 +257,76 @@
   problem description
 --------------------------------------------------------------------}
 
+data BacktrackPoint v
+  = BacktrackPoint
+  { bpSavedLB :: !(IORef (IntMap (Maybe v)))
+  , bpSavedUB :: !(IORef (IntMap (Maybe v)))
+  }
+
+cloneBacktrackPoint :: BacktrackPoint v -> IO (BacktrackPoint v)
+cloneBacktrackPoint bp = do
+  lbs <- newIORef =<< readIORef (bpSavedLB bp)
+  ubs <- newIORef =<< readIORef (bpSavedUB bp)
+  return $ BacktrackPoint lbs ubs
+
+pushBacktrackPoint :: GenericSolver v -> IO ()
+pushBacktrackPoint solver = do
+  savedLBs <- newIORef IntMap.empty
+  savedUBs <- newIORef IntMap.empty
+  lbs <- readIORef (svLB solver)
+  ubs <- readIORef (svUB solver)
+  modifyIORef (svBacktrackPoints solver) (BacktrackPoint savedLBs savedUBs :)
+
+popBacktrackPoint :: GenericSolver v -> IO ()
+popBacktrackPoint solver = do
+  bps <- readIORef (svBacktrackPoints solver)
+  case bps of
+    [] -> error "popBacktrackPoint: empty backtrack points"
+    bp : bps' -> do
+      lbs <- readIORef (svLB solver)
+      savedLBs <- readIORef (bpSavedLB bp)
+      writeIORef (svLB solver) $ IntMap.mergeWithKey (\_ _curr saved -> saved) id (const IntMap.empty) lbs savedLBs
+
+      ubs <- readIORef (svUB solver)
+      savedUBs <- readIORef (bpSavedUB bp)
+      writeIORef (svUB solver) $ IntMap.mergeWithKey (\_ _curr saved -> saved) id (const IntMap.empty) ubs savedUBs
+
+      writeIORef (svBacktrackPoints solver) bps'
+      writeIORef (svOk solver) True
+
+withBacktrackpoint :: GenericSolver v -> (BacktrackPoint v -> IO ()) -> IO ()
+withBacktrackpoint solver f = do
+  bps <- readIORef (svBacktrackPoints solver)
+  case bps of
+    [] -> return ()
+    bp : _ -> f bp
+
+bpSaveLB :: GenericSolver v -> Var -> IO ()
+bpSaveLB solver v = do
+  withBacktrackpoint solver $ \bp -> do
+    saved <- readIORef (bpSavedLB bp)
+    if v `IntMap.member` saved then
+      return ()
+    else do
+      lb <- readIORef (svLB solver)
+      let old = IntMap.lookup v lb
+      seq old $ writeIORef (bpSavedLB bp) (IntMap.insert v old saved)
+
+bpSaveUB :: GenericSolver v -> Var -> IO ()
+bpSaveUB solver v = do
+  withBacktrackpoint solver $ \bp -> do
+    saved <- readIORef (bpSavedUB bp)
+    if v `IntMap.member` saved then
+      return ()
+    else do
+      ub <- readIORef (svUB solver)
+      let old = IntMap.lookup v ub
+      seq old $ writeIORef (bpSavedUB bp) (IntMap.insert v old saved)
+
+{--------------------------------------------------------------------
+  problem description
+--------------------------------------------------------------------}
+
 newVar :: SolverValue v => GenericSolver v -> IO Var
 newVar solver = do
   v <- readIORef (svVCnt solver)
@@ -318,6 +396,7 @@
     (Just l0', _) | l <= l0' -> return ()
     (_, Just u0') | u0' < l -> markBad solver
     _ -> do
+      bpSaveLB solver x
       modifyIORef (svLB solver) (IntMap.insert x l)
       b <- isNonBasicVariable solver x
       v <- getValue solver x
@@ -332,6 +411,7 @@
     (_, Just u0') | u0' <= u -> return ()
     (Just l0', _) | u < l0' -> markBad solver
     _ -> do
+      bpSaveUB solver x
       modifyIORef (svUB solver) (IntMap.insert x u)
       b <- isNonBasicVariable solver x
       v <- getValue solver x
diff --git a/src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs b/src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs
new file mode 100644
--- /dev/null
+++ b/src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs
@@ -0,0 +1,433 @@
+{-# OPTIONS_GHC -Wall #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996
+-- Copyright   :  (c) Masahiro Sakai 2015
+-- License     :  BSD-style
+--
+-- Maintainer  :  masahiro.sakai@gmail.com
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This modules provides functions to check whether two monotone boolean
+-- functions /f/ and /g/ given in DNFs are mutually dual (/i.e./ f(x1,…,xn) = ¬g(¬x1,…,¬xn)).
+--
+-- References:
+--
+-- * [FredmanKhachiyan1996] Michael L. Fredman and Leonid Khachiyan,
+--   On the Complexicy of Dualization of Monotone Disjunctifve Normal Forms,
+--   Journal of Algorithms, vol. 21, pp. 618-628, 1996.
+--   <http://www.sciencedirect.com/science/article/pii/S0196677496900620>
+--   <http://www.cs.tau.ac.il/~fiat/dmsem03/On%20the%20complexity%20of%20Dualization%20of%20monotone%20Disjunctive%20Normal%20Forms%20-%201996.pdf>
+--
+-----------------------------------------------------------------------------
+module ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996
+  (
+  -- * Main functions
+    areDualDNFs
+  , checkDuality
+  , checkDualityA
+  , checkDualityB
+
+  -- * Redundancy
+  -- $Redundancy
+  , isRedundant
+  , deleteRedundancy
+
+  -- * Utilities for testing
+  , isCounterExampleOf
+  , occurFreq
+  ) where
+
+import Prelude hiding (all, any)
+import Control.Arrow ((***))
+import Control.Exception (assert)
+import Control.Monad
+import Data.Foldable (all, any)
+import Data.Function
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
+import Data.List hiding (all, any, intersect)
+import Data.Maybe
+import Data.Ratio
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+-- | xhi n ** xhi n == n
+xhi :: Double -> Double
+xhi n = iterate f m !! 30
+  where
+    m = logn / logBase 2 logn
+      where
+        logn = logBase 2 n
+    f x = m * ((logx + logBase 2 logx) / logx)
+      where
+        logx = logBase 2 x
+
+disjoint :: IntSet -> IntSet -> Bool
+disjoint xs ys = IntSet.null $ xs `IntSet.intersection` ys
+
+intersect :: IntSet -> IntSet -> Bool
+intersect xs ys = not $ disjoint xs ys
+
+isHittingSetOf :: IntSet -> Set IntSet -> Bool
+isHittingSetOf xs yss = all (xs `intersect`) yss
+
+isCounterExampleOf :: IntSet -> (Set IntSet, Set IntSet) -> Bool
+isCounterExampleOf xs (f,g) = lhs == rhs
+  where
+    lhs = or [is `IntSet.isSubsetOf` xs | is <- Set.toList f]
+    rhs = or [xs `disjoint` js | js <- Set.toList g]
+
+volume :: Set IntSet -> Set IntSet -> Int
+volume f g = Set.size f * Set.size g
+
+condition_1_1 :: Set IntSet -> Set IntSet -> Bool
+condition_1_1 f g = all (\is -> all (\js -> is `intersect` js) g) f
+
+condition_1_1_solve :: Set IntSet -> Set IntSet -> Maybe IntSet
+condition_1_1_solve f g = listToMaybe $ do
+  is <- Set.toList f
+  js <- Set.toList g
+  guard $ is `disjoint` js
+  return is
+
+condition_1_2 :: Set IntSet -> Set IntSet -> Bool
+condition_1_2 f g = h f == h g
+  where
+    h = IntSet.unions . Set.toList
+
+-- | Find @xs@ such that @xs `isCounterExampleOf` (f,g)@ unless @'condition_1_2' f g@.
+condition_1_2_solve :: Set IntSet -> Set IntSet -> Maybe IntSet
+condition_1_2_solve f g
+  | Just (v1,_) <- IntSet.minView d1 = Just $ head [IntSet.delete v1 is | is <- Set.toList f, v1 `IntSet.member` is]
+  | Just (v2,_) <- IntSet.minView d2 = Just $ head [(vs `IntSet.difference` (IntSet.delete v2 js)) | js <- Set.toList g, v2 `IntSet.member` js]
+  | otherwise = Nothing
+  where
+    f_vs = IntSet.unions $ Set.toList f
+    g_vs = IntSet.unions $ Set.toList g
+    vs = f_vs `IntSet.union` g_vs
+    d1 = f_vs `IntSet.difference` g_vs
+    d2 = g_vs `IntSet.difference` f_vs
+
+condition_1_3 :: Set IntSet -> Set IntSet -> Bool
+condition_1_3 f g = maxSize f <= Set.size g && maxSize g <= Set.size f
+  where
+    maxSize xs = foldl' max 0 [IntSet.size i | i <- Set.toList xs]
+
+condition_1_3_solve :: Set IntSet -> Set IntSet -> Maybe IntSet
+condition_1_3_solve f g = listToMaybe $
+  [head [is' | i <- IntSet.toList is, let is' = IntSet.delete i is, is' `isHittingSetOf` g] | is <- Set.toList f, IntSet.size is > g_size] ++
+  [xs `IntSet.difference` head [js' | j <- IntSet.toList js, let js' = IntSet.delete j js, js' `isHittingSetOf` f] | js <- Set.toList g, IntSet.size js > f_size]
+  where
+    xs = IntSet.unions $ Set.toList $ Set.union f g
+    f_size = Set.size f
+    g_size = Set.size g
+
+e :: Set IntSet -> Set IntSet -> Rational
+e f g = sum [1 % (2 ^ IntSet.size i) | i <- Set.toList f] +
+        sum [1 % (2 ^ IntSet.size j) | j <- Set.toList g]
+
+condition_2_1 :: Set IntSet -> Set IntSet -> Bool
+condition_2_1 f g = e f g >= 1
+
+condition_2_1_solve :: Set IntSet -> Set IntSet -> Maybe IntSet
+condition_2_1_solve f g =
+  if condition_2_1 f g
+  then Nothing
+  else Just $ loop (IntSet.toList vs) f g IntSet.empty
+  where
+    vs = IntSet.unions $ Set.toList $ Set.union f g
+
+    loop :: [Int] -> Set IntSet -> Set IntSet -> IntSet -> IntSet
+    loop [] _ _ ret = ret
+    loop (v:vs) f g ret =
+      if e f1 g1 <= e f2 g2
+      then loop vs f1 g1 (IntSet.insert v ret)
+      else loop vs f2 g2 ret
+      where
+        -- f = x f1 ∨ f2
+        -- g = x g2 ∨ g1
+        f1 = Set.map (IntSet.delete v) f
+        g1 = Set.filter (v `IntSet.notMember`) g
+        f2 = Set.filter (v `IntSet.notMember`) f
+        g2 = Set.map (IntSet.delete v) g
+
+-- | @'isRedundant' F@ tests whether /F/ contains redundant implicants.
+isRedundant :: Set IntSet -> Bool
+isRedundant = loop . sortBy (compare `on` IntSet.size) . Set.toList
+  where
+    loop :: [IntSet] -> Bool
+    loop [] = False
+    loop (xs:yss) = or [xs `IntSet.isSubsetOf` ys | ys <- yss] || loop yss
+
+isIrredundant :: Set IntSet -> Bool
+isIrredundant = not . isRedundant
+
+-- | Removes redundant implicants from a given DNF.
+deleteRedundancy :: Set IntSet -> Set IntSet
+deleteRedundancy = foldl' f Set.empty . sortBy (compare `on` IntSet.size) . Set.toList
+  where
+    f :: Set IntSet -> IntSet -> Set IntSet
+    f xss ys =
+      if any (`IntSet.isSubsetOf` ys) xss
+      then xss
+      else Set.insert ys xss
+
+-- | @occurFreq  x F@ computes /|{I∈F | x∈I}| \/ |F|/
+occurFreq
+  :: Fractional a
+  => Int -- ^ a variable /x/
+  -> Set IntSet -- ^ a DNF /F/
+  -> a
+occurFreq x f = fromIntegral (sum [1 | is <- Set.toList f, x `IntSet.member` is] :: Int) / fromIntegral (Set.size f)
+
+-- | @areDualDNFs f g@ checks whether two monotone boolean functions /f/
+-- and /g/ are mutually dual (/i.e./ f(x1,…,xn) = ¬g(¬x1,…,xn)).
+--
+-- Note that this function does not care about redundancy of DNFs.
+--
+-- Complexity: /O(n^o(log n))/ where @n = 'IntSet.size' f + 'IntSet.size' g@.
+areDualDNFs
+  :: Set IntSet -- ^ a monotone boolean function /f/ given in DNF
+  -> Set IntSet -- ^ a monotone boolean function /g/ given in DNF
+  -> Bool
+areDualDNFs f g = isNothing $ checkDualityB f g
+
+-- | Synonym for 'checkDualityB'.
+checkDuality :: Set IntSet -> Set IntSet -> Maybe IntSet
+checkDuality = checkDualityB
+
+-- | @checkDualityA f g@ checks whether two monotone boolean functions /f/
+-- and /g/ are mutually dual (/i.e./ f(x1,…,xn) = ¬g(¬x1,…,¬xn)) using
+-- “Algorithm A” of [FredmanKhachiyan1996].
+--
+-- If they are indeed mutually dual it returns @Nothing@, otherwise
+-- it returns @Just cs@ such that {xi ↦ (if xi∈cs then True else False) | i∈{1…n}}
+-- is a solution of f(x1,…,xn) = g(¬x1,…,¬xn)).
+--
+-- Note that this function does not care about redundancy of DNFs.
+--
+-- Complexity: /O(n^O(log^2 n))/ where @n = 'IntSet.size' f + 'IntSet.size' g@.
+checkDualityA
+  :: Set IntSet -- ^ a monotone boolean function /f/ given in DNF
+  -> Set IntSet -- ^ a monotone boolean function /g/ given in DNF
+  -> Maybe IntSet
+checkDualityA f g
+  | Just xs <- condition_1_1_solve f g = Just xs
+  | otherwise = checkDualityA' (deleteRedundancy f) (deleteRedundancy g)
+
+checkDualityA' :: Set IntSet -> Set IntSet -> Maybe IntSet
+checkDualityA' f g
+  | assert (isIrredundant f && isIrredundant g) False = undefined
+  | Just s <- condition_1_2_solve f g = Just s
+  | Just s <- condition_1_3_solve f g = Just s
+  | Just s <- condition_2_1_solve f g = Just s
+  | v <= 1 = solveSmall f g
+  | otherwise = msum
+      [ -- If x=0 then f(xs)=g(¬xs) ⇔ f1(xs) = g0(¬xs) ∨ g1(¬xs)
+        checkDualityA' f1 (deleteRedundancy (g0 `Set.union` g1))
+      , -- If x=1 then f(xs)=g(¬xs) ⇔ f0(xs) ∨ f1(xs) = g1(¬xs)
+        liftM (IntSet.insert x) $ checkDualityA' (deleteRedundancy (f0 `Set.union` f1)) g1
+      ]
+  where
+    size_f = Set.size f
+    size_g = Set.size g
+    n = size_f + size_g
+    v = size_f * size_g
+    xs = IntSet.unions $ Set.toList $ f `Set.union` g
+    epsilon :: Double
+    epsilon = 1 / logBase 2 (fromIntegral n)
+    x = head [x | x <- IntSet.toList xs, occurFreq x f >= epsilon || occurFreq x g >= epsilon]
+    -- f = x f0 ∨ f1
+    (f0, f1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) f
+    -- g = x g0 ∨ g1
+    (g0, g1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) g
+
+solveSmall :: Set IntSet -> Set IntSet -> Maybe IntSet
+solveSmall f g
+  | assert (isIrredundant f && isIrredundant g) False = undefined
+  | Set.null f && Set.null g = Just IntSet.empty
+  | Set.null f = assert (not (Set.null g)) $
+      if IntSet.empty `Set.member` g
+      then Nothing
+      else Just (IntSet.unions (Set.toList g))
+  | Set.null g = assert (not (Set.null f)) $
+      if IntSet.empty `Set.member` f
+      then Nothing
+      else Just IntSet.empty
+  | size_f == 1 && size_g == 1 =
+      let
+        is = Set.findMin f
+        js = Set.findMin g
+        is_size = IntSet.size is
+        js_size = IntSet.size js
+      in if is_size == 1 then
+           if js_size == 1 then
+             Nothing
+           else
+             Just (js `IntSet.difference` is)
+         else
+           Just (is `IntSet.difference` js)
+  | otherwise = error "should not happen"
+  where
+    size_f = Set.size f
+    size_g = Set.size g
+
+-- | @checkDualityB f g@ checks whether two monotone boolean functions /f/
+-- and /g/ are mutually dual (i.e. f(x1,…,xn) = ¬g(¬x1,…,xn)) using
+-- “Algorithm B” of [FredmanKhachiyan1996].
+--
+-- If they are indeed mutually dual it returns @Nothing@, otherwise
+-- it returns @Just cs@ such that {xi ↦ (if xi∈cs then True else False) | i∈{1…n}}
+-- is a solution of f(x1,…,xn) = g(¬x1,…,xn)).
+-- 
+-- Note that this function does not care about redundancy of DNFs.
+--
+-- Complexity: /O(n^o(log n))/ where @n = 'Set.size' f + 'Set.size' g@.
+checkDualityB
+  :: Set IntSet -- ^ a monotone boolean function /f/ given in DNF
+  -> Set IntSet -- ^ a monotone boolean function /f/ given in DNF
+  -> Maybe IntSet
+checkDualityB f g
+  | Just xs <- condition_1_1_solve f g = Just xs
+  | otherwise = checkDualityB' (deleteRedundancy f) (deleteRedundancy g)
+
+checkDualityB' :: Set IntSet -> Set IntSet -> Maybe IntSet
+checkDualityB' f g
+  | assert (isIrredundant f && isIrredundant g) False = undefined
+  | Just s <- condition_1_2_solve f g = Just s
+  | Just s <- condition_1_3_solve f g = Just s
+  | Just s <- condition_2_1_solve f g = Just s
+  | v <= 1 = solveSmall f g
+--  | min size_f size_g <= 2 = undefined
+  | otherwise =
+      let x = head [x | x <- IntSet.toList xs, occurFreq x f > (0::Rational), occurFreq x g > (0::Rational)]
+          -- f = x f0 ∨ f1
+          (f0, f1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) f
+          -- g = x g0 ∨ g1
+          (g0, g1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) g
+          epsilon_x_f :: Double
+          epsilon_x_f = occurFreq x f
+          epsilon_x_g :: Double
+          epsilon_x_g = occurFreq x g
+      in if epsilon_x_f <= epsilon_v then
+           msum
+           [ {- f(xs ∪ {x↦0})=g(¬xs ∪ {x↦1}) ⇔ f1(xs) = g0(¬xs) ∨ g1(¬xs). -}
+             checkDualityB' f1 (deleteRedundancy (g0 `Set.union` g1))
+           , {- f(¬xs ∪ {x↦1}) = g(xs ∪ {x↦0})
+                ⇔ f0(¬xs) ∨ f1(¬xs) = g1(xs)
+                ⇔ f0(¬xs) ∨ (¬g0(xs)∧¬g1(xs)) = g1(xs) {- duality of f1 and g0∨g1 -}
+                ⇔ f0(¬xs) = g1(xs) and g0(xs) = 1
+                   {- g0(xs)=0 is impossible, because
+                      it implies f0(¬xs)∨¬g1(xs)=g1(xs) and then
+                      f0(¬xs)=g1(xs)=1 which contradicts condition (1.1) -}
+              -}
+             msum $ do
+               js <- Set.toList g0
+               let f' = Set.filter (js `disjoint`) f0
+                   g' = Set.map (`IntSet.difference` js) g1
+               return $ do
+                 ys <- checkDualityB' (deleteRedundancy g') (deleteRedundancy f')
+                 let ys2 = IntSet.insert x $ xs `IntSet.difference` (js `IntSet.union` ys)
+                 assert (ys2 `isCounterExampleOf` (f,g)) $ return ()
+                 return ys2
+           ]
+         else if epsilon_x_g <= epsilon_v then
+           msum
+           [ {- f(xs ∪ {x↦1}) = g(¬xs ∪ {x↦0})) ⇔ f0(xs) ∨ f1(xs) = g1(¬xs). -}
+             liftM (IntSet.insert x) $ checkDualityB' (deleteRedundancy (f0 `Set.union` f1)) g1
+           , {- f(xs ∪ {x↦0}) = g(¬xs ∪ {x↦1})
+                ⇔ f1(xs) = g0(¬xs) ∨ g1(¬xs)
+                ⇔ f1(xs) = g0(¬xs) ∨ (¬f0(xs)∧¬f1(xs))  {- duality of g1 and f0∨f1 -}
+                ⇔ f1(xs) = g0(¬xs) and f0(xs) = 1
+                   {- f0(xs)=0 is impossible, because
+                      it implies f1(xs)=g0(¬xs)∨¬f1(xs) and then
+                      f1(xs)=g0(¬xs)=1 which contradicts condition (1.1) -}
+              -}
+             msum $ do
+               is <- Set.toList f0
+               let f' = Set.map (`IntSet.difference` is) f1
+                   g' = Set.filter (is `disjoint`) g0
+               return $ do
+                 ys <- checkDualityB' (deleteRedundancy f') (deleteRedundancy g')
+                 let ys2 = is `IntSet.union` ys
+                 assert (ys2 `isCounterExampleOf` (f,g)) $ return ()
+                 return ys2
+           ]
+         else -- epsilon_v < min epsilon_x_f epsilon_x_g
+           msum
+           [ -- If x=0 then f(xs)=g(¬xs) ⇔ f1(xs) = g0(¬xs) ∨ g1(¬xs)
+             checkDualityB' f1 (deleteRedundancy (g0 `Set.union` g1))
+           , -- If x=1 then f(xs)=g(¬xs) ⇔ f0(xs) ∨ f1(xs) = g1(¬xs)
+             liftM (IntSet.insert x) $ checkDualityB' (deleteRedundancy (f0 `Set.union` f1)) g1
+           ]
+  where
+    size_f = Set.size f
+    size_g = Set.size g
+    v = size_f * size_g
+    epsilon_v = 1 / xhi (fromIntegral v)
+    xs = IntSet.unions $ Set.toList $ f `Set.union` g
+
+-- $Redundancy
+-- An implicant /I∈F/ of a DNF /F/ is redundant if /F/ contains proper subset of /I/.
+-- A DNF /F/ is called redundant if it contains redundant implicants.
+-- The main functions of this modules does not care about redundancy of DNFs.
+
+test_condition_1_1_solve_L = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_1_1_solve f g
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9], [4]]
+    g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
+
+test_condition_1_1_solve_R = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_1_1_solve f g
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]]
+    g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9], [4,7,8]]
+
+test_condition_1_2_solve_L = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_1_2_solve f g
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9,10]]
+    g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
+
+test_condition_1_2_solve_R = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_1_2_solve f g
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]]
+    g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9,10]]
+
+test_condition_1_3_solve_L = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_1_3_solve f g
+    f = Set.fromList $ map IntSet.fromList [[2,4,7,10], [7,8], [9]]
+    g = Set.fromList $ map IntSet.fromList [[7,9,10], [4,8,9], [2,8,9]]
+
+test_condition_1_3_solve_R = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_1_3_solve f g
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9,10]]
+    g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9,10]]
+
+test_condition_2_1_solve_L = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_2_1_solve f g
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [4,7,9], [7,8,9]]
+    g = Set.fromList $ map IntSet.fromList [[2,4,7], [2,8,9], [4,8,9]]
+
+test_condition_2_1_solve_R = xs `isCounterExampleOf` (f,g)
+  where
+    Just xs = condition_2_1_solve f g
+    g = Set.fromList $ map IntSet.fromList [[2,4,7], [4,7,9], [7,8,9]]
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [2,8,9], [4,8,9]]
+
+test_checkDualityA = checkDualityA f g == Nothing
+  where
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]]
+    g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
+
+test_checkDualityB = checkDualityB f g == Nothing
+  where
+    f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]]
+    g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
diff --git a/src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs b/src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs
new file mode 100644
--- /dev/null
+++ b/src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs
@@ -0,0 +1,145 @@
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -Wall #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999
+-- Copyright   :  (c) Masahiro Sakai 2015
+-- License     :  BSD-style
+--
+-- Maintainer  :  masahiro.sakai@gmail.com
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- References:
+--
+-- * [GurvichKhachiyan1999] Vladimir Gurvich and Leonid Khachiyan,
+--   On generating the irredundant conjunctive and disjunctive normal forms of monotone Boolean functions,
+--   Discrete Applied Mathematics, vol. 96-97, pp. 363-373, 1999.
+--   <http://www.sciencedirect.com/science/article/pii/S0166218X99000992>
+--
+-----------------------------------------------------------------------------
+module ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999
+  ( findPrimeImplicateOrPrimeImplicant
+  , generateCNFAndDNF
+  , minimalHittingSets
+  , enumMinimalHittingSets
+  ) where
+
+import Control.Monad
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996 as FredmanKhachiyan1996
+
+-- | Find a new prime implicant or implicate.
+--
+-- Let /f/ be a monotone boolean function over set of variables /S/.
+-- Let ∧_{I∈C} ∨_{i∈I} x_i and ∨_{I∈D} ∧_{i∈I} x_i be the irredundant
+-- CNF representation /f/ and DNF representation of /f/ respectively.
+--
+-- Given a subset /C' ⊆ C/ and /D' ⊆ D/, @'findPrimeImplicateOrPrimeImplicant' S f C' D'@ returns
+-- 
+-- * @Just (Left I)@ where I ∈ C \\ C',
+--
+-- * @Just (Right I)@ where J ∈ D \\ D', or
+--
+-- * @Nothing@ if /C'=C/ and /D'=D/.
+-- 
+findPrimeImplicateOrPrimeImplicant
+  :: IntSet -- ^ Set of variables /V/
+  -> (IntSet -> Bool) -- ^ A monotone boolean function /f/ from /{0,1}^|V| ≅ P(V)/ to @Bool@
+  -> Set IntSet -- ^ Subset /C'/ of prime implicates /C/ of /f/
+  -> Set IntSet -- ^ Subset /D'/ of prime implicants /D/ of /f/
+  -> Maybe (Either IntSet IntSet)
+findPrimeImplicateOrPrimeImplicant vs f cs ds = do
+  ret <- findImplicateOrImplicant vs f cs ds
+  case ret of
+    Left xs -> return $ Left $ minimizeImplicate vs f xs
+    Right xs -> return $ Right $ minimizeImplicant vs f xs
+
+findImplicateOrImplicant
+  :: IntSet -- ^ Set of variables /V/
+  -> (IntSet -> Bool) -- ^ A monotone boolean function /f/ from /{0,1}^|V| ≅ P(V)/ to @Bool@
+  -> Set IntSet -- ^ Subset /C'/ of prime implicates /C/ of /f/
+  -> Set IntSet -- ^ Subset /D'/ of prime implicants /D/ of /f/
+  -> Maybe (Either IntSet IntSet)
+findImplicateOrImplicant vs f cs ds = do
+  xs <- FredmanKhachiyan1996.checkDuality ds cs
+  if f xs then
+    return $ Right xs
+  else
+    return $ Left (vs `IntSet.difference` xs)
+
+-- Minimize I such that ∧_{i∈I} x_i → f(x)
+minimizeImplicant :: IntSet -> (IntSet -> Bool) -> IntSet -> IntSet
+minimizeImplicant _ f is = loop (IntSet.toList is) is
+  where
+    loop [] !ret = ret
+    loop (x:xs) !ret =
+      if f (IntSet.delete x ret)
+      then loop xs (IntSet.delete x ret)
+      else loop xs ret
+
+-- Minimize I such that f(x) → ∨_{i∈I} x_i
+-- i.e. Minimize I such that ∧_{i∈I} ¬x_i → ¬f(x)
+-- i.e. Maximize J such that ∧_{j∈J} x_j → ¬f(x)
+minimizeImplicate :: IntSet -> (IntSet -> Bool) -> IntSet -> IntSet
+minimizeImplicate vs f is = (vs `IntSet.difference`) $ loop (IntSet.toList is) (vs `IntSet.difference` is)
+  where
+    loop [] !ret = ret
+    loop (x:xs) !ret =
+      if not (f (IntSet.insert x ret))
+      then loop xs (IntSet.insert x ret)
+      else loop xs ret
+
+-- | Compute the irredundant CNF representation and DNF representation.
+--
+-- Let /f/ be a monotone boolean function over set of variables /S/.
+-- This function returns /C/ and /D/ where ∧_{I∈C} ∨_{i∈I} x_i and
+-- ∨_{I∈D} ∧_{i∈I} x_i are the irredundant CNF representation /f/ and
+-- DNF representation of /f/ respectively.
+generateCNFAndDNF
+  :: IntSet -- ^ Set of variables /V/
+  -> (IntSet -> Bool) -- ^ A monotone boolean function /f/ from /{0,1}^|V| ≅ P(V)/ to @Bool@
+  -> Set IntSet -- ^ Subset /C'/ of prime implicates /C/ of /f/
+  -> Set IntSet -- ^ Subset /D'/ of prime implicants /D/ of /f/
+  -> (Set IntSet, Set IntSet)
+generateCNFAndDNF vs f cs ds =
+  case findPrimeImplicateOrPrimeImplicant vs f cs ds of
+    Nothing -> (cs, ds)
+    Just (Left xs)  -> generateCNFAndDNF vs f (Set.insert xs cs) ds
+    Just (Right xs) -> generateCNFAndDNF vs f cs (Set.insert xs ds)
+
+minimalHittingSets :: Set IntSet -> Set IntSet
+minimalHittingSets = Set.fromList . enumMinimalHittingSets
+
+enumMinimalHittingSets :: Set IntSet -> [IntSet]
+enumMinimalHittingSets dnf = loop Set.empty
+  where
+    vs = IntSet.unions $ Set.toList dnf
+    f = evalDNF dnf
+
+    loop :: Set IntSet -> [IntSet]
+    loop cs =
+      case findPrimeImplicateOrPrimeImplicant vs f cs dnf of
+        Nothing -> []
+        Just (Left c)  -> c : loop (Set.insert c cs)
+        Just (Right d) -> error "GurvichKhachiyan1999.enumMinimalHittingSets: should not happen"
+
+evalDNF :: Set IntSet -> IntSet -> Bool
+evalDNF dnf xs = or [is `IntSet.isSubsetOf` xs | is <- Set.toList dnf]
+
+evalCNF :: Set IntSet -> IntSet -> Bool
+evalCNF cnf xs = and [not $ IntSet.null $ is `IntSet.intersection` xs | is <- Set.toList cnf]
+ 
+
+f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]]
+g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
+
+testA1 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) Set.empty f 
+testA2 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.singleton (IntSet.fromList [2,8,9])) f
+testA3 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.fromList [IntSet.fromList [2,8,9], IntSet.fromList [4,8,9]]) f
+testA4 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.fromList [IntSet.fromList [2,8,9], IntSet.fromList [4,8,9], IntSet.fromList [7,9]]) f
+
+testB1 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) g Set.empty
diff --git a/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs b/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs
--- a/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs
+++ b/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs
@@ -33,16 +33,14 @@
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import Data.List
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Data.Typeable
 import System.Exit
 import System.IO
 import System.IO.Temp
 import ToySolver.Internal.ProcessUtil (runProcessWithOutputCallback)
 
-type Vertex = Int
-type HyperEdge = IntSet
-type HittingSet = IntSet
-
 data Options
   = Options
   { optHTCBDDCommand  :: FilePath
@@ -76,20 +74,20 @@
 
 instance Exception Failure
 
-minimalHittingSets :: Options -> [HyperEdge] -> IO [HittingSet]
+minimalHittingSets :: Options -> Set IntSet -> IO (Set IntSet)
 minimalHittingSets opt es = do
   withSystemTempFile "htcbdd-input.dat" $ \fname1 h1 -> do
-    forM_ es $ \e -> do
+    forM_ (Set.toList es) $ \e -> do
       hPutStrLn h1 $ intercalate " " [show (encTable IntMap.! v) | v <- IntSet.toList e]
     hClose h1
     withSystemTempFile "htcbdd-out.dat" $ \fname2 h2 -> do
       hClose h2
       execHTCBDD opt fname1 fname2
       s <- readFile fname2
-      return $ map (IntSet.fromList . map ((decTable !) . read) . words) $ lines s
+      return $ Set.fromList $ map (IntSet.fromList . map ((decTable !) . read) . words) $ lines s
   where
     vs :: IntSet
-    vs = IntSet.unions es
+    vs = IntSet.unions (Set.toList es)
 
     nv :: Int
     nv = IntSet.size vs
diff --git a/src/ToySolver/Combinatorial/HittingSet/SHD.hs b/src/ToySolver/Combinatorial/HittingSet/SHD.hs
--- a/src/ToySolver/Combinatorial/HittingSet/SHD.hs
+++ b/src/ToySolver/Combinatorial/HittingSet/SHD.hs
@@ -32,16 +32,14 @@
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import Data.List
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Data.Typeable
 import System.Exit
 import System.IO
 import System.IO.Temp
 import ToySolver.Internal.ProcessUtil (runProcessWithOutputCallback)
 
-type Vertex = Int
-type HyperEdge = IntSet
-type HittingSet = IntSet
-
 data Options
   = Options
   { optSHDCommand     :: FilePath
@@ -67,20 +65,20 @@
 
 instance Exception Failure
 
-minimalHittingSets :: Options -> [HyperEdge] -> IO [HittingSet]
+minimalHittingSets :: Options -> Set IntSet -> IO (Set IntSet)
 minimalHittingSets opt es = do
   withSystemTempFile "shd-input.dat" $ \fname1 h1 -> do
-    forM_ es $ \e -> do
+    forM_ (Set.toList es) $ \e -> do
       hPutStrLn h1 $ intercalate " " [show (encTable IntMap.! v) | v <- IntSet.toList e]
     hClose h1
     withSystemTempFile "shd-out.dat" $ \fname2 h2 -> do
       hClose h2
       execSHD opt fname1 fname2
       s <- readFile fname2
-      return $ map (IntSet.fromList . map ((decTable !) . read) . words) $ lines s
+      return $ Set.fromList $ map (IntSet.fromList . map ((decTable !) . read) . words) $ lines s
   where
     vs :: IntSet
-    vs = IntSet.unions es
+    vs = IntSet.unions (Set.toList es)
 
     nv :: Int
     nv = IntSet.size vs
diff --git a/src/ToySolver/Combinatorial/HittingSet/Simple.hs b/src/ToySolver/Combinatorial/HittingSet/Simple.hs
--- a/src/ToySolver/Combinatorial/HittingSet/Simple.hs
+++ b/src/ToySolver/Combinatorial/HittingSet/Simple.hs
@@ -12,22 +12,26 @@
 -----------------------------------------------------------------------------
 module ToySolver.Combinatorial.HittingSet.Simple
   ( minimalHittingSets
+  , enumMinimalHittingSets
   ) where
 
 import Control.Monad
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IntSet
 import Data.List
+import Data.Set (Set)
 import qualified Data.Set as Set
 
-type Vertex = Int
-type HyperEdge = IntSet
-type HittingSet = IntSet
+minimalHittingSets :: Set IntSet -> Set IntSet
+minimalHittingSets = Set.fromList . minimalHittingSets' . Set.toList
 
-minimalHittingSets :: [HyperEdge] -> [HittingSet]
-minimalHittingSets es = nubOrd $ f es IntSet.empty
+enumMinimalHittingSets :: Set IntSet -> [IntSet]
+enumMinimalHittingSets = nubOrd . minimalHittingSets' . Set.toList
+
+minimalHittingSets' :: [IntSet] -> [IntSet]
+minimalHittingSets' es = f es IntSet.empty
   where
-    f :: [HyperEdge] -> HittingSet -> [HittingSet]
+    f :: [IntSet] -> IntSet -> [IntSet]
     f [] hs = return hs
     f es hs = do
       v <- IntSet.toList $ IntSet.unions es
@@ -37,7 +41,7 @@
       let es' = propagateChoice es v e
       f es' hs'
 
-propagateChoice :: [HyperEdge] -> Vertex -> HyperEdge -> [HyperEdge]
+propagateChoice :: [IntSet] -> Int -> IntSet -> [IntSet]
 propagateChoice es v e = zs
   where
     xs = filter (v `IntSet.notMember`) es
diff --git a/src/ToySolver/Converter/MIP2SMT.hs b/src/ToySolver/Converter/MIP2SMT.hs
--- a/src/ToySolver/Converter/MIP2SMT.hs
+++ b/src/ToySolver/Converter/MIP2SMT.hs
@@ -30,7 +30,6 @@
 import Text.Printf
 
 import qualified ToySolver.Data.MIP as MIP
-import qualified ToySolver.Text.LPFile as LPFile
 import ToySolver.Internal.Util (showRationalAsFiniteDecimal, isInteger)
 
 data Options
@@ -384,7 +383,7 @@
 
 testFile :: FilePath -> IO ()
 testFile fname = do
-  result <- LPFile.parseFile fname
+  result <- MIP.readLPFile fname
   case result of
     Right mip -> putStrLn $ convert def mip ""
     Left err -> hPrint stderr err
@@ -393,7 +392,7 @@
 test = putStrLn $ convert def testdata ""
 
 testdata :: MIP.Problem
-Right testdata = LPFile.parseString "test" $ unlines
+Right testdata = MIP.parseLPString "test" $ unlines
   [ "Maximize"
   , " obj: x1 + 2 x2 + 3 x3 + x4"
   , "Subject To"
diff --git a/src/ToySolver/Converter/MaxSAT2NLPB.hs b/src/ToySolver/Converter/MaxSAT2NLPB.hs
--- a/src/ToySolver/Converter/MaxSAT2NLPB.hs
+++ b/src/ToySolver/Converter/MaxSAT2NLPB.hs
@@ -14,7 +14,7 @@
   ( convert
   ) where
 
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 import qualified ToySolver.Text.MaxSAT as MaxSAT
 
 convert :: MaxSAT.WCNF -> PBFile.Formula
diff --git a/src/ToySolver/Converter/MaxSAT2WBO.hs b/src/ToySolver/Converter/MaxSAT2WBO.hs
--- a/src/ToySolver/Converter/MaxSAT2WBO.hs
+++ b/src/ToySolver/Converter/MaxSAT2WBO.hs
@@ -14,7 +14,7 @@
   ( convert
   ) where
 
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 import qualified ToySolver.Text.MaxSAT as MaxSAT
 
 convert :: MaxSAT.WCNF -> PBFile.SoftFormula
diff --git a/src/ToySolver/Converter/PB2IP.hs b/src/ToySolver/Converter/PB2IP.hs
--- a/src/ToySolver/Converter/PB2IP.hs
+++ b/src/ToySolver/Converter/PB2IP.hs
@@ -21,8 +21,8 @@
 import Data.Map (Map)
 import qualified Data.Map as Map
 
+import qualified Data.PseudoBoolean as PBFile
 import qualified ToySolver.Data.MIP as MIP
-import qualified ToySolver.Text.PBFile as PBFile
 import qualified ToySolver.SAT.Types as SAT
 
 convert :: PBFile.Formula -> (MIP.Problem, Map MIP.Var Rational -> SAT.Model)
diff --git a/src/ToySolver/Converter/PB2LSP.hs b/src/ToySolver/Converter/PB2LSP.hs
--- a/src/ToySolver/Converter/PB2LSP.hs
+++ b/src/ToySolver/Converter/PB2LSP.hs
@@ -16,7 +16,7 @@
   ) where
 
 import Data.List
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 
 convert :: PBFile.Formula -> ShowS
 convert formula =
diff --git a/src/ToySolver/Converter/PB2SMP.hs b/src/ToySolver/Converter/PB2SMP.hs
--- a/src/ToySolver/Converter/PB2SMP.hs
+++ b/src/ToySolver/Converter/PB2SMP.hs
@@ -15,7 +15,7 @@
   ) where
 
 import Data.List
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 
 convert :: Bool -> PBFile.Formula -> ShowS
 convert isUnix formula =
diff --git a/src/ToySolver/Converter/PB2WBO.hs b/src/ToySolver/Converter/PB2WBO.hs
--- a/src/ToySolver/Converter/PB2WBO.hs
+++ b/src/ToySolver/Converter/PB2WBO.hs
@@ -17,7 +17,7 @@
 -----------------------------------------------------------------------------
 module ToySolver.Converter.PB2WBO (convert) where
 
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 
 convert :: PBFile.Formula -> PBFile.SoftFormula
 convert formula
diff --git a/src/ToySolver/Converter/PBSetObj.hs b/src/ToySolver/Converter/PBSetObj.hs
--- a/src/ToySolver/Converter/PBSetObj.hs
+++ b/src/ToySolver/Converter/PBSetObj.hs
@@ -15,7 +15,7 @@
   , setObj
   ) where
 
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 import ToySolver.Converter.ObjType
 
 setObj :: ObjType -> PBFile.Formula -> PBFile.Formula
diff --git a/src/ToySolver/Converter/SAT2PB.hs b/src/ToySolver/Converter/SAT2PB.hs
--- a/src/ToySolver/Converter/SAT2PB.hs
+++ b/src/ToySolver/Converter/SAT2PB.hs
@@ -17,7 +17,7 @@
 import Data.Array.IArray
 import qualified Language.CNF.Parse.ParseDIMACS as DIMACS
 
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 
 convert :: DIMACS.CNF -> PBFile.Formula
 convert cnf
diff --git a/src/ToySolver/Converter/WBO2PB.hs b/src/ToySolver/Converter/WBO2PB.hs
--- a/src/ToySolver/Converter/WBO2PB.hs
+++ b/src/ToySolver/Converter/WBO2PB.hs
@@ -14,7 +14,7 @@
 
 import Data.Array.IArray
 import qualified ToySolver.SAT.Types as SAT
-import qualified ToySolver.Text.PBFile as PBFile
+import qualified Data.PseudoBoolean as PBFile
 
 convert :: PBFile.SoftFormula -> (PBFile.Formula, SAT.Model -> SAT.Model)
 convert wbo = (formula, mtrans)
diff --git a/src/ToySolver/Data/BoolExpr.hs b/src/ToySolver/Data/BoolExpr.hs
--- a/src/ToySolver/Data/BoolExpr.hs
+++ b/src/ToySolver/Data/BoolExpr.hs
@@ -41,6 +41,7 @@
   | Not (BoolExpr a)
   | Imply (BoolExpr a) (BoolExpr a)
   | Equiv (BoolExpr a) (BoolExpr a)
+  | ITE (BoolExpr a) (BoolExpr a) (BoolExpr a)
   deriving (Eq, Ord, Show, Read, Typeable, Data)
 
 instance Functor BoolExpr where
@@ -64,6 +65,7 @@
   traverse f (Not x) = Not <$> traverse f x
   traverse f (Imply x y) = Imply <$> traverse f x <*> traverse f y
   traverse f (Equiv x y) = Equiv <$> traverse f x <*> traverse f y
+  traverse f (ITE c t e) = ITE <$> traverse f c <*> traverse f t <*> traverse f e
 
 instance NFData a => NFData (BoolExpr a) where
   rnf (Atom a) = rnf a
@@ -72,6 +74,7 @@
   rnf (Not x) = rnf x
   rnf (Imply x y) = rnf x `seq` rnf y
   rnf (Equiv x y) = rnf x `seq` rnf y
+  rnf (ITE c t e) = rnf c `seq` rnf t `seq` rnf e
 
 instance Hashable a => Hashable (BoolExpr a) where
   hashWithSalt s (Atom a) = s `hashWithSalt` (0::Int) `hashWithSalt` a
@@ -80,6 +83,7 @@
   hashWithSalt s (Not x)  = s `hashWithSalt` (3::Int) `hashWithSalt` x
   hashWithSalt s (Imply x y) = s `hashWithSalt` (4::Int) `hashWithSalt` x `hashWithSalt` y
   hashWithSalt s (Equiv x y) = s `hashWithSalt` (5::Int) `hashWithSalt` x `hashWithSalt` y
+  hashWithSalt s (ITE c t e) = s `hashWithSalt` (6::Int) `hashWithSalt` c `hashWithSalt` t `hashWithSalt` e
 
 instance Complement (BoolExpr a) where
   notB = Not
@@ -91,6 +95,7 @@
 instance Boolean (BoolExpr a) where
   (.=>.) = Imply
   (.<=>.) = Equiv
+  ite = ITE
 
 instance Variables a => Variables (BoolExpr a) where
   vars = foldMap vars
@@ -105,6 +110,7 @@
     g (Not x) = notB (g x)
     g (Imply x y) = g x .=>. g y
     g (Equiv x y) = g x .<=>. g y
+    g (ITE c t e) = ite (g c) (g t) (g e)
 
 {-# RULES
   "fold/fmap"    forall f g e.  fold f (fmap g e) = fold (f.g) e
@@ -142,6 +148,10 @@
     | isTrue x  = Simplify y
     | isFalse y = notB (Simplify x)
     | otherwise = Simplify (x .=>. y)
+  ite (Simplify c) (Simplify t) (Simplify e)
+    | isTrue c  = Simplify t
+    | isFalse c = Simplify e
+    | otherwise = Simplify (ITE c t e)
 
 isTrue :: BoolExpr a -> Bool
 isTrue (And []) = True
diff --git a/src/ToySolver/Data/Boolean.hs b/src/ToySolver/Data/Boolean.hs
--- a/src/ToySolver/Data/Boolean.hs
+++ b/src/ToySolver/Data/Boolean.hs
@@ -55,8 +55,11 @@
 -- | types that can be combined with boolean operations.
 class (MonotoneBoolean a, Complement a) => Boolean a where
   (.=>.), (.<=>.) :: a -> a -> a
+  ite :: a -> a -> a -> a
+
   x .=>. y = notB x .||. y
   x .<=>. y = (x .=>. y) .&&. (y .=>. x)
+  ite c t e = (c .&&. t) .||. (notB c .&&. e)
 
 
 instance (Complement a, Complement b) => Complement (a, b) where
@@ -73,7 +76,7 @@
 instance (Boolean a, Boolean b) => Boolean (a, b) where
   (xs1,ys1) .=>. (xs2,ys2) = (xs1 .=>. xs2, ys1 .=>. ys2)
   (xs1,ys1) .<=>. (xs2,ys2) = (xs1 .<=>. xs2, ys1 .<=>. ys2)
-
+  ite (c1,c2) (t1,t2) (e1,e2) = (ite c1 t1 e1, ite c2 t2 e2)
 
 instance Complement a => Complement (b -> a) where
   notB f = \x -> notB (f x)
@@ -89,6 +92,7 @@
 instance (Boolean a) => Boolean (b -> a) where
   f .=>. g = \x -> f x .=>. g x
   f .<=>. g = \x -> f x .<=>. g x
+  ite c t e = \x -> ite (c x) (t x) (e x)
 
 
 instance Complement Bool where
@@ -102,3 +106,5 @@
 
 instance Boolean Bool where
   (.<=>.) = (==)
+  ite c t e = if c then t else e
+
diff --git a/src/ToySolver/Data/MIP.hs b/src/ToySolver/Data/MIP.hs
--- a/src/ToySolver/Data/MIP.hs
+++ b/src/ToySolver/Data/MIP.hs
@@ -17,9 +17,13 @@
   , readFile
   , readLPFile
   , readMPSFile
+  , parseLPString
+  , parseMPSString
   , writeFile
   , writeLPFile
   , writeMPSFile
+  , toLPString
+  , toMPSString
   ) where
 
 import Prelude hiding (readFile, writeFile)
@@ -29,8 +33,8 @@
 import Text.Parsec
 
 import ToySolver.Data.MIP.Base
-import qualified ToySolver.Text.LPFile as LPFile
-import qualified ToySolver.Text.MPSFile as MPSFile
+import qualified ToySolver.Data.MIP.LPFile as LPFile
+import qualified ToySolver.Data.MIP.MPSFile as MPSFile
 
 -- | Parse .lp or .mps file based on file extension
 readFile :: FilePath -> IO (Either ParseError Problem)
@@ -48,6 +52,14 @@
 readMPSFile :: FilePath -> IO (Either ParseError Problem)
 readMPSFile = MPSFile.parseFile
 
+-- | Parse a string containing LP file data.
+parseLPString :: SourceName -> String -> Either ParseError Problem
+parseLPString = LPFile.parseString
+
+-- | Parse a string containing MPS file data.
+parseMPSString :: SourceName -> String -> Either ParseError Problem
+parseMPSString = MPSFile.parseString
+
 writeFile :: FilePath -> Problem -> IO ()
 writeFile fname prob =
   case map toLower (takeExtension fname) of
@@ -66,3 +78,9 @@
   case MPSFile.render prob of
     Left err -> ioError $ userError err
     Right s -> P.writeFile fname s
+
+toLPString :: Problem -> Either String String
+toLPString = LPFile.render
+
+toMPSString :: Problem -> Either String String
+toMPSString = MPSFile.render
diff --git a/src/ToySolver/Data/MIP/LPFile.hs b/src/ToySolver/Data/MIP/LPFile.hs
new file mode 100644
--- /dev/null
+++ b/src/ToySolver/Data/MIP/LPFile.hs
@@ -0,0 +1,636 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  ToySolver.Data.MIP.LPFile
+-- Copyright   :  (c) Masahiro Sakai 2011-2014
+-- License     :  BSD-style
+-- 
+-- Maintainer  :  masahiro.sakai@gmail.com
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A CPLEX .lp format parser library.
+-- 
+-- References:
+-- 
+-- * <http://publib.boulder.ibm.com/infocenter/cosinfoc/v12r2/index.jsp?topic=/ilog.odms.cplex.help/Content/Optimization/Documentation/CPLEX/_pubskel/CPLEX880.html>
+-- 
+-- * <http://www.gurobi.com/doc/45/refman/node589.html>
+-- 
+-- * <http://lpsolve.sourceforge.net/5.5/CPLEX-format.htm>
+--
+-----------------------------------------------------------------------------
+module ToySolver.Data.MIP.LPFile
+  ( parseString
+  , parseFile
+  , parser
+  , render
+  ) where
+
+import Control.Monad
+import Control.Monad.Writer
+import Data.Char
+import Data.List
+import Data.Maybe
+import Data.Ratio
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.OptDir
+import Text.Parsec hiding (label)
+import Text.Parsec.String
+
+import qualified ToySolver.Data.MIP.Base as MIP
+import ToySolver.Internal.Util (combineMaybe)
+import ToySolver.Internal.TextUtil (readUnsignedInteger)
+
+-- ---------------------------------------------------------------------------
+
+-- | Parse a string containing LP file data.
+-- The source name is only | used in error messages and may be the empty string.
+parseString :: SourceName -> String -> Either ParseError MIP.Problem
+parseString = parse parser
+
+-- | Parse a file containing LP file data.
+parseFile :: FilePath -> IO (Either ParseError MIP.Problem)
+parseFile = parseFromFile parser
+
+-- ---------------------------------------------------------------------------
+
+char' :: Char -> Parser Char
+char' c = (char c <|> char (toUpper c)) <?> show c
+
+string' :: String -> Parser ()
+string' s = mapM_ char' s <?> show s
+
+sep :: Parser ()
+sep = skipMany ((comment >> return ()) <|> (space >> return ()))
+
+comment :: Parser String
+comment = do
+  char '\\'
+  manyTill anyChar (try newline)
+
+tok :: Parser a -> Parser a
+tok p = do
+  x <- p
+  sep
+  return x
+
+ident :: Parser String
+ident = tok $ do
+  x <- letter <|> oneOf syms1 
+  xs <- many (alphaNum <|> oneOf syms2)
+  let s = x:xs 
+  guard $ map toLower s `Set.notMember` reserved
+  return s
+  where
+    syms1 = "!\"#$%&()/,;?@_`'{}|~"
+    syms2 = '.' : syms1
+
+variable :: Parser MIP.Var
+variable = liftM MIP.toVar ident
+
+label :: Parser MIP.Label
+label = do
+  name <- ident
+  tok $ char ':'
+  return name
+
+reserved :: Set String
+reserved = Set.fromList
+  [ "bound", "bounds"
+  , "gen", "general", "generals"
+  , "bin", "binary", "binaries"
+  , "semi", "semi-continuous", "semis"
+  , "sos"
+  , "end"
+  , "subject"
+  ]
+
+-- ---------------------------------------------------------------------------
+
+-- | LP file parser
+parser :: Parser MIP.Problem
+parser = do
+  sep
+  (flag, obj) <- problem
+
+  cs <- liftM concat $ many $ msum $
+    [ liftM (map Left) constraintSection
+    , liftM (map Left) lazyConstraintsSection
+    , liftM (map Right) userCutsSection
+    ]
+
+  bnds <- option Map.empty (try boundsSection)
+  exvs <- many (liftM Left generalSection <|> liftM Right binarySection)
+  let ints = Set.fromList $ concat [x | Left  x <- exvs]
+      bins = Set.fromList $ concat [x | Right x <- exvs]
+  bnds2 <- return $ Map.unionWith MIP.intersectBounds
+            bnds (Map.fromAscList [(v, (MIP.Finite 0, MIP.Finite 1)) | v <- Set.toAscList bins])
+  scs <- liftM Set.fromList $ option [] (try semiSection)
+
+  ss <- option [] (try sosSection)
+  end
+  let vs = Set.unions $ map MIP.vars cs ++
+           [ Map.keysSet bnds2
+           , ints
+           , bins
+           , scs
+           , MIP.vars (snd obj)
+           , MIP.vars ss
+           ]
+      isInt v  = v `Set.member` ints || v `Set.member` bins
+      isSemi v = v `Set.member` scs
+  return $
+    MIP.Problem
+    { MIP.dir               = flag
+    , MIP.objectiveFunction = obj
+    , MIP.constraints       = [c | Left c <- cs]
+    , MIP.userCuts          = [c | Right c <- cs]
+    , MIP.sosConstraints    = ss
+    , MIP.varInfo           =
+        Map.fromAscList
+        [ ( v
+          , MIP.VarInfo
+            { MIP.varBounds = Map.findWithDefault MIP.defaultBounds v bnds2
+            , MIP.varType   =
+                if isInt v then
+                  if isSemi v then MIP.SemiIntegerVariable
+                  else MIP.IntegerVariable
+                else
+                  if isSemi v then MIP.SemiContinuousVariable
+                  else MIP.ContinuousVariable
+            }
+          )
+        | v <- Set.toAscList vs
+        ]
+    }
+
+problem :: Parser (OptDir, MIP.ObjectiveFunction)
+problem = do
+  flag <-  (try minimize >> return OptMin)
+       <|> (try maximize >> return OptMax)
+  name <- optionMaybe (try label)
+  obj <- expr
+  return (flag, (name, obj))
+
+minimize, maximize :: Parser ()
+minimize = tok $ string' "min" >> optional (string' "imize")
+maximize = tok $ string' "max" >> optional (string' "imize")
+
+end :: Parser ()
+end = tok $ string' "end"
+
+-- ---------------------------------------------------------------------------
+
+constraintSection :: Parser [MIP.Constraint]
+constraintSection = subjectTo >> many (try (constraint False))
+
+subjectTo :: Parser ()
+subjectTo = msum
+  [ try $ tok (string' "subject") >> tok (string' "to")
+  , try $ tok (string' "such") >> tok (string' "that")
+  , try $ tok (string' "st")
+  , try $ tok (string' "s") >> optional (tok (char '.')) >> tok (string' "t")
+        >> tok (char '.') >> return ()
+  ]
+
+constraint :: Bool -> Parser MIP.Constraint
+constraint isLazy = do
+  name <- optionMaybe (try label)
+
+  g <- optionMaybe $ try $ do
+    var <- variable
+    tok (char '=')
+    val <- tok ((char '0' >> return 0) <|> (char '1' >> return 1))
+    tok $ string "->"
+    return (var, val)
+
+  -- It seems that CPLEX allows empty lhs, but GLPK rejects it.
+  e <- expr
+  op <- relOp
+  s <- option 1 sign
+  rhs <- number
+  return $ MIP.Constraint
+    { MIP.constrLabel     = name
+    , MIP.constrIndicator = g
+    , MIP.constrBody      = (e, op, s*rhs)
+    , MIP.constrIsLazy    = isLazy
+    }
+
+relOp :: Parser MIP.RelOp
+relOp = tok $ msum
+  [ char '<' >> optional (char '=') >> return MIP.Le
+  , char '>' >> optional (char '=') >> return MIP.Ge
+  , char '=' >> msum [ char '<' >> return MIP.Le
+                     , char '>' >> return MIP.Ge
+                     , return MIP.Eql
+                     ]
+  ]
+
+lazyConstraintsSection :: Parser [MIP.Constraint]
+lazyConstraintsSection = do
+  tok $ string' "lazy"
+  tok $ string' "constraints"
+  many $ try $ constraint True
+
+userCutsSection :: Parser [MIP.Constraint]
+userCutsSection = do
+  tok $ string' "user"
+  tok $ string' "cuts"
+  many $ try $ constraint False
+
+type Bounds2 = (Maybe MIP.BoundExpr, Maybe MIP.BoundExpr)
+
+boundsSection :: Parser (Map MIP.Var MIP.Bounds)
+boundsSection = do
+  tok $ string' "bound" >> optional (char' 's')
+  liftM (Map.map g . Map.fromListWith f) $ many (try bound)
+  where
+    f (lb1,ub1) (lb2,ub2) = (combineMaybe max lb1 lb2, combineMaybe min ub1 ub2)
+    g (lb, ub) = ( fromMaybe MIP.defaultLB lb
+                 , fromMaybe MIP.defaultUB ub
+                 )
+
+bound :: Parser (MIP.Var, Bounds2)
+bound = msum
+  [ try $ do
+      v <- try variable
+      msum
+        [ do
+            op <- relOp
+            b <- boundExpr
+            return
+              ( v
+              , case op of
+                  MIP.Le -> (Nothing, Just b)
+                  MIP.Ge -> (Just b, Nothing)
+                  MIP.Eql -> (Just b, Just b)
+              )
+        , do
+            tok $ string' "free"
+            return (v, (Just MIP.NegInf, Just MIP.PosInf))
+        ]
+  , do
+      b1 <- liftM Just boundExpr
+      op1 <- relOp
+      guard $ op1 == MIP.Le
+      v <- variable
+      b2 <- option Nothing $ do
+        op2 <- relOp
+        guard $ op2 == MIP.Le
+        liftM Just boundExpr
+      return (v, (b1, b2))
+  ]
+
+boundExpr :: Parser MIP.BoundExpr
+boundExpr = msum 
+  [ try (tok (char '+') >> inf >> return MIP.PosInf)
+  , try (tok (char '-') >> inf >> return MIP.NegInf)
+  , do
+      s <- option 1 sign
+      x <- number
+      return $ MIP.Finite (s*x)
+  ]
+
+inf :: Parser ()
+inf = tok (string "inf" >> optional (string "inity"))
+
+-- ---------------------------------------------------------------------------
+
+generalSection :: Parser [MIP.Var]
+generalSection = do
+  tok $ string' "gen" >> optional (string' "eral" >> optional (string' "s"))
+  many (try variable)
+
+binarySection :: Parser [MIP.Var]
+binarySection = do
+  tok $ string' "bin" >> optional (string' "ar" >> (string' "y" <|> string' "ies"))
+  many (try variable)
+
+semiSection :: Parser [MIP.Var]
+semiSection = do
+  tok $ string' "semi" >> optional (string' "-continuous" <|> string' "s")
+  many (try variable)
+
+sosSection :: Parser [MIP.SOSConstraint]
+sosSection = do
+  tok $ string' "sos"
+  many $ try $ do
+    (l,t) <- try (do{ l <- label; t <- typ; return (Just l, t) })
+          <|> (do{ t <- typ; return (Nothing, t) })
+    xs <- many $ try $ do
+      v <- variable
+      tok $ char ':'
+      w <- number
+      return (v,w)
+    return $ MIP.SOSConstraint l t xs
+  where
+    typ = do
+      t <- tok $ (char' 's' >> ((char '1' >> return MIP.S1) <|> (char '2' >> return MIP.S2)))
+      tok (string "::")
+      return t
+
+-- ---------------------------------------------------------------------------
+
+expr :: Parser MIP.Expr
+expr = try expr1 <|> return []
+  where
+    expr1 :: Parser MIP.Expr
+    expr1 = do
+      t <- term True
+      ts <- many (term False)
+      return $ concat (t : ts)
+
+sign :: Num a => Parser a
+sign = tok ((char '+' >> return 1) <|> (char '-' >> return (-1)))
+
+term :: Bool -> Parser MIP.Expr
+term flag = do
+  s <- if flag then optionMaybe sign else liftM Just sign
+  c <- optionMaybe number
+  e <- liftM (\s' -> [MIP.Term 1 [s']]) variable <|> qexpr
+  return $ case combineMaybe (*) s c of
+    Nothing -> e
+    Just d -> [MIP.Term (d*c') vs | MIP.Term c' vs <- e]
+
+qexpr :: Parser MIP.Expr
+qexpr = do
+  tok (char '[')
+  t <- qterm True
+  ts <- many (qterm False)
+  tok (char ']')
+  -- Gurobi allows ommiting "/2"
+  (do mapM_ (tok . char) ("/2" :: String) -- Explicit type signature is necessary because the type of mapM_ in GHC-7.10 is generalized for arbitrary Foldable
+      return [MIP.Term (r / 2) vs | MIP.Term r vs <- t:ts])
+   <|> return (t:ts)
+
+qterm :: Bool -> Parser MIP.Term
+qterm flag = do
+  s <- if flag then optionMaybe sign else liftM Just sign
+  c <- optionMaybe number
+  es <- qfactor `chainl1`  (tok (char '*') >> return (++))
+  return $ case combineMaybe (*) s c of
+    Nothing -> MIP.Term 1 es
+    Just d -> MIP.Term d es
+
+qfactor :: Parser [MIP.Var]
+qfactor = do
+  v <- variable
+  msum [ tok (char '^') >> tok (char '2') >> return [v,v]
+       , return [v]
+       ]
+
+number :: Parser Rational
+number = tok $ do
+  b <- (do{ x <- nat; y <- option 0 frac; return (fromInteger x + y) })
+    <|> frac
+  c <- option 0 e
+  return (b*10^^c)
+  where
+    digits = many1 digit
+
+    nat :: Parser Integer
+    nat = liftM readUnsignedInteger digits
+
+    frac :: Parser Rational
+    frac = do
+      char '.'
+      s <- digits
+      return (readUnsignedInteger s % 10^(length s))
+
+    e :: Parser Integer
+    e = do
+      oneOf "eE"
+      f <- msum [ char '+' >> return id
+                , char '-' >> return negate
+                , return id
+                ]
+      liftM f nat
+
+-- ---------------------------------------------------------------------------
+
+type M a = Writer ShowS a
+
+execM :: M a -> String
+execM m = execWriter m ""
+
+writeString :: String -> M ()
+writeString s = tell $ showString s
+
+writeChar :: Char -> M ()
+writeChar c = tell $ showChar c
+
+-- ---------------------------------------------------------------------------
+
+-- | Render a problem into a string.
+render :: MIP.Problem -> Either String String
+render mip = Right $ execM $ render' $ removeEmptyExpr mip
+
+writeVar :: MIP.Var -> M ()
+writeVar v = writeString $ MIP.fromVar v
+
+render' :: MIP.Problem -> M ()
+render' mip = do
+  writeString $
+    case MIP.dir mip of
+      OptMin -> "MINIMIZE"
+      OptMax -> "MAXIMIZE"
+  writeChar '\n'
+
+  do
+    let (l, obj) = MIP.objectiveFunction mip
+    renderLabel l
+    renderExpr True obj
+    writeChar '\n'
+
+  writeString "SUBJECT TO\n"
+  forM_ (MIP.constraints mip) $ \c -> do
+    unless (MIP.constrIsLazy c) $ do
+      renderConstraint c
+      writeChar '\n'
+
+  let lcs = [c | c <- MIP.constraints mip, MIP.constrIsLazy c]
+  unless (null lcs) $ do
+    writeString "LAZY CONSTRAINTS\n"
+    forM_ lcs $ \c -> do
+      renderConstraint c
+      writeChar '\n'
+
+  let cuts = [c | c <- MIP.userCuts mip]
+  unless (null cuts) $ do
+    writeString "USER CUTS\n"
+    forM_ cuts $ \c -> do
+      renderConstraint c
+      writeChar '\n'
+
+  let ivs = MIP.integerVariables mip `Set.union` MIP.semiIntegerVariables mip
+      (bins,gens) = Set.partition (\v -> MIP.getBounds mip v == (MIP.Finite 0, MIP.Finite 1)) ivs
+      scs = MIP.semiContinuousVariables mip `Set.union` MIP.semiIntegerVariables mip
+
+  writeString "BOUNDS\n"
+  forM_ (Map.toAscList (MIP.varInfo mip)) $ \(v, MIP.VarInfo{ MIP.varBounds = (lb,ub) }) -> do
+    unless (v `Set.member` bins) $ do
+      renderBoundExpr lb
+      writeString " <= "
+      writeVar v
+      writeString " <= "
+      renderBoundExpr ub
+      writeChar '\n'
+
+  unless (Set.null gens) $ do
+    writeString "GENERALS\n"
+    renderVariableList $ Set.toList gens
+
+  unless (Set.null bins) $ do
+    writeString "BINARIES\n"
+    renderVariableList $ Set.toList bins
+
+  unless (Set.null scs) $ do
+    writeString "SEMI-CONTINUOUS\n"
+    renderVariableList $ Set.toList scs
+
+  unless (null (MIP.sosConstraints mip)) $ do
+    writeString "SOS\n"
+    forM_ (MIP.sosConstraints mip) $ \(MIP.SOSConstraint l typ xs) -> do
+      renderLabel l
+      writeString $ show typ
+      writeString " ::"
+      forM_ xs $ \(v, r) -> do
+        writeString "  "
+        writeVar v
+        writeString " : "
+        writeString $ showValue r
+      writeChar '\n'
+
+  writeString "END\n"
+
+-- FIXME: Gurobi は quadratic term が最後に一つある形式でないとダメっぽい
+renderExpr :: Bool -> MIP.Expr -> M ()
+renderExpr isObj e = fill 80 (ts1 ++ ts2)
+  where
+    (ts,qts) = partition isLin e 
+    isLin (MIP.Term _ [])  = True
+    isLin (MIP.Term _ [_]) = True
+    isLin _ = False
+
+    ts1 = map f ts
+    ts2
+      | null qts  = []
+      | otherwise =
+        -- マイナスで始めるとSCIP 2.1.1 は「cannot have '-' in front of quadratic part ('[')」というエラーを出す
+        ["+ ["] ++ map g qts ++ [if isObj then "] / 2" else "]"]
+
+    f :: MIP.Term -> String
+    f (MIP.Term c [])  = showConstTerm c
+    f (MIP.Term c [v]) = showCoeff c ++ MIP.fromVar v
+    f _ = error "should not happen"
+
+    g :: MIP.Term -> String
+    g (MIP.Term c vs) = 
+      (if isObj then showCoeff (2*c) else showCoeff c) ++
+      intercalate " * " (map MIP.fromVar vs)
+
+showValue :: Rational -> String
+showValue c =
+  if denominator c == 1
+    then show (numerator c)
+    else show (fromRational c :: Double)
+
+showCoeff :: Rational -> String
+showCoeff c =
+  if c' == 1
+    then s
+    else s ++ showValue c' ++ " "
+  where
+    c' = abs c
+    s = if c >= 0 then "+ " else "- "
+
+showConstTerm :: Rational -> String
+showConstTerm c = s ++ v
+  where
+    s = if c >= 0 then "+ " else "- "
+    v = showValue (abs c)
+
+renderLabel :: Maybe MIP.Label -> M ()
+renderLabel l =
+  case l of
+    Nothing -> return ()
+    Just s -> writeString s >> writeString ": "
+
+renderOp :: MIP.RelOp -> M ()
+renderOp MIP.Le = writeString "<="
+renderOp MIP.Ge = writeString ">="
+renderOp MIP.Eql = writeString "="
+
+renderConstraint :: MIP.Constraint -> M ()
+renderConstraint c@MIP.Constraint{ MIP.constrBody = (e,op,val) }  = do
+  renderLabel (MIP.constrLabel c)
+  case MIP.constrIndicator c of
+    Nothing -> return ()
+    Just (v,vval) -> do
+      writeVar v
+      writeString " = "
+      writeString $ showValue vval
+      writeString " -> "
+
+  renderExpr False e
+  writeChar ' '
+  renderOp op
+  writeChar ' '
+  writeString $ showValue val
+
+renderBoundExpr :: MIP.BoundExpr -> M ()
+renderBoundExpr (MIP.Finite r) = writeString $ showValue r
+renderBoundExpr MIP.NegInf = writeString "-inf"
+renderBoundExpr MIP.PosInf = writeString "+inf"
+
+renderVariableList :: [MIP.Var] -> M ()
+renderVariableList vs = fill 80 (map MIP.fromVar vs) >> writeChar '\n'
+
+fill :: Int -> [String] -> M ()
+fill width str = go str 0
+  where
+    go [] _ = return ()
+    go (x:xs) 0 = writeString x >> go xs (length x)
+    go (x:xs) w =
+      if w + 1 + length x <= width
+        then writeChar ' ' >> writeString x >> go xs (w + 1 + length x)
+        else writeChar '\n' >> go (x:xs) 0
+
+-- ---------------------------------------------------------------------------
+
+{-
+compileExpr :: Expr -> Maybe (Map Var Rational)
+compileExpr e = do
+  xs <- forM e $ \(Term c vs) ->
+    case vs of
+      [v] -> return (v, c)
+      _ -> mzero
+  return (Map.fromList xs)
+-}
+
+-- ---------------------------------------------------------------------------
+
+removeEmptyExpr :: MIP.Problem -> MIP.Problem
+removeEmptyExpr prob =
+  prob
+  { MIP.objectiveFunction =
+      case MIP.objectiveFunction prob of
+        (label, e) -> (label, convertExpr e)
+  , MIP.constraints = map convertConstr $ MIP.constraints prob
+  , MIP.userCuts    = map convertConstr $ MIP.userCuts prob
+  }
+  where
+    convertExpr [] = [MIP.Term 0 [MIP.toVar "x0"]]
+    convertExpr e = e
+
+    convertConstr constr =
+      constr
+      { MIP.constrBody =
+          case MIP.constrBody constr of
+            (lhs,op,rhs) -> (convertExpr lhs, op, rhs)
+      }
diff --git a/src/ToySolver/Data/MIP/MPSFile.hs b/src/ToySolver/Data/MIP/MPSFile.hs
new file mode 100644
--- /dev/null
+++ b/src/ToySolver/Data/MIP/MPSFile.hs
@@ -0,0 +1,851 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  ToySolver.Data.MIP.MPSFile
+-- Copyright   :  (c) Masahiro Sakai 2012-2014
+-- License     :  BSD-style
+-- 
+-- Maintainer  :  masahiro.sakai@gmail.com
+-- Stability   :  provisional
+-- Portability :  non-portable (TypeFamilies)
+--
+-- A .mps format parser library.
+-- 
+-- References:
+-- 
+-- * <http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_synopsis.html>
+-- 
+-- * <http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_synopsis.html>
+-- 
+-- * <http://www.gurobi.com/documentation/5.0/reference-manual/node744>
+--
+-- * <http://en.wikipedia.org/wiki/MPS_(format)>
+--
+-----------------------------------------------------------------------------
+module ToySolver.Data.MIP.MPSFile
+  ( parseString
+  , parseFile
+  , parser
+  , render
+  ) where
+
+import Control.Monad
+import Control.Monad.Writer
+import Data.Maybe
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Ratio
+import Data.Interned
+import Data.Interned.String
+
+import qualified Text.Parsec as P
+import Text.Parsec hiding (spaces, newline, Column)
+import Text.Parsec.String
+import Text.Printf
+
+import Data.OptDir
+import qualified ToySolver.Data.MIP.Base as MIP
+import ToySolver.Internal.TextUtil (readUnsignedInteger)
+
+type Column = MIP.Var
+type Row = InternedString
+
+data BoundType
+  = LO  -- lower bound
+  | UP  -- upper bound
+  | FX  -- variable is fixed at the specified value
+  | FR  -- free variable (no lower or upper bound)
+  | MI  -- infinite lower bound
+  | PL  -- infinite upper bound
+  | BV  -- variable is binary (equal 0 or 1)
+  | LI  -- lower bound for integer variable
+  | UI  -- upper bound for integer variable
+  | SC  -- upper bound for semi-continuous variable
+  | SI  -- upper bound for semi-integer variable
+  deriving (Eq, Ord, Show, Read, Enum, Bounded)
+
+-- ---------------------------------------------------------------------------
+
+-- | Parse a string containing MPS file data.
+-- The source name is only | used in error messages and may be the empty string.
+parseString :: SourceName -> String -> Either ParseError MIP.Problem
+parseString = parse parser
+
+-- | Parse a file containing MPS file data.
+parseFile :: FilePath -> IO (Either ParseError MIP.Problem)
+parseFile = parseFromFile parser
+
+-- ---------------------------------------------------------------------------
+
+space' :: Parser Char
+space' = oneOf [' ', '\t']
+
+spaces' :: Parser ()
+spaces' = skipMany space'
+
+spaces1' :: Parser ()
+spaces1' = skipMany1 space'
+
+commentline :: Parser ()
+commentline = do
+  _ <- char '*'
+  _ <- manyTill anyChar P.newline
+  return ()
+
+newline' :: Parser ()
+newline' = do
+  spaces'
+  _ <- P.newline
+  skipMany commentline
+  return ()
+
+tok :: Parser a -> Parser a
+tok p = do
+  x <- p
+  msum [spaces1', lookAhead (try (char '\n' >> return ())), eof]
+  return x
+
+row :: Parser Row
+row = liftM intern ident
+
+column :: Parser Column
+column = liftM MIP.toVar ident
+
+ident :: Parser String
+ident = tok $ many1 $ noneOf [' ', '\t', '\n']
+
+stringLn :: String -> Parser ()
+stringLn s = string s >> newline'
+
+sign :: Num a => Parser a
+sign = (char '+' >> return 1) <|> (char '-' >> return (-1))
+
+number :: Parser Rational
+number = tok $ do
+  b <- (do{ s <- option 1 sign; x <- nat; y <- option 0 frac; return (s * (fromInteger x + y)) })
+    <|> frac
+  c <- option 0 e
+  return (b*10^^c)
+  where
+    digits = many1 digit
+
+    nat :: Parser Integer
+    nat = liftM readUnsignedInteger digits
+
+    frac :: Parser Rational
+    frac = do
+      char '.'
+      s <- digits
+      return (readUnsignedInteger s % 10^(length s))
+
+    e :: Parser Integer
+    e = do
+      oneOf "eE"
+      f <- msum [ char '+' >> return id
+                , char '-' >> return negate
+                , return id
+                ]
+      liftM f nat
+
+-- ---------------------------------------------------------------------------
+
+-- | MPS file parser
+parser :: Parser MIP.Problem
+parser = do
+  many commentline
+
+  _name <- nameSection
+
+  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_objsen.html
+  -- CPLEX extends the MPS standard by allowing two additional sections: OBJSEN and OBJNAME.
+  -- If these options are used, they must appear in order and as the first and second sections after the NAME section. 
+  objsense <- optionMaybe $ objSenseSection
+  objname  <- optionMaybe $ objNameSection
+
+  rows <- rowsSection
+
+  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_usercuts.html
+  -- The order of sections must be ROWS USERCUTS.  
+  usercuts <- option [] userCutsSection
+
+  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_lazycons.html
+  -- The order of sections must be ROWS USERCUTS LAZYCONS.
+  lazycons <- option [] lazyConsSection
+
+  (cols, intvs1) <- colsSection
+  rhss <- rhsSection
+  rngs <- option Map.empty rangesSection
+  bnds <- option [] boundsSection
+
+  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_quadobj.html
+  -- Following the BOUNDS section, a QMATRIX section may be specified.
+  qobj <- msum [quadObjSection, qMatrixSection, return []]
+
+  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_sos.html
+  -- Note that in an MPS file, the SOS section must follow the BOUNDS section.
+  sos <- option [] sosSection
+
+  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_qcmatrix.html
+  -- QCMATRIX sections appear after the optional SOS section. 
+  qterms <- liftM Map.fromList $ many qcMatrixSection
+
+  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_indicators.html
+  -- The INDICATORS section follows any quadratic constraint section and any quadratic objective section.
+  inds <- option Map.empty indicatorsSection
+
+  string "ENDATA"
+
+  let objrow =
+        case objname of
+          Nothing -> head [r | (Nothing, r) <- rows] -- XXX
+          Just r  -> intern r
+      objdir =
+        case objsense of
+          Nothing -> OptMin
+          Just d  -> d
+      vs     = Map.keysSet cols `Set.union` Set.fromList [col | (_,col,_) <- bnds]
+      intvs2 = Set.fromList [col | (t,col,_) <- bnds, t `elem` [BV,LI,UI]]
+      scvs   = Set.fromList [col | (SC,col,_) <- bnds]
+      sivs   = Set.fromList [col | (SI,col,_) <- bnds]
+
+  let explicitBounds = Map.fromListWith f
+        [ case typ of
+            LO -> (col, (Just (MIP.Finite val), Nothing))
+            UP -> (col, (Nothing, Just (MIP.Finite val)))
+            FX -> (col, (Just (MIP.Finite val), Just (MIP.Finite val)))
+            FR -> (col, (Just MIP.NegInf, Just MIP.PosInf))
+            MI -> (col, (Just MIP.NegInf, Nothing))
+            PL -> (col, (Nothing, Just MIP.PosInf))
+            BV -> (col, (Just (MIP.Finite 0), Just (MIP.Finite 1)))
+            LI -> (col, (Just (MIP.Finite val), Nothing))
+            UI -> (col, (Nothing, Just (MIP.Finite val)))
+            SC -> (col, (Nothing, Just (MIP.Finite val)))
+            SI -> (col, (Nothing, Just (MIP.Finite val)))
+        | (typ,col,val) <- bnds ]
+        where
+          f (a1,b1) (a2,b2) = (g a1 a2, g b1 b2)
+          g _ (Just x) = Just x
+          g x Nothing  = x
+
+  let bounds = Map.fromList
+        [ case Map.lookup v explicitBounds of
+            Nothing ->
+              if v `Set.member` intvs1
+              then
+                -- http://eaton.math.rpi.edu/cplex90html/reffileformatscplex/reffileformatscplex9.html
+                -- If no bounds are specified for the variables within markers, bounds of 0 (zero) and 1 (one) are assumed.
+                (v, (MIP.Finite 0, MIP.Finite 1))
+              else
+                (v, (MIP.Finite 0, MIP.PosInf))
+            Just (Nothing, Just (MIP.Finite ub)) | ub < 0 ->
+              {-
+                http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_records.html
+                If no bounds are specified, CPLEX assumes a lower
+                bound of 0 (zero) and an upper bound of +∞. If only a
+                single bound is specified, the unspecified bound
+                remains at 0 or +∞, whichever applies, with one
+                exception. If an upper bound of less than 0 is
+                specified and no other bound is specified, the lower
+                bound is automatically set to -∞. CPLEX deviates
+                slightly from a convention used by some MPS readers
+                when it encounters an upper bound of 0 (zero). Rather
+                than automatically set this variable’s lower bound to
+                -∞, CPLEX accepts both a lower and upper bound of 0,
+                effectively fixing that variable at 0. CPLEX resets
+                the lower bound to -∞ only if the upper bound is less
+                than 0. A warning message is issued when this
+                exception is encountered.
+              -}
+              (v, (MIP.NegInf, MIP.Finite ub))
+            {-
+              lp_solve uses 1 as default lower bound for semi-continuous variable.
+              <http://lpsolve.sourceforge.net/5.5/mps-format.htm>
+              But Gurobi Optimizer uses 0 as default lower bound for semi-continuous variable.
+              Here we adopt Gurobi's way.
+            -}
+{-
+            Just (Nothing, ub) | v `Set.member` scvs ->
+              (v, (MIP.Finite 1, fromMaybe MIP.PosInf ub))
+-}
+            Just (lb,ub) ->
+              (v, (fromMaybe (MIP.Finite 0) lb, fromMaybe MIP.PosInf ub))
+        | v <- Set.toList vs ]
+
+  let rowCoeffs :: Map Row (Map Column Rational)
+      rowCoeffs = Map.fromListWith Map.union [(row, Map.singleton col coeff) | (col,m) <- Map.toList cols, (row,coeff) <- Map.toList m]
+
+  let f :: Bool -> (Maybe MIP.RelOp, Row) -> [MIP.Constraint]
+      f _isLazy (Nothing, _row) = []
+      f isLazy (Just op, row) = do
+        let lhs = [MIP.Term c [col] | (col,c) <- Map.toList (Map.findWithDefault Map.empty row rowCoeffs)]
+                  ++ Map.findWithDefault [] row qterms
+        let rhs = Map.findWithDefault 0 row rhss
+        (op2,rhs2) <-
+          case Map.lookup row rngs of
+            Nothing  -> return (op, rhs)
+            Just rng ->
+              case op of
+                MIP.Ge  -> [(MIP.Ge, rhs), (MIP.Le, rhs + abs rng)]
+                MIP.Le  -> [(MIP.Ge, rhs - abs rng), (MIP.Le, rhs)]
+                MIP.Eql ->
+                  if rng < 0
+                  then [(MIP.Ge, rhs + rng), (MIP.Le, rhs)]
+                  else [(MIP.Ge, rhs), (MIP.Le, rhs + rng)]
+        return $
+          MIP.Constraint
+          { MIP.constrLabel     = Just $ unintern row
+          , MIP.constrIndicator = Map.lookup row inds
+          , MIP.constrIsLazy    = isLazy
+          , MIP.constrBody      = (lhs, op2, rhs2)
+          }
+
+  let mip =
+        MIP.Problem
+        { MIP.dir                     = objdir
+        , MIP.objectiveFunction       =
+            ( Just (unintern objrow)
+            , [MIP.Term c [col] | (col,m) <- Map.toList cols, c <- maybeToList (Map.lookup objrow m)] ++ qobj
+            )
+        , MIP.constraints           = concatMap (f False) rows ++ concatMap (f True) lazycons
+        , MIP.sosConstraints        = sos
+        , MIP.userCuts              = concatMap (f False) usercuts
+        , MIP.varInfo               =
+            Map.fromAscList
+            [ ( v
+              , MIP.VarInfo
+                { MIP.varBounds = Map.findWithDefault MIP.defaultBounds v bounds
+                , MIP.varType   =
+                    if v `Set.member` sivs then
+                      MIP.SemiIntegerVariable
+                    else if v `Set.member` intvs1 && v `Set.member` scvs then
+                      MIP.SemiIntegerVariable
+                    else if v `Set.member` intvs1 || v `Set.member` intvs2 then
+                      MIP.IntegerVariable
+                    else if v `Set.member` scvs then
+                      MIP.SemiContinuousVariable
+                    else
+                      MIP.ContinuousVariable
+                }
+              )
+            | v <- Set.toAscList vs
+            ]
+        }
+
+  return mip
+
+nameSection :: Parser (Maybe String)
+nameSection = do
+  string "NAME"
+  n <- optionMaybe $ try $ do
+    spaces1'
+    ident
+  newline'
+  return n
+
+objSenseSection :: Parser OptDir
+objSenseSection = do
+  try $ stringLn "OBJSENSE"
+  spaces1'
+  d <-  (try (stringLn "MAX") >> return OptMax)
+    <|> (stringLn "MIN" >> return OptMin)
+  return d
+
+objNameSection :: Parser String
+objNameSection = do
+  try $ stringLn "OBJNAME"
+  spaces1'
+  name <- ident
+  newline'
+  return name
+
+rowsSection :: Parser [(Maybe MIP.RelOp, Row)]
+rowsSection = do
+  try $ stringLn "ROWS"
+  rowsBody
+
+userCutsSection :: Parser [(Maybe MIP.RelOp, Row)]
+userCutsSection = do
+  try $ stringLn "USERCUTS"
+  rowsBody
+
+lazyConsSection :: Parser [(Maybe MIP.RelOp, Row)]
+lazyConsSection = do
+  try $ stringLn "LAZYCONS"
+  rowsBody
+
+rowsBody :: Parser [(Maybe MIP.RelOp, Row)]
+rowsBody = many $ do
+  spaces1'
+  op <- msum
+        [ char 'N' >> return Nothing
+        , char 'G' >> return (Just MIP.Ge)
+        , char 'L' >> return (Just MIP.Le)
+        , char 'E' >> return (Just MIP.Eql)
+        ]
+  spaces1'
+  name <- row
+  newline'
+  return (op, name)
+
+colsSection :: Parser (Map Column (Map Row Rational), Set Column)
+colsSection = do
+  try $ stringLn "COLUMNS"
+  body False Map.empty Set.empty
+  where
+    body :: Bool -> Map Column (Map Row Rational) -> Set Column -> Parser (Map Column (Map Row Rational), Set Column)
+    body isInt rs ivs = msum
+      [ do isInt' <- try intMarker
+           body isInt' rs ivs
+      , do (k,v) <- entry
+           let rs'  = Map.insertWith Map.union k v rs
+               ivs' = if isInt then Set.insert k ivs else ivs
+           seq rs' $ seq ivs' $ body isInt rs' ivs'
+      , return (rs, ivs)
+      ]
+
+    intMarker :: Parser Bool
+    intMarker = do
+      spaces1'
+      _marker <- ident 
+      string "'MARKER'"
+      spaces1'
+      b <-  (try (string "'INTORG'") >> return True)
+        <|> (string "'INTEND'" >> return False)
+      newline'
+      return b
+
+    entry :: Parser (Column, Map Row Rational)
+    entry = do
+      spaces1'
+      col <- column
+      rv1 <- rowAndVal
+      opt <- optionMaybe rowAndVal
+      newline'
+      case opt of
+        Nothing -> return (col, rv1)
+        Just rv2 ->  return (col, Map.union rv1 rv2)
+
+rowAndVal :: Parser (Map Row Rational)
+rowAndVal = do
+  r <- row
+  val <- number
+  return $ Map.singleton r val
+
+rhsSection :: Parser (Map Row Rational)
+rhsSection = do
+  try $ stringLn "RHS"
+  liftM Map.unions $ many entry
+  where
+    entry = do
+      spaces1'
+      _name <- ident
+      rv1 <- rowAndVal
+      opt <- optionMaybe rowAndVal
+      newline'
+      case opt of
+        Nothing  -> return rv1
+        Just rv2 -> return $ Map.union rv1 rv2
+
+rangesSection :: Parser (Map Row Rational)
+rangesSection = do
+  try $ stringLn "RANGES"
+  liftM Map.unions $ many entry
+  where
+    entry = do
+      spaces1'
+      _name <- ident
+      rv1 <- rowAndVal
+      opt <- optionMaybe rowAndVal
+      newline'
+      case opt of
+        Nothing  -> return rv1
+        Just rv2 -> return $ Map.union rv1 rv2
+
+boundsSection :: Parser [(BoundType, Column, Rational)]
+boundsSection = do
+  try $ stringLn "BOUNDS"
+  many entry
+  where
+    entry = do
+      spaces1'
+      typ   <- boundType
+      _name <- ident
+      col   <- column
+      val   <- if typ `elem` [FR, BV, MI, PL]
+               then return 0
+               else number
+      newline'
+      return (typ, col, val)
+
+boundType :: Parser BoundType
+boundType = tok $ do
+  msum [try (string (show k)) >> return k | k <- [minBound..maxBound]]
+
+sosSection :: Parser [MIP.SOSConstraint]
+sosSection = do
+  try $ stringLn "SOS"
+  many entry
+  where
+    entry = do
+      spaces1'
+      typ <-  (try (string "S1") >> return MIP.S1)
+          <|> (string "S2" >> return MIP.S2)
+      spaces1'
+      name <- ident
+      newline'
+      xs <- many (try identAndVal)
+      return $ MIP.SOSConstraint{ MIP.sosLabel = Just name, MIP.sosType = typ, MIP.sosBody = xs }
+
+    identAndVal :: Parser (Column, Rational)
+    identAndVal = do
+      spaces1'
+      col <- column
+      val <- number
+      newline'
+      return (col, val)
+
+quadObjSection :: Parser [MIP.Term]
+quadObjSection = do
+  try $ stringLn "QUADOBJ"
+  many entry
+  where
+    entry = do
+      spaces1'
+      col1 <- column
+      col2 <- column
+      val  <- number
+      newline'
+      return $ MIP.Term (if col1 /= col2 then val else val / 2) [col1, col2]
+
+qMatrixSection :: Parser [MIP.Term]
+qMatrixSection = do
+  try $ stringLn "QMATRIX"
+  many entry
+  where
+    entry = do
+      spaces1'
+      col1 <- column
+      col2 <- column
+      val  <- number
+      newline'
+      return $ MIP.Term (val / 2) [col1, col2]
+
+qcMatrixSection :: Parser (Row, [MIP.Term])
+qcMatrixSection = do
+  try $ string "QCMATRIX"
+  spaces1'
+  r <- row
+  newline'
+  xs <- many entry
+  return (r, xs)
+  where
+    entry = do
+      spaces1'
+      col1 <- column
+      col2 <- column
+      val  <- number
+      newline'
+      return $ MIP.Term val [col1, col2]
+
+indicatorsSection :: Parser (Map Row (Column, Rational))
+indicatorsSection = do
+  try $ stringLn "INDICATORS"
+  liftM Map.fromList $ many entry
+  where
+    entry = do
+      spaces1'
+      string "IF"
+      spaces1'
+      r <- row
+      var <- column
+      val <- number
+      newline'
+      return (r, (var, val))
+
+-- ---------------------------------------------------------------------------
+
+type M a = Writer ShowS a
+
+execM :: M a -> String
+execM m = execWriter m ""
+
+writeString :: String -> M ()
+writeString s = tell $ showString s
+
+writeChar :: Char -> M ()
+writeChar c = tell $ showChar c
+
+-- ---------------------------------------------------------------------------
+
+render :: MIP.Problem -> Either String String
+render mip | not (checkAtMostQuadratic mip) = Left "Expression must be atmost quadratic"
+render mip = Right $ execM $ render' $ nameRows mip
+
+render' :: MIP.Problem -> M ()
+render' mip = do
+  let probName = ""
+
+  -- NAME section
+  -- The name starts in column 15 in fixed formats.
+  writeSectionHeader $ "NAME" ++ replicate 10 ' ' ++ probName
+
+  -- OBJSENSE section
+  -- Note: GLPK-4.48 does not support this section.
+  writeSectionHeader "OBJSENSE"
+  case MIP.dir mip of
+    OptMin -> writeFields ["MIN"]
+    OptMax -> writeFields ["MAX"]
+
+  let (Just objName, obj) = MIP.objectiveFunction mip
+
+{-
+  -- OBJNAME section
+  -- Note: GLPK-4.48 does not support this section.
+  writeSectionHeader "OBJNAME"
+  writeFields [objName]
+-}
+
+  let renderRows cs = do
+        forM_ cs $ \c -> do
+          let (_,op,_) = MIP.constrBody c
+          let s = case op of
+                    MIP.Le  -> "L"
+                    MIP.Ge  -> "G"
+                    MIP.Eql -> "E"
+          writeFields [s, fromJust $ MIP.constrLabel c]
+
+  -- ROWS section
+  writeSectionHeader "ROWS"
+  writeFields ["N", objName]
+  renderRows [c | c <- MIP.constraints mip, not (MIP.constrIsLazy c)]
+
+  -- USERCUTS section
+  unless (null (MIP.userCuts mip)) $ do
+    writeSectionHeader "USERCUTS"
+    renderRows (MIP.userCuts mip)
+
+  -- LAZYCONS section
+  let lcs = [c | c <- MIP.constraints mip, MIP.constrIsLazy c]
+  unless (null lcs) $ do
+    writeSectionHeader "LAZYCONS"
+    renderRows lcs
+
+  -- COLUMNS section
+  writeSectionHeader "COLUMNS"
+  let cols :: Map Column (Map String Rational)
+      cols = Map.fromListWith Map.union
+             [ (v, Map.singleton l d)
+             | (Just l, xs) <-
+                 MIP.objectiveFunction mip :
+                 [(MIP.constrLabel c, lhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let (lhs,_,_) = MIP.constrBody c]
+             , MIP.Term d [v] <- xs
+             ]
+      f col xs =
+        forM_ (Map.toList xs) $ \(row, d) -> do
+          writeFields ["", unintern col, row, showValue d]
+      ivs = MIP.integerVariables mip `Set.union` MIP.semiIntegerVariables mip
+  forM_ (Map.toList (Map.filterWithKey (\col _ -> col `Set.notMember` ivs) cols)) $ \(col, xs) -> f col xs
+  unless (Set.null ivs) $ do
+    writeFields ["", "MARK0000", "'MARKER'", "", "'INTORG'"]
+    forM_ (Map.toList (Map.filterWithKey (\col _ -> col `Set.member` ivs) cols)) $ \(col, xs) -> f col xs
+    writeFields ["", "MARK0001", "'MARKER'", "", "'INTEND'"]
+
+  -- RHS section
+  let rs = [(fromJust $ MIP.constrLabel c, rhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let (_,_,rhs) = MIP.constrBody c, rhs /= 0]
+  writeSectionHeader "RHS"
+  forM_ rs $ \(name, val) -> do
+    writeFields ["", "rhs", name, showValue val]
+
+  -- BOUNDS section
+  writeSectionHeader "BOUNDS"
+  forM_ (Map.toList (MIP.varInfo mip)) $ \(col, vinfo) -> do
+    let (lb,ub) = MIP.varBounds vinfo
+        vt = MIP.varType vinfo
+    case (lb,ub) of
+      (MIP.NegInf, MIP.PosInf) -> do
+        -- free variable (no lower or upper bound)
+        writeFields ["FR", "bound", unintern col]
+                  
+      (MIP.Finite 0, MIP.Finite 1) | vt == MIP.IntegerVariable -> do
+        -- variable is binary (equal 0 or 1)
+        writeFields ["BV", "bound", unintern col] 
+
+      (MIP.Finite a, MIP.Finite b) | a == b -> do
+        -- variable is fixed at the specified value
+        writeFields ["FX", "bound", unintern col, showValue a]
+
+      _ -> do
+        case lb of
+          MIP.PosInf -> error "should not happen"
+          MIP.NegInf -> do
+            -- Minus infinity
+            writeFields ["MI", "bound", unintern col]
+          MIP.Finite 0 | vt == MIP.ContinuousVariable -> return ()
+          MIP.Finite a -> do
+            let t = case vt of
+                      MIP.IntegerVariable -> "LI" -- lower bound for integer variable
+                      _ -> "LO" -- Lower bound
+            writeFields [t, "bound", unintern col, showValue a]
+
+        case ub of
+          MIP.NegInf -> error "should not happen"
+          MIP.PosInf | vt == MIP.ContinuousVariable -> return ()
+          MIP.PosInf -> do
+            when (vt == MIP.SemiContinuousVariable || vt == MIP.SemiIntegerVariable) $
+              error "cannot express +inf upper bound of semi-continuous or semi-integer variable"
+            writeFields ["PL", "bound", unintern col] -- Plus infinity
+          MIP.Finite a -> do
+            let t = case vt of
+                      MIP.SemiContinuousVariable -> "SC" -- Upper bound for semi-continuous variable
+                      MIP.SemiIntegerVariable ->
+                        -- Gurobi uses "SC" while lpsolve uses "SI" for upper bound of semi-integer variable
+                        "SC"
+                      MIP.IntegerVariable -> "UI" -- Upper bound for integer variable
+                      _ -> "UP" -- Upper bound
+            writeFields [t, "bound", unintern col, showValue a]
+
+  -- QMATRIX section
+  -- Gurobiは対称行列になっていないと "qmatrix isn't symmetric" というエラーを発生させる
+  let qm = Map.map (2*) $ quadMatrix obj
+  unless (Map.null qm) $ do
+    writeSectionHeader "QMATRIX"
+    forM_ (Map.toList qm) $ \(((v1,v2), val)) -> do
+      writeFields ["", unintern v1, unintern v2, showValue val]
+
+  -- SOS section
+  unless (null (MIP.sosConstraints mip)) $ do
+    writeSectionHeader "SOS"
+    forM_ (MIP.sosConstraints mip) $ \sos -> do
+      let t = case MIP.sosType sos of
+                MIP.S1 -> "S1"
+                MIP.S2 -> "S2"
+      writeFields $ t : maybeToList (MIP.sosLabel sos)
+      forM_ (MIP.sosBody sos) $ \(var,val) -> do
+        writeFields ["", unintern var, showValue val]
+
+  -- QCMATRIX section
+  let xs = [ (fromJust $ MIP.constrLabel c, qm)
+           | c <- MIP.constraints mip ++ MIP.userCuts mip
+           , let (lhs,_,_) = MIP.constrBody c
+           , let qm = quadMatrix lhs
+           , not (Map.null qm) ]
+  unless (null xs) $ do
+    forM_ xs $ \(row, qm) -> do
+      -- The name starts in column 12 in fixed formats.
+      writeSectionHeader $ "QCMATRIX" ++ replicate 3 ' ' ++ row
+      forM_ (Map.toList qm) $ \((v1,v2), val) -> do
+        writeFields ["", unintern v1, unintern v2, showValue val]
+
+  -- INDICATORS section
+  -- Note: Gurobi-5.6.3 does not support this section.
+  let ics = [c | c <- MIP.constraints mip, isJust $ MIP.constrIndicator c]
+  unless (null ics) $ do
+    writeSectionHeader "INDICATORS"
+    forM_ ics $ \c -> do
+      let Just (var,val) = MIP.constrIndicator c
+      writeFields ["IF", fromJust (MIP.constrLabel c), unintern var, showValue val]
+
+  -- ENDATA section
+  writeSectionHeader "ENDATA"
+
+writeSectionHeader :: String -> M ()
+writeSectionHeader s = writeString s >> writeChar '\n'
+
+-- Fields start in column 2, 5, 15, 25, 40 and 50
+writeFields :: [String] -> M ()
+writeFields xs = f1 xs >> writeChar '\n'
+  where
+    -- columns 1-4
+    f1 [] = return ()
+    f1 [x] = writeString (' ' : x)
+    f1 (x:xs) = do
+      writeString $ printf " %-2s " x
+      f2 xs
+
+    -- columns 5-14
+    f2 [] = return ()
+    f2 [x] = writeString x
+    f2 (x:xs) = do
+      writeString $ printf "%-9s " x
+      f3 xs
+
+    -- columns 15-24
+    f3 [] = return ()
+    f3 [x] = writeString x
+    f3 (x:xs) = do
+      writeString $ printf "%-9s " x
+      f4 xs
+
+    -- columns 25-39
+    f4 [] = return ()
+    f4 [x] = writeString x
+    f4 (x:xs) = do
+      writeString $ printf "%-14s " x
+      f5 xs
+
+    -- columns 40-49
+    f5 [] = return ()
+    f5 [x] = writeString x
+    f5 (x:xs) = do
+      writeString $ printf "%-19s " x
+      f6 xs
+
+    -- columns 50-
+    f6 [] = return ()
+    f6 [x] = writeString x
+    f6 _ = error "MPSFile: >6 fields (this should not happen)"
+
+showValue :: Rational -> String
+showValue c =
+  if denominator c == 1
+    then show (numerator c)
+    else show (fromRational c :: Double)
+ 
+nameRows :: MIP.Problem -> MIP.Problem
+nameRows mip
+  = mip
+  { MIP.objectiveFunction = (Just objName', obj)
+  , MIP.constraints = f (MIP.constraints mip) ["row" ++ show n | n <- [(1::Int)..]]
+  , MIP.userCuts = f (MIP.userCuts mip) ["usercut" ++ show n | n <- [(1::Int)..]]
+  , MIP.sosConstraints = g (MIP.sosConstraints mip) ["sos" ++ show n | n <- [(1::Int)..]]
+  }
+  where
+    (objName, obj) = MIP.objectiveFunction mip
+    used = Set.fromList $ catMaybes $ objName : [MIP.constrLabel c | c <- MIP.constraints mip ++ MIP.userCuts mip] ++ [MIP.sosLabel c | c <- MIP.sosConstraints mip]
+    objName' = fromMaybe (head [name | n <- [(1::Int)..], let name = "obj" ++ show n, name `Set.notMember` used]) objName
+
+    f [] _ = []
+    f (c:cs) (name:names)
+      | isJust (MIP.constrLabel c) = c : f cs (name:names)
+      | name `Set.notMember` used = c{ MIP.constrLabel = Just name } : f cs names
+      | otherwise = f (c:cs) names
+
+    g [] _ = []
+    g (c:cs) (name:names)
+      | isJust (MIP.sosLabel c) = c : g cs (name:names)
+      | name `Set.notMember` used = c{ MIP.sosLabel = Just name } : g cs names
+      | otherwise = g (c:cs) names
+
+quadMatrix :: MIP.Expr -> Map (MIP.Var, MIP.Var) Rational
+quadMatrix e = Map.fromList $ do
+  let m = Map.fromListWith (+) [(if v1<=v2 then (v1,v2) else (v2,v1), c) | MIP.Term c [v1,v2] <- e]
+  ((v1,v2),c) <- Map.toList m
+  if v1==v2 then
+    [((v1,v2), c)]
+  else
+    [((v1,v2), c/2), ((v2,v1), c/2)]
+
+checkAtMostQuadratic :: MIP.Problem -> Bool
+checkAtMostQuadratic mip =  all (all f) es
+  where
+    es = snd (MIP.objectiveFunction mip) :
+         [lhs | c <- MIP.constraints mip ++ MIP.userCuts mip, let (lhs,_,_) = MIP.constrBody c]
+    f :: MIP.Term -> Bool
+    f (MIP.Term _ [_]) = True
+    f (MIP.Term _ [_,_]) = True
+    f _ = False
+
+-- ---------------------------------------------------------------------------
diff --git a/src/ToySolver/Data/Polynomial/Base.hs b/src/ToySolver/Data/Polynomial/Base.hs
--- a/src/ToySolver/Data/Polynomial/Base.hs
+++ b/src/ToySolver/Data/Polynomial/Base.hs
@@ -570,7 +570,8 @@
 data X = X
   deriving (Eq, Ord, Bounded, Enum, Show, Read, Typeable, Data)
 
-instance NFData X
+instance NFData X where
+   rnf a = a `seq` ()
 
 instance Hashable X where
   hashWithSalt = hashUsing fromEnum
diff --git a/src/ToySolver/FOLModelFinder.hs b/src/ToySolver/FOLModelFinder.hs
--- a/src/ToySolver/FOLModelFinder.hs
+++ b/src/ToySolver/FOLModelFinder.hs
@@ -284,7 +284,8 @@
     gensym :: M Var
     gensym = do
       (vs, n, ls) <- get
-      let go m = do
+      let go :: Int -> M Var
+          go m = do
             let v = "#" ++ show m
             if v `Set.member` vs
               then go (m+1)
diff --git a/src/ToySolver/Internal/Data/IOURef.hs b/src/ToySolver/Internal/Data/IOURef.hs
--- a/src/ToySolver/Internal/Data/IOURef.hs
+++ b/src/ToySolver/Internal/Data/IOURef.hs
@@ -24,7 +24,7 @@
 import Data.Array.Base
 import Data.Array.IO
 
-newtype IOURef a = IOURef (IOUArray Int a)
+newtype IOURef a = IOURef (IOUArray Int a) deriving (Eq)
 
 {-# INLINEABLE newIOURef #-}
 newIOURef :: (MArray IOUArray a IO) => a -> IO (IOURef a)
diff --git a/src/ToySolver/Internal/Data/IndexedPriorityQueue.hs b/src/ToySolver/Internal/Data/IndexedPriorityQueue.hs
--- a/src/ToySolver/Internal/Data/IndexedPriorityQueue.hs
+++ b/src/ToySolver/Internal/Data/IndexedPriorityQueue.hs
@@ -156,6 +156,7 @@
 
   dequeueBatch q = go []
     where
+      go :: [Value] -> IO [Value]
       go xs = do
         r <- dequeue q
         case r of
diff --git a/src/ToySolver/Internal/Data/PriorityQueue.hs b/src/ToySolver/Internal/Data/PriorityQueue.hs
--- a/src/ToySolver/Internal/Data/PriorityQueue.hs
+++ b/src/ToySolver/Internal/Data/PriorityQueue.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, BangPatterns, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -Wall #-}
 -----------------------------------------------------------------------------
 -- |
@@ -8,7 +8,7 @@
 -- 
 -- Maintainer  :  masahiro.sakai@gmail.com
 -- Stability   :  provisional
--- Portability :  non-portable (MultiParamTypeClasses, FlexibleInstances, BangPatterns)
+-- Portability :  non-portable (MultiParamTypeClasses, FlexibleInstances, BangPatterns, ScopedTypeVariables)
 --
 -- Priority queue implemented as array-based binary heap.
 --
@@ -103,6 +103,7 @@
 
   dequeueBatch q = go []
     where
+      go :: [a] -> IO [a]
       go xs = do
         r <- dequeue q
         case r of
diff --git a/src/ToySolver/Internal/Data/Vec.hs b/src/ToySolver/Internal/Data/Vec.hs
--- a/src/ToySolver/Internal/Data/Vec.hs
+++ b/src/ToySolver/Internal/Data/Vec.hs
@@ -52,8 +52,9 @@
 import qualified Data.Array.Base as A
 import qualified Data.Array.IO as A
 import Data.IORef
+import ToySolver.Internal.Data.IOURef
 
-newtype GenericVec a e = GenericVec (IORef (Int, a Index e))
+data GenericVec a e = GenericVec {-# UNPACK #-} !(IOURef Int) {-# UNPACK #-} !(IORef (a Index e))
   deriving Eq
 
 type Vec e = GenericVec A.IOArray e
@@ -63,14 +64,14 @@
 
 new :: A.MArray a e IO => IO (GenericVec a e)
 new = do
-  a <- A.newArray_ (0,-1)
-  ref <- newIORef (0,a)
-  return $ GenericVec ref
+  sizeRef <- newIOURef 0
+  arrayRef <- newIORef =<< A.newArray_ (0,-1)
+  return $ GenericVec sizeRef arrayRef
 
 {- INLINE getSize #-}
 -- | Get the internal representation array
 getSize :: A.MArray a e IO => GenericVec a e -> IO Int
-getSize (GenericVec ref) = liftM fst $ readIORef ref
+getSize (GenericVec sizeRef _) = readIOURef sizeRef
 
 {-# SPECIALIZE read :: Vec e -> Int -> IO e #-}
 {-# SPECIALIZE read :: UVec Int -> Int -> IO Int #-}
@@ -115,16 +116,15 @@
 {-# SPECIALIZE resize :: UVec Double -> Int -> IO () #-}
 {-# SPECIALIZE resize :: UVec Bool -> Int -> IO () #-}
 resize :: A.MArray a e IO => GenericVec a e -> Int -> IO ()
-resize v@(GenericVec ref) !n = do
+resize v@(GenericVec sizeRef arrayRef) !n = do
   a <- getArray v
   capa <- getCapacity v
-  if n <= capa then do
-    writeIORef ref (n,a)
-  else do
+  unless (n <= capa) $ do
     let capa' = max 2 (capa * 3 `div` 2)
     a' <- A.newArray_ (0, capa'-1)
     copyTo a a' (0,capa-1)
-    writeIORef ref (n,a')
+    writeIORef arrayRef a'
+  writeIOURef sizeRef n
 
 {-# SPECIALIZE growTo :: Vec e -> Int -> IO () #-}
 {-# SPECIALIZE growTo :: UVec Int -> Int -> IO () #-}
@@ -169,10 +169,11 @@
 {-# SPECIALIZE clone :: UVec Double -> IO (UVec Double) #-}
 {-# SPECIALIZE clone :: UVec Bool -> IO (UVec Bool) #-}
 clone :: A.MArray a e IO => GenericVec a e -> IO (GenericVec a e)
-clone (GenericVec ref) = do
-  (n,a) <- readIORef ref
-  a' <- cloneArray a
-  liftM GenericVec $ newIORef (n,a')
+clone (GenericVec sizeRef arrayRef) = do
+  a <- readIORef arrayRef
+  arrayRef' <- newIORef =<< cloneArray a
+  sizeRef'  <- newIOURef =<< readIOURef sizeRef
+  return $ GenericVec sizeRef' arrayRef'
 
 {--------------------------------------------------------------------
 
@@ -181,7 +182,7 @@
 {-# INLINE getArray #-}
 -- | Get the internal representation array
 getArray :: GenericVec a e -> IO (a Index e)
-getArray (GenericVec ref) = liftM snd $ readIORef ref
+getArray (GenericVec _ arrayRef) = readIORef arrayRef
 
 {-# INLINE getCapacity #-}
 -- | Get the internal representation array
@@ -194,13 +195,14 @@
 {-# SPECIALIZE resizeCapacity :: UVec Bool -> Int -> IO () #-}
 -- | Pre-allocate internal buffer for @n@ elements.
 resizeCapacity :: A.MArray a e IO => GenericVec a e -> Int -> IO ()
-resizeCapacity (GenericVec ref) capa = do
-  (n,arr) <- readIORef ref
+resizeCapacity (GenericVec sizeRef arrayRef) capa = do
+  n <- readIOURef sizeRef
+  arr <- readIORef arrayRef
   capa0 <- liftM rangeSize $ A.getBounds arr
   when (capa0 < capa) $ do
     arr' <- A.newArray_ (0, capa-1)
     copyTo arr arr' (0, n-1)
-    writeIORef ref (n,arr')
+    writeIORef arrayRef arr'
 
 {--------------------------------------------------------------------
   utility
diff --git a/src/ToySolver/SAT.hs b/src/ToySolver/SAT.hs
--- a/src/ToySolver/SAT.hs
+++ b/src/ToySolver/SAT.hs
@@ -61,3416 +61,3697 @@
   , addPBExactlySoft
   , addXORClause
   , addXORClauseSoft
-
-  -- * Solving
-  , solve
-  , solveWith
-  , BudgetExceeded (..)
-
-  -- * Extract results
-  , Model
-  , getModel
-  , getFailedAssumptions
-
-  -- * Solver configulation
-  , RestartStrategy (..)
-  , setRestartStrategy
-  , defaultRestartStrategy
-  , setRestartFirst
-  , defaultRestartFirst
-  , setRestartInc
-  , defaultRestartInc
-  , setLearntSizeFirst
-  , defaultLearntSizeFirst
-  , setLearntSizeInc
-  , defaultLearntSizeInc
-  , setCCMin
-  , defaultCCMin
-  , LearningStrategy (..)
-  , setLearningStrategy
-  , defaultLearningStrategy
-  , setEnablePhaseSaving
-  , getEnablePhaseSaving
-  , defaultEnablePhaseSaving
-  , setEnableForwardSubsumptionRemoval
-  , getEnableForwardSubsumptionRemoval
-  , defaultEnableForwardSubsumptionRemoval
-  , setEnableBackwardSubsumptionRemoval
-  , getEnableBackwardSubsumptionRemoval
-  , defaultEnableBackwardSubsumptionRemoval
-  , setVarPolarity
-  , setLogger
-  , setCheckModel
-  , setRandomFreq
-  , defaultRandomFreq
-  , setRandomGen
-  , getRandomGen
-  , setConfBudget
-  , PBHandlerType (..)
-  , setPBHandlerType
-  , defaultPBHandlerType
-
-  -- * Read state
-  , nVars
-  , nAssigns
-  , nConstraints
-  , nLearnt
-  , getVarFixed
-  , getLitFixed
-
-  -- * Internal API
-  , varBumpActivity
-  , varDecayActivity
-  ) where
-
-import Prelude hiding (log)
-import Control.Loop
-import Control.Monad
-import Control.Exception
-#if MIN_VERSION_array(0,5,0)
-import Data.Array.IO
-#else
-import Data.Array.IO hiding (unsafeFreeze)
-#endif
-import Data.Array.Unsafe (unsafeFreeze)
-import Data.Array.Base (unsafeRead, unsafeWrite)
-#if MIN_VERSION_hashable(1,2,0)
-import Data.Bits (xor) -- for defining 'combine' function
-#endif
-import Data.Function (on)
-import Data.Hashable
-import Data.HashSet (HashSet)
-import qualified Data.HashSet as HashSet
-import Data.IORef
-import Data.List
-import Data.Maybe
-import Data.Ord
-import qualified Data.IntMap as IM
-import qualified Data.IntSet as IS
-import qualified Data.Set as Set
-import qualified ToySolver.Internal.Data.IndexedPriorityQueue as PQ
-import qualified ToySolver.Internal.Data.SeqQueue as SQ
-import qualified ToySolver.Internal.Data.Vec as Vec
-import Data.Time
-import Data.Typeable
-import System.CPUTime
-import qualified System.Random as Rand
-import Text.Printf
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Types (IO (..))
-import GHC.Exts hiding (Constraint)
-#endif
-
-import ToySolver.Data.LBool
-import ToySolver.SAT.Types
-
-{--------------------------------------------------------------------
-  internal data structures
---------------------------------------------------------------------}
-
-type Level = Int
-
-levelRoot :: Level
-levelRoot = -1
-
-data Assignment
-  = Assignment
-  { aValue  :: !Bool
-  , aIndex  :: {-# UNPACK #-} !Int
-  , aLevel  :: {-# UNPACK #-} !Level
-  , aReason :: !(Maybe SomeConstraintHandler)
-  , aBacktrackCBs :: !(IORef [IO ()])
-  }
-
-data VarData
-  = VarData
-  { vdAssignment :: !(IORef (Maybe Assignment))
-  , vdPolarity   :: !(IORef Bool)
-  , vdPosLitData :: !LitData
-  , vdNegLitData :: !LitData
-  -- | will be invoked when the variable is assigned
-  , vdWatches    :: !(IORef [SomeConstraintHandler])
-  , vdActivity   :: !(IORef VarActivity)
-  }
-
-data LitData
-  = LitData
-  { -- | will be invoked when this literal is falsified
-    ldWatches   :: !(IORef [SomeConstraintHandler])
-  , ldOccurList :: !(IORef (HashSet SomeConstraintHandler))
-  }
-
-newVarData :: IO VarData
-newVarData = do
-  ainfo <- newIORef Nothing
-  polarity <- newIORef True
-  pos <- newLitData
-  neg <- newLitData
-  watches <- newIORef []
-  activity <- newIORef 0
-  return $ VarData ainfo polarity pos neg watches activity
-
-newLitData :: IO LitData
-newLitData = do
-  ws <- newIORef []
-  occ <- newIORef HashSet.empty
-  return $ LitData ws occ
-
-varData :: Solver -> Var -> IO VarData
-varData solver !v = Vec.unsafeRead (svVarData solver) (v-1)
-
-litData :: Solver -> Lit -> IO LitData
-litData solver !l =
-  -- litVar による heap allocation を避けるために、
-  -- litPolarityによる分岐後にvarDataを呼ぶ。
-  if litPolarity l then do
-    vd <- varData solver l
-    return $ vdPosLitData vd
-  else do
-    vd <- varData solver (negate l)
-    return $ vdNegLitData vd
-
-{-# INLINE varValue #-}
-varValue :: Solver -> Var -> IO LBool
-varValue solver !v = do
-  vd <- varData solver v
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Nothing -> return lUndef
-    Just x -> return $! (liftBool $! aValue x)
-
-{-# INLINE litValue #-}
-litValue :: Solver -> Lit -> IO LBool
-litValue solver !l = do
-  -- litVar による heap allocation を避けるために、
-  -- litPolarityによる分岐後にvarDataを呼ぶ。
-  if litPolarity l then
-    varValue solver l
-  else do
-    m <- varValue solver (negate l)
-    return $! lnot m
-
-getVarFixed :: Solver -> Var -> IO LBool
-getVarFixed solver !v = do
-  vd <- varData solver v
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Just x | aLevel x == levelRoot -> return $! (liftBool $! aValue x)
-    _ -> return lUndef
-
-getLitFixed :: Solver -> Var -> IO LBool
-getLitFixed solver !l = do
-  -- litVar による heap allocation を避けるために、
-  -- litPolarityによる分岐後にvarDataを呼ぶ。
-  if litPolarity l then
-    getVarFixed solver l
-  else do
-    m <- getVarFixed solver (negate l)
-    return $! lnot m
-
-varLevel :: Solver -> Var -> IO Level
-varLevel solver !v = do
-  vd <- varData solver v
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Nothing -> error ("ToySolver.SAT.varLevel: unassigned var " ++ show v)
-    Just a -> return (aLevel a)
-
-litLevel :: Solver -> Lit -> IO Level
-litLevel solver l = varLevel solver (litVar l)
-
-varReason :: Solver -> Var -> IO (Maybe SomeConstraintHandler)
-varReason solver !v = do
-  vd <- varData solver v
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Nothing -> error ("ToySolver.SAT.varReason: unassigned var " ++ show v)
-    Just a -> return (aReason a)
-
-varAssignNo :: Solver -> Var -> IO Int
-varAssignNo solver !v = do
-  vd <- varData solver v
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Nothing -> error ("ToySolver.SAT.varAssignNo: unassigned var " ++ show v)
-    Just a -> return (aIndex a)
-
--- | Solver instance
-data Solver
-  = Solver
-  { svOk           :: !(IORef Bool)
-  , svVarQueue     :: !PQ.PriorityQueue
-  , svTrail        :: !(IORef [Lit])
-  , svVarData      :: !(Vec.Vec VarData)
-  , svConstrDB     :: !(IORef [SomeConstraintHandler])
-  , svLearntDB     :: !(IORef (Int,[SomeConstraintHandler]))
-  , svAssumptions  :: !(IORef (IOUArray Int Lit))
-  , svLevel        :: !(IORef Level)
-  , svBCPQueue     :: !(SQ.SeqQueue Lit)
-  , svModel        :: !(IORef (Maybe Model))
-  , svNDecision    :: !(IORef Int)
-  , svNRandomDecision :: !(IORef Int)
-  , svNConflict    :: !(IORef Int)
-  , svNRestart     :: !(IORef Int)
-  , svNAssigns     :: !(IORef Int)
-  , svNFixed       :: !(IORef Int)
-  , svNLearntGC    :: !(IORef Int)
-  , svNRemovedConstr :: !(IORef Int)
-
-  -- | Inverse of the variable activity decay factor. (default 1 / 0.95)
-  , svVarDecay     :: !(IORef Double)
-
-  -- | Amount to bump next variable with.
-  , svVarInc       :: !(IORef Double)
-
-  -- | Inverse of the constraint activity decay factor. (1 / 0.999)
-  , svConstrDecay  :: !(IORef Double)
-
-  -- | Amount to bump next constraint with.
-  , svConstrInc    :: !(IORef Double)
-
-  , svRestartStrategy :: !(IORef RestartStrategy)
-
-  -- | The initial restart limit. (default 100)
-  , svRestartFirst :: !(IORef Int)
-
-  -- | The factor with which the restart limit is multiplied in each restart. (default 1.5)
-  , svRestartInc :: !(IORef Double)
-
-  -- | The initial limit for learnt constraints.
-  , svLearntSizeFirst :: !(IORef Int)
-
-  -- | The limit for learnt constraints is multiplied with this factor periodically. (default 1.1)
-  , svLearntSizeInc :: !(IORef Double)
-
-  , svLearntLim       :: !(IORef Int)
-  , svLearntLimAdjCnt :: !(IORef Int)
-  , svLearntLimSeq    :: !(IORef [(Int,Int)])
-
-  -- | Controls conflict constraint minimization (0=none, 1=local, 2=recursive)
-  , svCCMin :: !(IORef Int)
-
-  , svEnablePhaseSaving :: !(IORef Bool)
-  , svEnableForwardSubsumptionRemoval :: !(IORef Bool)
-
-  , svLearningStrategy :: !(IORef LearningStrategy)
-
-  , svPBHandlerType :: !(IORef PBHandlerType)
-
-  , svEnableBackwardSubsumptionRemoval :: !(IORef Bool)
-
-  , svLogger :: !(IORef (Maybe (String -> IO ())))
-  , svStartWC    :: !(IORef UTCTime)
-  , svLastStatWC :: !(IORef UTCTime)
-
-  , svCheckModel :: !(IORef Bool)
-
-  , svRandomFreq :: !(IORef Double)
-  , svRandomGen  :: !(IORef Rand.StdGen)
-
-  , svFailedAssumptions :: !(IORef [Lit])
-
-  , svConfBudget :: !(IORef Int)
-  }
-
-markBad :: Solver -> IO ()
-markBad solver = do
-  writeIORef (svOk solver) False
-  SQ.clear (svBCPQueue solver)
-
-bcpEnqueue :: Solver -> Lit -> IO ()
-bcpEnqueue solver l = SQ.enqueue (svBCPQueue solver) l
-
-bcpDequeue :: Solver -> IO (Maybe Lit)
-bcpDequeue solver = SQ.dequeue (svBCPQueue solver)
-
-bcpCheckEmpty :: Solver -> IO ()
-bcpCheckEmpty solver = do
-  size <- SQ.queueSize (svBCPQueue solver)
-  unless (size == 0) $
-    error "BUG: BCP Queue should be empty at this point"
-
-assignBy :: ConstraintHandler c => Solver -> Lit -> c -> IO Bool
-assignBy solver lit c = do
-  lv <- readIORef (svLevel solver)
-  let !c2 = if lv == levelRoot
-            then Nothing
-            else Just $! toConstraintHandler c
-  assign_ solver lit c2
-
-assign :: Solver -> Lit -> IO Bool
-assign solver lit = assign_ solver lit Nothing
-
-assign_ :: Solver -> Lit -> Maybe SomeConstraintHandler -> IO Bool
-assign_ solver !lit reason = assert (validLit lit) $ do
-  vd <- varData solver (litVar lit)
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Just a -> return $ litPolarity lit == aValue a
-    Nothing -> do
-      idx <- readIORef (svNAssigns solver)
-      lv <- readIORef (svLevel solver)
-      bt <- newIORef []
-
-      writeIORef (vdAssignment vd) $ Just $!
-        Assignment
-        { aValue  = litPolarity lit
-        , aIndex  = idx
-        , aLevel  = lv
-        , aReason = reason
-        , aBacktrackCBs = bt
-        }
-
-      modifyIORef (svTrail solver) (lit:)
-      modifyIORef' (svNAssigns solver) (+1)
-      when (lv == levelRoot) $ modifyIORef' (svNFixed solver) (+1)
-      bcpEnqueue solver lit
-
-      when debugMode $ logIO solver $ do
-        let r = case reason of
-                  Nothing -> ""
-                  Just _ -> " by propagation"
-        return $ printf "assign(level=%d): %d%s" lv lit r
-
-      return True
-
-unassign :: Solver -> Var -> IO ()
-unassign solver !v = assert (validVar v) $ do
-  vd <- varData solver v
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Nothing -> error "unassign: should not happen"
-    Just a -> do
-      flag <- getEnablePhaseSaving solver
-      when flag $ writeIORef (vdPolarity vd) (aValue a)
-      readIORef (aBacktrackCBs a) >>= sequence_
-  writeIORef (vdAssignment vd) Nothing
-  modifyIORef' (svNAssigns solver) (subtract 1)
-  PQ.enqueue (svVarQueue solver) v
-
-addBacktrackCB :: Solver -> Var -> IO () -> IO ()
-addBacktrackCB solver !v callback = do
-  vd <- varData solver v
-  m <- readIORef (vdAssignment vd)
-  case m of
-    Nothing -> error "addBacktrackCB: should not happen"
-    Just a -> modifyIORef (aBacktrackCBs a) (callback :)
-
--- | Register the constraint to be notified when the literal becames false.
-watchLit :: ConstraintHandler c => Solver -> Lit -> c -> IO ()
-watchLit solver !lit c = do
-  when debugMode $ do
-    lits <- watchedLiterals solver c
-    unless (lit `elem` lits) $ error "watch: should not happen"
-  ld <- litData solver lit
-  modifyIORef (ldWatches ld) (toConstraintHandler c : )
-
--- | Register the constraint to be notified when the variable is assigned.
-watchVar :: ConstraintHandler c => Solver -> Var -> c -> IO ()
-watchVar solver !var c = do
-  when debugMode $ do
-    vs <- watchedVariables solver c
-    unless (var `elem` vs) $ error "watchVar: should not happen"
-  vd <- varData solver var
-  modifyIORef (vdWatches vd) (toConstraintHandler c : )
-
--- | Returns list of constraints that are watching the literal.
-watches :: Solver -> Lit -> IO [SomeConstraintHandler]
-watches solver !lit = do
-  ld <- litData solver lit
-  readIORef (ldWatches ld)
-
-addToDB :: ConstraintHandler c => Solver -> c -> IO ()
-addToDB solver c = do
-  let c2 = toConstraintHandler c
-  modifyIORef (svConstrDB solver) (c2 : )
-  when debugMode $ logIO solver $ do
-    str <- showConstraintHandler c
-    return $ printf "constraint %s is added" str
-
-  b <- isPBRepresentable c
-  when b $ do
-    (lhs,_) <- toPBLinAtLeast c
-    forM_ lhs $ \(_,lit) -> do
-       ld <- litData solver lit
-       modifyIORef' (ldOccurList ld) (HashSet.insert c2)
-
-  sanityCheck solver
-
-addToLearntDB :: ConstraintHandler c => Solver -> c -> IO ()
-addToLearntDB solver c = do
-  modifyIORef (svLearntDB solver) $ \(n,xs) -> (n+1, toConstraintHandler c : xs)
-  when debugMode $ logIO solver $ do
-    str <- showConstraintHandler c
-    return $ printf "constraint %s is added" str
-  sanityCheck solver
-
-reduceDB :: Solver -> IO ()
-reduceDB solver = do
-  (_,cs) <- readIORef (svLearntDB solver)
-
-  xs <- forM cs $ \c -> do
-    p <- constrIsProtected solver c
-    w <- constrWeight solver c
-    actval <- constrReadActivity c
-    return (c, (p, w*actval))
-
-  -- Note that False <= True
-  let ys = sortBy (comparing snd) xs
-      (zs,ws) = splitAt (length ys `div` 2) ys
-
-  let loop [] ret = return ret
-      loop ((c,(isShort,_)) : rest) ret = do
-        flag <- if isShort
-                then return True
-                else isLocked solver c
-        if flag then
-          loop rest (c:ret)
-        else do
-          detach solver c
-          loop rest ret
-  zs2 <- loop zs []
-
-  let cs2 = zs2 ++ map fst ws
-      n2 = length cs2
-
-  -- log solver $ printf "learnt constraints deletion: %d -> %d" n n2
-  writeIORef (svLearntDB solver) (n2,cs2)
-
-type VarActivity = Double
-
-varActivity :: Solver -> Var -> IO VarActivity
-varActivity solver !v = do
-  vd <- varData solver v
-  readIORef (vdActivity vd)
-
-varDecayActivity :: Solver -> IO ()
-varDecayActivity solver = do
-  d <- readIORef (svVarDecay solver)
-  modifyIORef' (svVarInc solver) (d*)
-
-varBumpActivity :: Solver -> Var -> IO ()
-varBumpActivity solver !v = do
-  inc <- readIORef (svVarInc solver)
-  vd <- varData solver v
-  modifyIORef' (vdActivity vd) (+inc)
-  PQ.update (svVarQueue solver) v
-  aval <- readIORef (vdActivity vd)
-  when (aval > 1e20) $
-    -- Rescale
-    varRescaleAllActivity solver
-
-varRescaleAllActivity :: Solver -> IO ()
-varRescaleAllActivity solver = do
-  vs <- variables solver
-  forM_ vs $ \v -> do
-    vd <- varData solver v
-    modifyIORef' (vdActivity vd) (* 1e-20)
-  modifyIORef' (svVarInc solver) (* 1e-20)
-
-variables :: Solver -> IO [Var]
-variables solver = do
-  n <- nVars solver
-  return [1 .. n]
-
--- | number of variables of the problem.
-nVars :: Solver -> IO Int
-nVars solver = Vec.getSize (svVarData solver)
-
--- | number of assigned variables.
-nAssigns :: Solver -> IO Int
-nAssigns solver = readIORef (svNAssigns solver)
-
--- | number of constraints.
-nConstraints :: Solver -> IO Int
-nConstraints solver = do
-  xs <- readIORef (svConstrDB solver)
-  return $ length xs
-
--- | number of learnt constrints.
-nLearnt :: Solver -> IO Int
-nLearnt solver = do
-  (n,_) <- readIORef (svLearntDB solver)
-  return n
-
-learntConstraints :: Solver -> IO [SomeConstraintHandler]
-learntConstraints solver = do
-  (_,cs) <- readIORef (svLearntDB solver)
-  return cs
-
-{--------------------------------------------------------------------
-  Solver
---------------------------------------------------------------------}
-
--- | Create a new Solver instance.
-newSolver :: IO Solver
-newSolver = do
- rec
-  ok   <- newIORef True
-  trail <- newIORef []
-  vars <- Vec.new
-  vqueue <- PQ.newPriorityQueueBy (ltVar solver)
-  db  <- newIORef []
-  db2 <- newIORef (0,[])
-  as  <- newIORef =<< newArray_ (0,-1)
-  lv  <- newIORef levelRoot
-  q   <- SQ.newFifo
-  m   <- newIORef Nothing
-  ndecision <- newIORef 0
-  nranddec  <- newIORef 0
-  nconflict <- newIORef 0
-  nrestart  <- newIORef 0
-  nassigns  <- newIORef 0
-  nfixed    <- newIORef 0
-  nlearntgc <- newIORef 0
-  nremoved  <- newIORef 0
-
-  constrDecay <- newIORef (1 / 0.999)
-  constrInc   <- newIORef 1
-  varDecay <- newIORef (1 / 0.95)
-  varInc   <- newIORef 1
-  restartStrat <- newIORef defaultRestartStrategy
-  restartFirst <- newIORef defaultRestartFirst
-  restartInc <- newIORef defaultRestartInc
-  learning <- newIORef defaultLearningStrategy
-  learntSizeFirst <- newIORef defaultLearntSizeFirst
-  learntSizeInc <- newIORef defaultLearntSizeInc
-  ccMin <- newIORef defaultCCMin
-  checkModel <- newIORef False
-  pbHandlerType <- newIORef defaultPBHandlerType
-  enablePhaseSaving <- newIORef defaultEnablePhaseSaving
-  enableForwardSubsumptionRemoval <- newIORef defaultEnableForwardSubsumptionRemoval
-  enableBackwardSubsumptionRemoval <- newIORef defaultEnableBackwardSubsumptionRemoval
-
-  learntLim       <- newIORef undefined
-  learntLimAdjCnt <- newIORef (-1)
-  learntLimSeq    <- newIORef undefined
-
-  logger <- newIORef Nothing
-  startWC    <- newIORef undefined
-  lastStatWC <- newIORef undefined
-
-  randfreq <- newIORef defaultRandomFreq
-  randgen  <- newIORef =<< Rand.newStdGen
-
-  failed <- newIORef []
-
-  confBudget <- newIORef (-1)
-
-  let solver =
-        Solver
-        { svOk = ok
-        , svVarQueue   = vqueue
-        , svTrail      = trail
-        , svVarData    = vars
-        , svConstrDB   = db
-        , svLearntDB   = db2
-        , svAssumptions = as
-        , svLevel      = lv
-        , svBCPQueue   = q
-        , svModel      = m
-        , svNDecision  = ndecision
-        , svNRandomDecision = nranddec
-        , svNConflict  = nconflict
-        , svNRestart   = nrestart
-        , svNAssigns   = nassigns
-        , svNFixed     = nfixed
-        , svNLearntGC  = nlearntgc
-        , svNRemovedConstr = nremoved
-        , svVarDecay    = varDecay
-        , svVarInc      = varInc
-        , svConstrDecay = constrDecay
-        , svConstrInc   = constrInc
-        , svRestartStrategy = restartStrat
-        , svRestartFirst = restartFirst
-        , svRestartInc   = restartInc
-        , svLearningStrategy = learning
-        , svLearntSizeFirst = learntSizeFirst
-        , svLearntSizeInc = learntSizeInc
-        , svCCMin = ccMin
-        , svEnablePhaseSaving = enablePhaseSaving
-        , svEnableForwardSubsumptionRemoval = enableForwardSubsumptionRemoval
-        , svPBHandlerType   = pbHandlerType
-        , svEnableBackwardSubsumptionRemoval = enableBackwardSubsumptionRemoval
-        , svLearntLim       = learntLim
-        , svLearntLimAdjCnt = learntLimAdjCnt
-        , svLearntLimSeq    = learntLimSeq
-        , svLogger = logger
-        , svStartWC    = startWC
-        , svLastStatWC = lastStatWC
-        , svCheckModel = checkModel
-        , svRandomFreq = randfreq
-        , svRandomGen  = randgen
-        , svFailedAssumptions = failed
-        , svConfBudget = confBudget
-        }
- return solver
-
-ltVar :: Solver -> Var -> Var -> IO Bool
-ltVar solver v1 v2 = do
-  a1 <- varActivity solver v1
-  a2 <- varActivity solver v2
-  return $! a1 > a2
-
-{--------------------------------------------------------------------
-  Problem specification
---------------------------------------------------------------------}
-
--- |Add a new variable
-newVar :: Solver -> IO Var
-newVar solver = do
-  n <- Vec.getSize (svVarData solver)
-  let v = n + 1
-  vd <- newVarData
-  Vec.push (svVarData solver) vd
-  PQ.enqueue (svVarQueue solver) v
-  return v
-
--- |Add variables. @newVars solver n = replicateM n (newVar solver)@
-newVars :: Solver -> Int -> IO [Var]
-newVars solver n = do
-  nv <- nVars solver
-  resizeVarCapacity solver (nv+n)
-  replicateM n (newVar solver)
-
--- |Add variables. @newVars_ solver n = newVars solver n >> return ()@
-newVars_ :: Solver -> Int -> IO ()
-newVars_ solver n = do
-  nv <- nVars solver
-  resizeVarCapacity solver (nv+n)
-  replicateM_ n (newVar solver)
-
--- |Pre-allocate internal buffer for @n@ variables.
-resizeVarCapacity :: Solver -> Int -> IO ()
-resizeVarCapacity solver n = do
-  Vec.resizeCapacity (svVarData solver) n
-  PQ.resizeHeapCapacity (svVarQueue solver) n
-  PQ.resizeTableCapacity (svVarQueue solver) (n+1)
-
--- |Add a clause to the solver.
-addClause :: Solver -> Clause -> IO ()
-addClause solver lits = do
-  d <- readIORef (svLevel solver)
-  assert (d == levelRoot) $ return ()
-
-  ok <- readIORef (svOk solver)
-  when ok $ do
-    lits2 <- instantiateClause solver lits
-    case normalizeClause =<< lits2 of
-      Nothing -> return ()
-      Just [] -> markBad solver
-      Just [lit] -> do
-        {- We do not call 'removeBackwardSubsumedBy' here,
-           because subsumed constraints will be removed by 'simplify'. -}
-        ret <- assign solver lit
-        assert ret $ return ()
-        ret2 <- deduce solver
-        case ret2 of
-          Nothing -> return ()
-          Just _ -> markBad solver
-      Just lits3 -> do
-        subsumed <- checkForwardSubsumption solver lits
-        unless subsumed $ do
-          removeBackwardSubsumedBy solver ([(1,lit) | lit <- lits3], 1)
-          clause <- newClauseHandler lits3 False
-          addToDB solver clause
-          _ <- basicAttachClauseHandler solver clause
-          return ()
-
--- | Add a cardinality constraints /atleast({l1,l2,..},n)/.
-addAtLeast :: Solver -- ^ The 'Solver' argument.
-           -> [Lit]  -- ^ set of literals /{l1,l2,..}/ (duplicated elements are ignored)
-           -> Int    -- ^ /n/.
-           -> IO ()
-addAtLeast solver lits n = do
-  d <- readIORef (svLevel solver)
-  assert (d == levelRoot) $ return ()
-
-  ok <- readIORef (svOk solver)
-  when ok $ do
-    (lits',n') <- liftM normalizeAtLeast $ instantiateAtLeast solver (lits,n)
-    let len = length lits'
-
-    if n' <= 0 then return ()
-    else if n' > len then markBad solver
-    else if n' == 1 then addClause solver lits'
-    else if n' == len then do
-      {- We do not call 'removeBackwardSubsumedBy' here,
-         because subsumed constraints will be removed by 'simplify'. -}
-      forM_ lits' $ \l -> do
-        ret <- assign solver l
-        assert ret $ return ()
-      ret2 <- deduce solver
-      case ret2 of
-        Nothing -> return ()
-        Just _ -> markBad solver
-    else do
-      removeBackwardSubsumedBy solver ([(1,lit) | lit <- lits'], fromIntegral n')
-      c <- newAtLeastHandler lits' n' False
-      addToDB solver c
-      _ <- basicAttachAtLeastHandler solver c
-      return ()
-
--- | Add a cardinality constraints /atmost({l1,l2,..},n)/.
-addAtMost :: Solver -- ^ The 'Solver' argument
-          -> [Lit]  -- ^ set of literals /{l1,l2,..}/ (duplicated elements are ignored)
-          -> Int    -- ^ /n/
-          -> IO ()
-addAtMost solver lits n = addAtLeast solver lits' (len-n)
-  where
-    len   = length lits
-    lits' = map litNot lits
-
--- | Add a cardinality constraints /exactly({l1,l2,..},n)/.
-addExactly :: Solver -- ^ The 'Solver' argument
-           -> [Lit]  -- ^ set of literals /{l1,l2,..}/ (duplicated elements are ignored)
-           -> Int    -- ^ /n/
-           -> IO ()
-addExactly solver lits n = do
-  addAtLeast solver lits n
-  addAtMost solver lits n
-
--- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … ≥ n/.
-addPBAtLeast :: Solver          -- ^ The 'Solver' argument.
-             -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
-             -> Integer         -- ^ /n/
-             -> IO ()
-addPBAtLeast solver ts n = do
-  d <- readIORef (svLevel solver)
-  assert (d == levelRoot) $ return ()
-
-  ok <- readIORef (svOk solver)
-  when ok $ do
-    (ts',degree) <- liftM normalizePBLinAtLeast $ instantiatePB solver (ts,n)
-  
-    case pbToAtLeast (ts',degree) of
-      Just (lhs',rhs') -> addAtLeast solver lhs' rhs'
-      Nothing -> do
-        let cs = map fst ts'
-            slack = sum cs - degree
-        if degree <= 0 then return ()
-        else if slack < 0 then markBad solver
-        else do
-          removeBackwardSubsumedBy solver (ts', degree)
-          c <- newPBHandler solver ts' degree False
-          addToDB solver c
-          ret <- attach solver c
-          if not ret then do
-            markBad solver
-          else do
-            ret2 <- deduce solver
-            case ret2 of
-              Nothing -> return ()
-              Just _ -> markBad solver
-
--- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … ≤ n/.
-addPBAtMost :: Solver          -- ^ The 'Solver' argument.
-            -> [(Integer,Lit)] -- ^ list of @[(c1,l1),(c2,l2),…]@
-            -> Integer         -- ^ /n/
-            -> IO ()
-addPBAtMost solver ts n = addPBAtLeast solver [(-c,l) | (c,l) <- ts] (negate n)
-
--- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … = n/.
-addPBExactly :: Solver          -- ^ The 'Solver' argument.
-             -> [(Integer,Lit)] -- ^ list of terms @[(c1,l1),(c2,l2),…]@
-             -> Integer         -- ^ /n/
-             -> IO ()
-addPBExactly solver ts n = do
-  (ts2,n2) <- liftM normalizePBLinExactly $ instantiatePB solver (ts,n)
-  addPBAtLeast solver ts2 n2
-  addPBAtMost solver ts2 n2
-
--- | Add a soft pseudo boolean constraints /lit ⇒ c1*l1 + c2*l2 + … ≥ n/.
-addPBAtLeastSoft
-  :: Solver          -- ^ The 'Solver' argument.
-  -> Lit             -- ^ indicator @lit@
-  -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
-  -> Integer         -- ^ /n/
-  -> IO ()
-addPBAtLeastSoft solver sel lhs rhs = do
-  (lhs', rhs') <- liftM normalizePBLinAtLeast $ instantiatePB solver (lhs,rhs)
-  addPBAtLeast solver ((rhs', litNot sel) : lhs') rhs'
-
--- | Add a soft pseudo boolean constraints /lit ⇒ c1*l1 + c2*l2 + … ≤ n/.
-addPBAtMostSoft
-  :: Solver          -- ^ The 'Solver' argument.
-  -> Lit             -- ^ indicator @lit@
-  -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
-  -> Integer         -- ^ /n/
-  -> IO ()
-addPBAtMostSoft solver sel lhs rhs =
-  addPBAtLeastSoft solver sel [(negate c, lit) | (c,lit) <- lhs] (negate rhs)
-
--- | Add a soft pseudo boolean constraints /lit ⇒ c1*l1 + c2*l2 + … = n/.
-addPBExactlySoft
-  :: Solver          -- ^ The 'Solver' argument.
-  -> Lit             -- ^ indicator @lit@
-  -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
-  -> Integer         -- ^ /n/
-  -> IO ()
-addPBExactlySoft solver sel lhs rhs = do
-  (lhs2, rhs2) <- liftM normalizePBLinExactly $ instantiatePB solver (lhs,rhs)
-  addPBAtLeastSoft solver sel lhs2 rhs2
-  addPBAtMostSoft solver sel lhs2 rhs2
-
--- | Add a parity constraint /l1 ⊕ l2 ⊕ … ⊕ ln = rhs/
-addXORClause
-  :: Solver -- ^ The 'Solver' argument.
-  -> [Lit]  -- ^ literals @[l1, l2, …, ln]@
-  -> Bool   -- ^ /rhs/
-  -> IO ()
-addXORClause solver lits rhs = do
-  d <- readIORef (svLevel solver)
-  assert (d == levelRoot) $ return ()
-
-  ok <- readIORef (svOk solver)
-  when ok $ do
-    xcl <- instantiateXORClause solver (lits,rhs)
-    case normalizeXORClause xcl of
-      ([], True) -> markBad solver
-      ([], False) -> return ()
-      ([l], b) -> addClause solver [if b then l else litNot l]
-      (l:ls, b) -> do
-        c <- newXORClauseHandler ((if b then l else litNot l) : ls) False
-        addToDB solver c
-        _ <- basicAttachXORClauseHandler solver c
-        return ()
-
--- | Add a soft parity constraint /lit ⇒ l1 ⊕ l2 ⊕ … ⊕ ln = rhs/
-addXORClauseSoft
-  :: Solver -- ^ The 'Solver' argument.
-  -> Lit    -- ^ indicator @lit@
-  -> [Lit]  -- ^ literals @[l1, l2, …, ln]@
-  -> Bool   -- ^ /rhs/
-  -> IO ()
-addXORClauseSoft solver ind lits rhs = do
-  reified <- newVar solver
-  addXORClause solver (litNot reified : lits) rhs
-  addClause solver [litNot ind, reified] -- ind ⇒ reified
-
-{--------------------------------------------------------------------
-  Problem solving
---------------------------------------------------------------------}
-
--- | Solve constraints.
--- Returns 'True' if the problem is SATISFIABLE.
--- Returns 'False' if the problem is UNSATISFIABLE.
-solve :: Solver -> IO Bool
-solve solver = do
-  as <- newArray_ (0,-1)
-  writeIORef (svAssumptions solver) as
-  solve_ solver
-
--- | Solve constraints under assuptions.
--- Returns 'True' if the problem is SATISFIABLE.
--- Returns 'False' if the problem is UNSATISFIABLE.
-solveWith :: Solver
-          -> [Lit]    -- ^ Assumptions
-          -> IO Bool
-solveWith solver ls = do
-  as <- newListArray (0, length ls -1) ls
-  writeIORef (svAssumptions solver) as
-  solve_ solver
-
-solve_ :: Solver -> IO Bool
-solve_ solver = do
-  log solver "Solving starts ..."
-  resetStat solver
-  writeIORef (svModel solver) Nothing
-  writeIORef (svFailedAssumptions solver) []
-
-  ok <- readIORef (svOk solver)
-  if not ok then
-    return False
-  else do
-    when debugMode $ dumpVarActivity solver
-    d <- readIORef (svLevel solver)
-    assert (d == levelRoot) $ return ()
-
-    restartStrategy <- readIORef (svRestartStrategy solver)
-    restartFirst  <- readIORef (svRestartFirst solver)
-    restartInc    <- readIORef (svRestartInc solver)
-    let restartSeq = mkRestartSeq restartStrategy restartFirst restartInc
-
-    let learntSizeAdj = do
-          (size,adj) <- shift (svLearntLimSeq solver)
-          writeIORef (svLearntLim solver) size
-          writeIORef (svLearntLimAdjCnt solver) adj
-        onConflict = do
-          cnt <- readIORef (svLearntLimAdjCnt solver)
-          if (cnt==0)
-          then learntSizeAdj
-          else writeIORef (svLearntLimAdjCnt solver) $! cnt-1
-
-    cnt <- readIORef (svLearntLimAdjCnt solver)
-    when (cnt == -1) $ do
-      learntSizeFirst <- readIORef (svLearntSizeFirst solver)
-      learntSizeInc   <- readIORef (svLearntSizeInc solver)
-      nc <- nConstraints solver
-      nv <- nVars solver
-      let initialLearntLim = if learntSizeFirst > 0 then learntSizeFirst else max ((nc + nv) `div` 3) 16
-          learntSizeSeq    = iterate (ceiling . (learntSizeInc*) . fromIntegral) initialLearntLim
-          learntSizeAdjSeq = iterate (\x -> (x * 3) `div` 2) (100::Int)
-      writeIORef (svLearntLimSeq solver) (zip learntSizeSeq learntSizeAdjSeq)
-      learntSizeAdj
-
-    let loop [] = error "solve_: should not happen"
-        loop (conflict_lim:rs) = do
-          printStat solver True
-          ret <- search solver conflict_lim onConflict
-          case ret of
-            SRFinished x -> return $ Just x
-            SRBudgetExceeded -> return Nothing
-            SRRestart -> do
-              modifyIORef' (svNRestart solver) (+1)
-              backtrackTo solver levelRoot
-              loop rs
-
-    printStatHeader solver
-
-    startCPU <- getCPUTime
-    startWC  <- getCurrentTime
-    writeIORef (svStartWC solver) startWC
-    result <- loop restartSeq
-    endCPU <- getCPUTime
-    endWC  <- getCurrentTime
-
-    when (result == Just True) $ do
-      checkModel <- readIORef (svCheckModel solver)
-      when checkModel $ checkSatisfied solver
-      constructModel solver
-
-    backtrackTo solver levelRoot
-
-    when debugMode $ dumpVarActivity solver
-    when debugMode $ dumpConstrActivity solver
-    printStat solver True
-    (log solver . printf "#cpu_time = %.3fs") (fromIntegral (endCPU - startCPU) / 10^(12::Int) :: Double)
-    (log solver . printf "#wall_clock_time = %.3fs") (realToFrac (endWC `diffUTCTime` startWC) :: Double)
-    (log solver . printf "#decision = %d") =<< readIORef (svNDecision solver)
-    (log solver . printf "#random_decision = %d") =<< readIORef (svNRandomDecision solver)
-    (log solver . printf "#conflict = %d") =<< readIORef (svNConflict solver)
-    (log solver . printf "#restart = %d")  =<< readIORef (svNRestart solver)
-
-    case result of
-      Just x  -> return x
-      Nothing -> throw BudgetExceeded
-
-data BudgetExceeded = BudgetExceeded
-  deriving (Show, Typeable)
-
-instance Exception BudgetExceeded
-
-data SearchResult
-  = SRFinished Bool
-  | SRRestart
-  | SRBudgetExceeded
-
-search :: Solver -> Int -> IO () -> IO SearchResult
-search solver !conflict_lim onConflict = do
-  conflictCounter <- newIORef 0
-  let 
-    loop :: IO SearchResult
-    loop = do
-      sanityCheck solver
-      conflict <- deduce solver
-      sanityCheck solver
-      case conflict of
-        Just constr -> do
-          ret <- handleConflict conflictCounter constr
-          case ret of
-            Just sr -> return sr
-            Nothing -> loop
-        Nothing -> do
-          lv <- readIORef (svLevel solver)
-          when (lv == levelRoot) $ simplify solver
-          checkGC
-          r <- pickAssumption
-          case r of
-            Nothing -> return (SRFinished False)
-            Just lit
-              | lit /= litUndef -> decide solver lit >> loop
-              | otherwise -> do
-                  lit2 <- pickBranchLit solver
-                  if lit2 == litUndef
-                    then return (SRFinished True)
-                    else decide solver lit2 >> loop
-  loop
-
-  where
-    checkGC :: IO ()
-    checkGC = do
-      n <- nLearnt solver
-      m <- nAssigns solver
-      learnt_lim <- readIORef (svLearntLim solver)
-      when (learnt_lim >= 0 && n - m > learnt_lim) $ do
-        modifyIORef' (svNLearntGC solver) (+1)
-        reduceDB solver
-
-    pickAssumption :: IO (Maybe Lit)
-    pickAssumption = do
-      !as <- readIORef (svAssumptions solver)
-      !b <- getBounds as
-      let go = do
-              d <- readIORef (svLevel solver)
-              if not (inRange b (d+1)) then
-                return (Just litUndef)
-              else do
-                l <- readArray as (d+1)
-                val <- litValue solver l
-                if val == lTrue then do
-                  -- dummy decision level
-                  modifyIORef' (svLevel solver) (+1)
-                  go
-                else if val == lFalse then do
-                  -- conflict with assumption
-                  core <- analyzeFinal solver l
-                  writeIORef (svFailedAssumptions solver) core
-                  return Nothing
-                else
-                  return (Just l)
-      go
-
-    handleConflict :: IORef Int -> SomeConstraintHandler -> IO (Maybe SearchResult)
-    handleConflict conflictCounter constr = do
-      varDecayActivity solver
-      constrDecayActivity solver
-      onConflict
-
-      modifyIORef' (svNConflict solver) (+1)
-      d <- readIORef (svLevel solver)
-
-      when debugMode $ logIO solver $ do
-        str <- showConstraintHandler constr
-        return $ printf "conflict(level=%d): %s" d str
-
-      modifyIORef' conflictCounter (+1)
-      c <- readIORef conflictCounter
-
-      modifyIORef' (svConfBudget solver) $ \confBudget ->
-        if confBudget > 0 then confBudget - 1 else confBudget
-      confBudget <- readIORef (svConfBudget solver)
-
-      when (c `mod` 100 == 0) $ do
-        printStat solver False
-
-      if d == levelRoot then do
-        markBad solver
-        return $ Just (SRFinished False)
-      else if confBudget==0 then
-        return $ Just SRBudgetExceeded
-      else if conflict_lim >= 0 && c >= conflict_lim then
-        return $ Just SRRestart
-      else do
-        strat <- readIORef (svLearningStrategy solver)
-        case strat of
-          LearningClause -> learnClause constr >> return Nothing
-          LearningHybrid -> learnHybrid conflictCounter constr
-
-    learnClause :: SomeConstraintHandler -> IO ()
-    learnClause constr = do
-      (learntClause, level) <- analyzeConflict solver constr
-      backtrackTo solver level
-      case learntClause of
-        [] -> error "search(LearningClause): should not happen"
-        [lit] -> do
-          ret <- assign solver lit
-          assert ret $ return ()
-          return ()
-        lit:_ -> do
-          cl <- newClauseHandler learntClause True
-          addToLearntDB solver cl
-          basicAttachClauseHandler solver cl
-          assignBy solver lit cl
-          constrBumpActivity solver cl
-
-    learnHybrid :: IORef Int -> SomeConstraintHandler -> IO (Maybe SearchResult)
-    learnHybrid conflictCounter constr = do
-      ((learntClause, clauseLevel), (pb, pbLevel)) <- analyzeConflictHybrid solver constr
-      let minLevel = min clauseLevel pbLevel
-      backtrackTo solver minLevel
-
-      case learntClause of
-        [] -> error "search(LearningHybrid): should not happen"
-        [lit] -> do
-          _ <- assign solver lit -- This should always succeed.
-          return ()
-        lit:_ -> do
-          cl <- newClauseHandler learntClause True
-          addToLearntDB solver cl
-          basicAttachClauseHandler solver cl
-          constrBumpActivity solver cl
-          when (minLevel == clauseLevel) $ do
-            _ <- assignBy solver lit cl -- This should always succeed.
-            return ()
-
-      ret <- deduce solver
-      case ret of
-        Just conflicted -> do
-          handleConflict conflictCounter conflicted
-          -- TODO: should also learn the PB constraint?
-        Nothing -> do
-          let (lhs,rhs) = pb
-          h <- newPBHandlerPromoted solver lhs rhs True
-          case h of
-            CHClause _ -> do
-              {- We don't want to add additional clause,
-                 since it would be subsumed by already added one. -}
-              return Nothing
-            _ -> do
-              addToLearntDB solver h
-              ret2 <- attach solver h
-              constrBumpActivity solver h
-              if ret2 then
-                return Nothing
-              else
-                handleConflict conflictCounter h
-
--- | After 'solve' returns True, it returns an satisfying assignment.
-getModel :: Solver -> IO Model
-getModel solver = do
-  m <- readIORef (svModel solver)
-  return (fromJust m)
-
--- | After 'solveWith' returns False, it returns a set of assumptions
--- that leads to contradiction. In particular, if it returns an empty
--- set, the problem is unsatisiable without any assumptions.
-getFailedAssumptions :: Solver -> IO [Lit]
-getFailedAssumptions solver = readIORef (svFailedAssumptions solver)
-
-{--------------------------------------------------------------------
-  Simplification
---------------------------------------------------------------------}
-
--- | Simplify the constraint database according to the current top-level assigment.
-simplify :: Solver -> IO ()
-simplify solver = do
-  let loop [] rs !n     = return (rs,n)
-      loop (y:ys) rs !n = do
-        b1 <- isSatisfied solver y
-        b2 <- isLocked solver y
-        if b1 && not b2 then do
-          detach solver y
-          loop ys rs (n+1)
-        else loop ys (y:rs) n
-
-  -- simplify original constraint DB
-  do
-    xs <- readIORef (svConstrDB solver)
-    (ys,n) <- loop xs [] (0::Int)
-    modifyIORef' (svNRemovedConstr solver) (+n)
-    writeIORef (svConstrDB solver) ys
-
-  -- simplify learnt constraint DB
-  do
-    (m,xs) <- readIORef (svLearntDB solver)
-    (ys,n) <- loop xs [] (0::Int)
-    writeIORef (svLearntDB solver) (m-n, ys)
-
-{-
-References:
-L. Zhang, "On subsumption removal and On-the-Fly CNF simplification,"
-Theory and Applications of Satisfiability Testing (2005), pp. 482-489.
--}
-
-checkForwardSubsumption :: Solver -> Clause -> IO Bool
-checkForwardSubsumption solver lits = do
-  flag <- getEnableForwardSubsumptionRemoval solver
-  if not flag then
-    return False
-  else do
-    withEnablePhaseSaving solver False $ do
-      bracket_
-        (modifyIORef' (svLevel solver) (+1))
-        (backtrackTo solver levelRoot) $ do
-          b <- allM (\lit -> assign solver (litNot lit)) lits
-          if b then
-            liftM isJust (deduce solver)
-          else do
-            when debugMode $ log solver ("forward subsumption: " ++ show lits)
-            return True
-  where
-    withEnablePhaseSaving solver flag m =
-      bracket
-        (getEnablePhaseSaving solver)
-        (setEnablePhaseSaving solver)
-        (\_ -> setEnablePhaseSaving solver flag >> m)
-
-removeBackwardSubsumedBy :: Solver -> PBLinAtLeast -> IO ()
-removeBackwardSubsumedBy solver pb = do
-  flag <- getEnableBackwardSubsumptionRemoval solver
-  when flag $ do
-    xs <- backwardSubsumedBy solver pb
-    when debugMode $ do
-      forM_ (HashSet.toList xs) $ \c -> do
-        s <- showConstraintHandler c
-        log solver (printf "backward subsumption: %s is subsumed by %s\n" s (show pb))
-    removeConstraintHandlers solver xs
-
-backwardSubsumedBy :: Solver -> PBLinAtLeast -> IO (HashSet SomeConstraintHandler)
-backwardSubsumedBy solver pb@(lhs,_) = do
-  xs <- forM lhs $ \(_,lit) -> do
-    ld <- litData solver lit
-    readIORef (ldOccurList ld)
-  case xs of
-    [] -> return HashSet.empty
-    s:ss -> do
-      let p c = do
-            -- Note that @isPBRepresentable c@ is always True here,
-            -- because only such constraints are added to occur list.
-            -- See 'addToDB'.
-            pb2 <- instantiatePB solver =<< toPBLinAtLeast c
-            return $ pbSubsume pb pb2
-      liftM HashSet.fromList
-        $ filterM p
-        $ HashSet.toList
-        $ foldl' HashSet.intersection s ss
-
-removeConstraintHandlers :: Solver -> HashSet SomeConstraintHandler -> IO ()
-removeConstraintHandlers _ zs | HashSet.null zs = return ()
-removeConstraintHandlers solver zs = do
-  let loop [] rs !n     = return (rs,n)
-      loop (c:cs) rs !n = do
-        if c `HashSet.member` zs then do
-          detach solver c
-          loop cs rs (n+1)
-        else loop cs (c:rs) n
-  xs <- readIORef (svConstrDB solver)
-  (ys,n) <- loop xs [] (0::Int)
-  modifyIORef' (svNRemovedConstr solver) (+n)
-  writeIORef (svConstrDB solver) ys
-
-{--------------------------------------------------------------------
-  Parameter settings.
---------------------------------------------------------------------}
-
-setRestartStrategy :: Solver -> RestartStrategy -> IO ()
-setRestartStrategy solver s = writeIORef (svRestartStrategy solver) s
-
--- | default value for @RestartStrategy@.
-defaultRestartStrategy :: RestartStrategy
-defaultRestartStrategy = MiniSATRestarts
-
--- | The initial restart limit. (default 100)
--- Negative value is used to disable restart.
-setRestartFirst :: Solver -> Int -> IO ()
-setRestartFirst solver !n = writeIORef (svRestartFirst solver) n
-
--- | default value for @RestartFirst@.
-defaultRestartFirst :: Int
-defaultRestartFirst = 100
-
--- | The factor with which the restart limit is multiplied in each restart. (default 1.5)
-setRestartInc :: Solver -> Double -> IO ()
-setRestartInc solver !r = writeIORef (svRestartInc solver) r
-
--- | default value for @RestartInc@.
-defaultRestartInc :: Double
-defaultRestartInc = 1.5
-
-data LearningStrategy
-  = LearningClause
-  | LearningHybrid
-
-setLearningStrategy :: Solver -> LearningStrategy -> IO ()
-setLearningStrategy solver l = writeIORef (svLearningStrategy solver) $! l
-
-defaultLearningStrategy :: LearningStrategy
-defaultLearningStrategy = LearningClause
-
--- | The initial limit for learnt clauses.
-setLearntSizeFirst :: Solver -> Int -> IO ()
-setLearntSizeFirst solver !x = writeIORef (svLearntSizeFirst solver) x
-
--- | default value for @LearntSizeFirst@.
-defaultLearntSizeFirst :: Int
-defaultLearntSizeFirst = -1
-
--- | The limit for learnt clauses is multiplied with this factor each restart. (default 1.1)
-setLearntSizeInc :: Solver -> Double -> IO ()
-setLearntSizeInc solver !r = writeIORef (svLearntSizeInc solver) r
-
--- | default value for @LearntSizeInc@.
-defaultLearntSizeInc :: Double
-defaultLearntSizeInc = 1.1
-
--- | The limit for learnt clauses is multiplied with this factor each restart. (default 1.1)
-setCCMin :: Solver -> Int -> IO ()
-setCCMin solver !v = writeIORef (svCCMin solver) v
-
--- | default value for @CCMin@.
-defaultCCMin :: Int
-defaultCCMin = 2
-
--- | The default polarity of a variable.
-setVarPolarity :: Solver -> Var -> Bool -> IO ()
-setVarPolarity solver v val = do
-  vd <- varData solver v
-  writeIORef (vdPolarity vd) val
-
-setCheckModel :: Solver -> Bool -> IO ()
-setCheckModel solver flag = do
-  writeIORef (svCheckModel solver) flag
-
--- | The frequency with which the decision heuristic tries to choose a random variable
-setRandomFreq :: Solver -> Double -> IO ()
-setRandomFreq solver r = do
-  writeIORef (svRandomFreq solver) r
-
-defaultRandomFreq :: Double
-defaultRandomFreq = 0.005
-
--- | Set random generator used by the random variable selection
-setRandomGen :: Solver -> Rand.StdGen -> IO ()
-setRandomGen solver = writeIORef (svRandomGen solver)
-
--- | Get random generator used by the random variable selection
-getRandomGen :: Solver -> IO Rand.StdGen
-getRandomGen solver = readIORef (svRandomGen solver)
-
-setConfBudget :: Solver -> Maybe Int -> IO ()
-setConfBudget solver (Just b) | b >= 0 = writeIORef (svConfBudget solver) b
-setConfBudget solver _ = writeIORef (svConfBudget solver) (-1)
-
-data PBHandlerType = PBHandlerTypeCounter | PBHandlerTypePueblo
-  deriving (Show, Eq, Ord)
-
-defaultPBHandlerType :: PBHandlerType
-defaultPBHandlerType = PBHandlerTypeCounter
-
-setPBHandlerType :: Solver -> PBHandlerType -> IO ()
-setPBHandlerType solver ht = do
-  writeIORef (svPBHandlerType solver) ht
-
-setEnablePhaseSaving :: Solver -> Bool -> IO ()
-setEnablePhaseSaving solver flag = do
-  writeIORef (svEnablePhaseSaving solver) flag
-
-getEnablePhaseSaving :: Solver -> IO Bool
-getEnablePhaseSaving solver = do
-  readIORef (svEnablePhaseSaving solver)
-
-defaultEnablePhaseSaving :: Bool
-defaultEnablePhaseSaving = True
-
-setEnableForwardSubsumptionRemoval :: Solver -> Bool -> IO ()
-setEnableForwardSubsumptionRemoval solver flag = do
-  writeIORef (svEnableForwardSubsumptionRemoval solver) flag
-
-getEnableForwardSubsumptionRemoval :: Solver -> IO Bool
-getEnableForwardSubsumptionRemoval solver = do
-  readIORef (svEnableForwardSubsumptionRemoval solver)
-
-defaultEnableForwardSubsumptionRemoval :: Bool
-defaultEnableForwardSubsumptionRemoval = False
-
-setEnableBackwardSubsumptionRemoval :: Solver -> Bool -> IO ()
-setEnableBackwardSubsumptionRemoval solver flag = do
-  writeIORef (svEnableBackwardSubsumptionRemoval solver) flag
-
-getEnableBackwardSubsumptionRemoval :: Solver -> IO Bool
-getEnableBackwardSubsumptionRemoval solver = do
-  readIORef (svEnableBackwardSubsumptionRemoval solver)
-
-defaultEnableBackwardSubsumptionRemoval :: Bool
-defaultEnableBackwardSubsumptionRemoval = False
-
-{--------------------------------------------------------------------
-  API for implementation of @solve@
---------------------------------------------------------------------}
-
-pickBranchLit :: Solver -> IO Lit
-pickBranchLit !solver = do
-  let vqueue = svVarQueue solver
-
-  -- Random decision
-  let withRandGen :: (Rand.StdGen -> (a, Rand.StdGen)) -> IO a
-      withRandGen f = do
-        randgen  <- readIORef (svRandomGen solver)
-        let (r, randgen') = f randgen
-        writeIORef (svRandomGen solver) randgen'
-        return r
-  !randfreq <- readIORef (svRandomFreq solver)
-  !size <- PQ.queueSize vqueue
-  !r <- withRandGen Rand.random
-  var <-
-    if (r < randfreq && size >= 2) then do
-      a <- PQ.getHeapArray vqueue
-      i <- withRandGen $ Rand.randomR (0, size-1)
-      var <- readArray a i
-      val <- varValue solver var
-      if val == lUndef then do
-        modifyIORef' (svNRandomDecision solver) (1+)
-        return var
-      else return litUndef
-    else
-      return litUndef
-
-  -- Activity based decision
-  let loop :: IO Var
-      loop = do
-        m <- PQ.dequeue vqueue
-        case m of
-          Nothing -> return litUndef
-          Just var2 -> do
-            val2 <- varValue solver var2
-            if val2 /= lUndef
-              then loop
-              else return var2
-  var2 <-
-    if var==litUndef
-    then loop
-    else return var
-
-  if var2==litUndef then
-    return litUndef
-  else do
-    vd <- varData solver var2
-    -- TODO: random polarity
-    p <- readIORef (vdPolarity vd)
-    return $! literal var2 p
-
-decide :: Solver -> Lit -> IO ()
-decide solver !lit = do
-  modifyIORef' (svNDecision solver) (+1)
-  modifyIORef' (svLevel solver) (+1)
-  when debugMode $ do
-    val <- litValue solver lit
-    when (val /= lUndef) $ error "decide: should not happen"
-  assign solver lit
-  return ()
-
-deduce :: Solver -> IO (Maybe SomeConstraintHandler)
-deduce solver = loop
-  where
-    loop :: IO (Maybe SomeConstraintHandler)
-    loop = do
-      r <- bcpDequeue solver
-      case r of
-        Nothing -> return Nothing
-        Just lit -> do
-          ret <- processLit lit
-          case ret of
-            Just _ -> return ret
-            Nothing -> do
-              ret <- processVar (litVar lit)
-              case ret of
-                Just _ -> return ret
-                Nothing -> loop
-
-    processLit :: Lit -> IO (Maybe SomeConstraintHandler)
-    processLit !lit = do
-      let falsifiedLit = litNot lit
-      ld <- litData solver falsifiedLit
-      let wsref = ldWatches ld
-      let loop2 [] = return Nothing
-          loop2 (w:ws) = do
-            ok <- propagate solver w falsifiedLit
-            if ok then
-              loop2 ws
-            else do
-              modifyIORef wsref (++ws)
-              return (Just w)
-      ws <- readIORef wsref
-      writeIORef wsref []
-      loop2 ws
-
-    processVar :: Lit -> IO (Maybe SomeConstraintHandler)
-    processVar !lit = do
-      let falsifiedLit = litNot lit
-      vd <- varData solver (litVar lit)
-      let wsref = vdWatches vd
-      let loop2 [] = return Nothing
-          loop2 (w:ws) = do
-            ok <- propagate solver w falsifiedLit
-            if ok
-              then loop2 ws
-              else do
-                modifyIORef wsref (++ws)
-                return (Just w)
-      ws <- readIORef wsref
-      writeIORef wsref []
-      loop2 ws
-
-analyzeConflict :: ConstraintHandler c => Solver -> c -> IO (Clause, Level)
-analyzeConflict solver constr = do
-  d <- readIORef (svLevel solver)
-
-  let split :: [Lit] -> IO (LitSet, LitSet)
-      split = go (IS.empty, IS.empty)
-        where
-          go (xs,ys) [] = return (xs,ys)
-          go (xs,ys) (l:ls) = do
-            lv <- litLevel solver l
-            if lv == levelRoot then
-              go (xs,ys) ls
-            else if lv >= d then
-              go (IS.insert l xs, ys) ls
-            else
-              go (xs, IS.insert l ys) ls
-
-  let loop :: LitSet -> LitSet -> IO LitSet
-      loop lits1 lits2
-        | sz==1 = do
-            return $ lits1 `IS.union` lits2
-        | sz>=2 = do
-            l <- popTrail solver
-            if litNot l `IS.notMember` lits1 then do
-              unassign solver (litVar l)
-              loop lits1 lits2
-            else do
-              m <- varReason solver (litVar l)
-              case m of
-                Nothing -> error "analyzeConflict: should not happen"
-                Just constr2 -> do
-                  constrBumpActivity solver constr2
-                  xs <- reasonOf solver constr2 (Just l)
-                  forM_ xs $ \lit -> varBumpActivity solver (litVar lit)
-                  unassign solver (litVar l)
-                  (ys,zs) <- split xs
-                  loop (IS.delete (litNot l) lits1 `IS.union` ys)
-                       (lits2 `IS.union` zs)
-        | otherwise = error "analyzeConflict: should not happen: reason of current level is empty"
-        where
-          sz = IS.size lits1
-
-  constrBumpActivity solver constr
-  conflictClause <- reasonOf solver constr Nothing
-  forM_ conflictClause $ \lit -> varBumpActivity solver (litVar lit)
-  (ys,zs) <- split conflictClause
-  lits <- loop ys zs
-
-  lits2 <- minimizeConflictClause solver lits
-
-  xs <- liftM (sortBy (flip (comparing snd))) $
-    forM (IS.toList lits2) $ \l -> do
-      lv <- litLevel solver l
-      return (l,lv)
-
-  let level = case xs of
-                [] -> error "analyzeConflict: should not happen"
-                [_] -> levelRoot
-                _:(_,lv):_ -> lv
-  return (map fst xs, level)
-
--- { p } ∪ { pにfalseを割り当てる原因のassumption }
-analyzeFinal :: Solver -> Lit -> IO [Lit]
-analyzeFinal solver p = do
-  lits <- readIORef (svTrail solver)
-  let go :: [Lit] -> VarSet -> [Lit] -> IO [Lit]
-      go [] _ result = return result
-      go (l:ls) seen result = do
-        lv <- litLevel solver l
-        if lv == levelRoot then
-          return result
-        else if litVar l `IS.member` seen then do
-          r <- varReason solver (litVar l)
-          case r of
-            Nothing -> do
-              let seen' = IS.delete (litVar l) seen
-              go ls seen' (l : result)
-            Just constr  -> do
-              c <- reasonOf solver constr (Just l)
-              let seen' = IS.delete (litVar l) seen `IS.union` IS.fromList [litVar l2 | l2 <- c]
-              go ls seen' result
-        else
-          go ls seen result
-  go lits (IS.singleton (litVar p)) [p]
-
-analyzeConflictHybrid :: ConstraintHandler c => Solver -> c -> IO ((Clause, Level), (PBLinAtLeast, Level))
-analyzeConflictHybrid solver constr = do
-  d <- readIORef (svLevel solver)
-
-  let split :: [Lit] -> IO (LitSet, LitSet)
-      split = go (IS.empty, IS.empty)
-        where
-          go (xs,ys) [] = return (xs,ys)
-          go (xs,ys) (l:ls) = do
-            lv <- litLevel solver l
-            if lv == levelRoot then
-              go (xs,ys) ls
-            else if lv >= d then
-              go (IS.insert l xs, ys) ls
-            else
-              go (xs, IS.insert l ys) ls
-
-  let loop :: LitSet -> LitSet -> PBLinAtLeast -> IO (LitSet, PBLinAtLeast)
-      loop lits1 lits2 pb
-        | sz==1 = do
-            return $ (lits1 `IS.union` lits2, pb)
-        | sz>=2 = do
-            l <- popTrail solver
-            m <- varReason solver (litVar l)
-            case m of
-              Nothing -> error "analyzeConflictHybrid: should not happen"
-              Just constr2 -> do
-                xs <- reasonOf solver constr2 (Just l)
-                (lits1',lits2') <-
-                  if litNot l `IS.notMember` lits1 then
-                    return (lits1,lits2)
-                  else do
-                    constrBumpActivity solver constr2
-                    forM_ xs $ \lit -> varBumpActivity solver (litVar lit)
-                    (ys,zs) <- split xs
-                    return  (IS.delete (litNot l) lits1 `IS.union` ys, lits2 `IS.union` zs)
-
-                pb' <- if any (\(_,l2) -> litNot l == l2) (fst pb)
-                       then do
-                         pb2 <- do
-                           b <- isPBRepresentable constr2
-                           if not b then do
-                             return $ clauseToPBLinAtLeast (l:xs)
-                           else do
-                             pb2 <- toPBLinAtLeast constr2
-                             o <- pbOverSAT solver pb2
-                             if o then
-                               return $ clauseToPBLinAtLeast (l:xs)
-                             else
-                               return pb2
-                         return $ cutResolve pb pb2 (litVar l)
-                       else return pb
-
-                unassign solver (litVar l)
-                loop lits1' lits2' pb'
-
-        | otherwise = error "analyzeConflictHybrid: should not happen: reason of current level is empty"
-        where
-          sz = IS.size lits1
-
-  constrBumpActivity solver constr
-  conflictClause <- reasonOf solver constr Nothing
-  pbConfl <- do
-    b <- isPBRepresentable constr
-    if b then
-      toPBLinAtLeast constr
-    else
-      return (clauseToPBLinAtLeast conflictClause)
-  forM_ conflictClause $ \lit -> varBumpActivity solver (litVar lit)
-  (ys,zs) <- split conflictClause
-  (lits, pb) <- loop ys zs pbConfl
-
-  lits2 <- minimizeConflictClause solver lits
-
-  xs <- liftM (sortBy (flip (comparing snd))) $
-    forM (IS.toList lits2) $ \l -> do
-      lv <- litLevel solver l
-      return (l,lv)
-
-  let level = case xs of
-                [] -> error "analyzeConflict: should not happen"
-                [_] -> levelRoot
-                _:(_,lv):_ -> lv
-  pblevel <- pbBacktrackLevel solver pb
-  return ((map fst xs, level), (pb, pblevel))
-
-pbBacktrackLevel :: Solver -> PBLinAtLeast -> IO Level
-pbBacktrackLevel _ ([], rhs) = assert (rhs > 0) $ return levelRoot
-pbBacktrackLevel solver (lhs, rhs) = do
-  levelToLiterals <- liftM (IM.unionsWith IM.union) $ forM lhs $ \(_,lit) -> do
-    val <- litValue solver lit
-    if val /= lUndef then do
-      level <- litLevel solver lit
-      return $ IM.singleton level (IM.singleton lit val)
-    else
-      return $ IM.empty
-
-  let replay [] _ _ = error "pbBacktrackLevel: should not happen"
-      replay ((lv,lv_lits) : lvs) lhs slack = do
-        let slack_lv = slack - sum [c | (c,lit) <- lhs, IM.lookup lit lv_lits == Just lFalse]
-            lhs_lv   = [tm | tm@(_,lit) <- lhs, IM.notMember lit lv_lits]
-        if slack_lv < 0 then
-          return lv -- CONFLICT
-        else if any (\(c,_) -> c > slack_lv) lhs_lv then
-          return lv -- UNIT
-        else
-          replay lvs lhs_lv slack_lv
-
-  let initial_slack = sum [c | (c,_) <- lhs] - rhs
-  replay (IM.toList levelToLiterals) lhs initial_slack
-
-minimizeConflictClause :: Solver -> LitSet -> IO LitSet
-minimizeConflictClause solver lits = do
-  ccmin <- readIORef (svCCMin solver)
-  if ccmin >= 2 then
-    minimizeConflictClauseRecursive solver lits
-  else if ccmin >= 1 then
-    minimizeConflictClauseLocal solver lits
-  else
-    return lits
-
-minimizeConflictClauseLocal :: Solver -> LitSet -> IO LitSet
-minimizeConflictClauseLocal solver lits = do
-  let xs = IS.toAscList lits
-  ys <- filterM (liftM not . isRedundant) xs
-  when debugMode $ do
-    log solver "minimizeConflictClauseLocal:"
-    log solver $ show xs
-    log solver $ show ys
-  return $ IS.fromAscList $ ys
-
-  where
-    isRedundant :: Lit -> IO Bool
-    isRedundant lit = do
-      c <- varReason solver (litVar lit)
-      case c of
-        Nothing -> return False
-        Just c2 -> do
-          ls <- reasonOf solver c2 (Just (litNot lit))
-          allM test ls
-
-    test :: Lit -> IO Bool
-    test lit = do
-      lv <- litLevel solver lit
-      return $ lv == levelRoot || lit `IS.member` lits
-
-minimizeConflictClauseRecursive :: Solver -> LitSet -> IO LitSet
-minimizeConflictClauseRecursive solver lits = do
-  let
-    isRedundant :: Lit -> IO Bool
-    isRedundant lit = do
-      c <- varReason solver (litVar lit)
-      case c of
-        Nothing -> return False
-        Just c2 -> do
-          ls <- reasonOf solver c2 (Just (litNot lit))
-          go ls IS.empty
-
-    go :: [Lit] -> IS.IntSet -> IO Bool
-    go [] _ = return True
-    go (lit : ls) seen = do
-      lv <- litLevel solver lit
-      if lv == levelRoot || lit `IS.member` lits || lit `IS.member` seen then
-        go ls seen
-      else do
-        c <- varReason solver (litVar lit)
-        case c of
-          Nothing -> return False
-          Just c2 -> do
-            ls2 <- reasonOf solver c2 (Just (litNot lit))
-            go (ls2 ++ ls) (IS.insert lit seen)
-
-  let xs = IS.toAscList lits
-  ys <- filterM (liftM not . isRedundant) xs
-  when debugMode $ do
-    log solver "minimizeConflictClauseRecursive:"
-    log solver $ show xs
-    log solver $ show ys
-  return $ IS.fromAscList $ ys
-
-popTrail :: Solver -> IO Lit
-popTrail solver = do
-  m <- readIORef (svTrail solver)
-  case m of
-    []   -> error "ToySolver.SAT.popTrail: empty trail"
-    l:ls -> do
-      writeIORef (svTrail solver) ls
-      return l
-
--- | Revert to the state at given level
--- (keeping all assignment at @level@ but not beyond).
-backtrackTo :: Solver -> Int -> IO ()
-backtrackTo solver level = do
-  when debugMode $ log solver $ printf "backtrackTo: %d" level
-  writeIORef (svTrail solver) =<< loop =<< readIORef (svTrail solver)
-  SQ.clear (svBCPQueue solver)
-  writeIORef (svLevel solver) level
-  where
-    loop :: [Lit] -> IO [Lit]
-    loop [] = return []
-    loop lls@(l:ls) = do
-      lv <- litLevel solver l
-      if lv <= level
-        then return lls
-        else unassign solver (litVar l) >> loop ls
-
-constructModel :: Solver -> IO ()
-constructModel solver = do
-  n <- nVars solver
-  (marr::IOUArray Var Bool) <- newArray_ (1,n)
-  forLoop 1 (<=n) (+1) $ \v -> do
-    vd <- varData solver v
-    a <- readIORef (vdAssignment vd)
-    writeArray marr v (aValue (fromJust a))
-  m <- unsafeFreeze marr
-  writeIORef (svModel solver) (Just m)
-
-constrDecayActivity :: Solver -> IO ()
-constrDecayActivity solver = do
-  d <- readIORef (svConstrDecay solver)
-  modifyIORef' (svConstrInc solver) (d*)
-
-constrBumpActivity :: ConstraintHandler a => Solver -> a -> IO ()
-constrBumpActivity solver this = do
-  aval <- constrReadActivity this
-  when (aval >= 0) $ do -- learnt clause
-    inc <- readIORef (svConstrInc solver)
-    let aval2 = aval+inc
-    constrWriteActivity this $! aval2
-    when (aval2 > 1e20) $
-      -- Rescale
-      constrRescaleAllActivity solver
-
-constrRescaleAllActivity :: Solver -> IO ()
-constrRescaleAllActivity solver = do
-  xs <- learntConstraints solver
-  forM_ xs $ \c -> do
-    aval <- constrReadActivity c
-    when (aval >= 0) $
-      constrWriteActivity c $! (aval * 1e-20)
-  modifyIORef' (svConstrInc solver) (* 1e-20)
-
-resetStat :: Solver -> IO ()
-resetStat solver = do
-  writeIORef (svNDecision solver) 0
-  writeIORef (svNRandomDecision solver) 0
-  writeIORef (svNConflict solver) 0
-  writeIORef (svNRestart solver) 0
-  writeIORef (svNLearntGC  solver) 0
-
-printStatHeader :: Solver -> IO ()
-printStatHeader solver = do
-  log solver $ "============================[ Search Statistics ]============================"
-  log solver $ " Time | Restart | Decision | Conflict |      LEARNT     | Fixed    | Removed "
-  log solver $ "      |         |          |          |    Limit     GC | Var      | Constra "
-  log solver $ "============================================================================="
-
-printStat :: Solver -> Bool -> IO ()
-printStat solver force = do
-  nowWC <- getCurrentTime
-  b <- if force
-       then return True
-       else do
-         lastWC <- readIORef (svLastStatWC solver)
-         return $ (nowWC `diffUTCTime` lastWC) > 1
-  when b $ do
-    startWC   <- readIORef (svStartWC solver)
-    let tm = showTimeDiff $ nowWC `diffUTCTime` startWC
-    restart   <- readIORef (svNRestart solver)
-    dec       <- readIORef (svNDecision solver)
-    conflict  <- readIORef (svNConflict solver)
-    learntLim <- readIORef (svLearntLim solver)
-    learntGC  <- readIORef (svNLearntGC solver)
-    fixed     <- readIORef (svNFixed solver)
-    removed   <- readIORef (svNRemovedConstr solver)
-    log solver $ printf "%s | %7d | %8d | %8d | %8d %6d | %8d | %8d"
-      tm restart dec conflict learntLim learntGC fixed removed
-    writeIORef (svLastStatWC solver) nowWC
-
-showTimeDiff :: NominalDiffTime -> String
-showTimeDiff sec
-  | si <  100  = printf "%4.1fs" (fromRational s :: Double)
-  | si <= 9999 = printf "%4ds" si
-  | mi <  100  = printf "%4.1fm" (fromRational m :: Double)
-  | mi <= 9999 = printf "%4dm" mi
-  | hi <  100  = printf "%4.1fs" (fromRational h :: Double)
-  | otherwise  = printf "%4dh" hi
-  where
-    s :: Rational
-    s = realToFrac sec
-
-    si :: Integer
-    si = round s
-
-    m :: Rational
-    m = s / 60
-
-    mi :: Integer
-    mi = round m
-
-    h :: Rational
-    h = m / 60
-
-    hi :: Integer
-    hi = round h
-
-{--------------------------------------------------------------------
-  constraint implementation
---------------------------------------------------------------------}
-
-class (Eq a, Hashable a) => ConstraintHandler a where
-  toConstraintHandler :: a -> SomeConstraintHandler
-
-  showConstraintHandler :: a -> IO String
-
-  attach :: Solver -> a -> IO Bool
-
-  watchedLiterals :: Solver -> a -> IO [Lit]
-
-  watchedVariables :: Solver -> a -> IO [Var]
-
-  -- | invoked with the watched literal when the literal is falsified.
-  -- 'watch' で 'toConstraint' を呼び出して heap allocation が発生するのを
-  -- 避けるために、元の 'SomeConstraintHandler' も渡しておく。
-  basicPropagate :: Solver -> SomeConstraintHandler -> a -> Lit -> IO Bool
-
-  -- | deduce a clause C∨l from the constraint and return C.
-  -- C and l should be false and true respectively under the current
-  -- assignment.
-  basicReasonOf :: Solver -> a -> Maybe Lit -> IO Clause
-
-  isPBRepresentable :: a -> IO Bool
-  toPBLinAtLeast :: a -> IO PBLinAtLeast
-
-  isSatisfied :: Solver -> a -> IO Bool
-
-  constrIsProtected :: Solver -> a -> IO Bool
-  constrIsProtected _ _ = return False
-
-  constrWeight :: Solver -> a -> IO Double
-  constrWeight _ _ = return 1.0
-
-  constrReadActivity :: a -> IO Double
-
-  constrWriteActivity :: a -> Double -> IO ()
-
-detach :: Solver -> SomeConstraintHandler -> IO ()
-detach solver c = do
-  lits <- watchedLiterals solver c
-  forM_ lits $ \lit -> do
-    ld <- litData solver lit
-    modifyIORef' (ldWatches ld) (delete c)
-  vs <- watchedVariables solver c
-  forM_ vs $ \v -> do
-    vd <- varData solver v
-    modifyIORef' (vdWatches vd) (delete c)
-
-  b <- isPBRepresentable c
-  when b $ do
-    (lhs,_) <- toPBLinAtLeast c
-    forM_ lhs $ \(_,lit) -> do
-      ld <- litData solver lit
-      modifyIORef' (ldOccurList ld) (HashSet.delete c)
-
--- | invoked with the watched literal when the literal is falsified.
-propagate :: Solver -> SomeConstraintHandler -> Lit -> IO Bool
-propagate solver c l = basicPropagate solver c c l
-
--- | deduce a clause C∨l from the constraint and return C.
--- C and l should be false and true respectively under the current
--- assignment.
-reasonOf :: ConstraintHandler a => Solver -> a -> Maybe Lit -> IO Clause
-reasonOf solver c x = do
-  when debugMode $
-    case x of
-      Nothing -> return ()
-      Just lit -> do
-        val <- litValue solver lit
-        unless (lTrue == val) $ do
-          str <- showConstraintHandler c
-          error (printf "reasonOf: value of literal %d should be True but %s (basicReasonOf %s %s)" lit (show val) str (show x))
-  cl <- basicReasonOf solver c x
-  when debugMode $ do
-    forM_ cl $ \lit -> do
-      val <- litValue solver lit
-      unless (lFalse == val) $ do
-        str <- showConstraintHandler c
-        error (printf "reasonOf: value of literal %d should be False but %s (basicReasonOf %s %s)" lit (show val) str (show x))
-  return cl
-
-isLocked :: Solver -> SomeConstraintHandler -> IO Bool
-isLocked solver c = do
-    b1 <- anyM p1 =<< watchedLiterals solver c
-    b2 <- anyM p2 =<< watchedVariables solver c
-    return $ b1 || b2
-  where
-    p1 :: Lit -> IO Bool
-    p1 lit = do
-      val <- litValue solver lit
-      if val /= lTrue then return False
-      else do
-        m <- varReason solver (litVar lit)
-        case m of
-          Nothing -> return False
-          Just c2 -> return $! c == c2
-    p2 :: Var -> IO Bool
-    p2 var = do
-      val <- varValue solver var
-      if val == lUndef then return False
-      else do
-        m <- varReason solver var
-        case m of
-          Nothing -> return False
-          Just c2 -> return $! c == c2
-
-data SomeConstraintHandler
-  = CHClause !ClauseHandler
-  | CHAtLeast !AtLeastHandler
-  | CHPBCounter !PBHandlerCounter
-  | CHPBPueblo !PBHandlerPueblo
-  | CHXORClause !XORClauseHandler
-  deriving Eq
-
-instance Hashable SomeConstraintHandler where
-  hashWithSalt s (CHClause c)    = s `hashWithSalt` (0::Int) `hashWithSalt` c
-  hashWithSalt s (CHAtLeast c)   = s `hashWithSalt` (1::Int) `hashWithSalt` c
-  hashWithSalt s (CHPBCounter c) = s `hashWithSalt` (2::Int) `hashWithSalt` c
-  hashWithSalt s (CHPBPueblo c)  = s `hashWithSalt` (3::Int) `hashWithSalt` c
-  hashWithSalt s (CHXORClause c) = s `hashWithSalt` (4::Int) `hashWithSalt` c
-
-instance ConstraintHandler SomeConstraintHandler where
-  toConstraintHandler = id
-
-  showConstraintHandler (CHClause c)    = showConstraintHandler c
-  showConstraintHandler (CHAtLeast c)   = showConstraintHandler c
-  showConstraintHandler (CHPBCounter c) = showConstraintHandler c
-  showConstraintHandler (CHPBPueblo c)  = showConstraintHandler c
-  showConstraintHandler (CHXORClause c) = showConstraintHandler c
-
-  attach solver (CHClause c)    = attach solver c
-  attach solver (CHAtLeast c)   = attach solver c
-  attach solver (CHPBCounter c) = attach solver c
-  attach solver (CHPBPueblo c)  = attach solver c
-  attach solver (CHXORClause c) = attach solver c
-
-  watchedLiterals solver (CHClause c)    = watchedLiterals solver c
-  watchedLiterals solver (CHAtLeast c)   = watchedLiterals solver c
-  watchedLiterals solver (CHPBCounter c) = watchedLiterals solver c
-  watchedLiterals solver (CHPBPueblo c)  = watchedLiterals solver c
-  watchedLiterals solver (CHXORClause c) = watchedLiterals solver c
-
-  watchedVariables solver (CHClause c)    = watchedVariables solver c
-  watchedVariables solver (CHAtLeast c)   = watchedVariables solver c
-  watchedVariables solver (CHPBCounter c) = watchedVariables solver c
-  watchedVariables solver (CHPBPueblo c)  = watchedVariables solver c
-  watchedVariables solver (CHXORClause c) = watchedVariables solver c
-
-  basicPropagate solver this (CHClause c)  lit   = basicPropagate solver this c lit
-  basicPropagate solver this (CHAtLeast c) lit   = basicPropagate solver this c lit
-  basicPropagate solver this (CHPBCounter c) lit = basicPropagate solver this c lit
-  basicPropagate solver this (CHPBPueblo c) lit  = basicPropagate solver this c lit
-  basicPropagate solver this (CHXORClause c) lit = basicPropagate solver this c lit
-
-  basicReasonOf solver (CHClause c)  l   = basicReasonOf solver c l
-  basicReasonOf solver (CHAtLeast c) l   = basicReasonOf solver c l
-  basicReasonOf solver (CHPBCounter c) l = basicReasonOf solver c l
-  basicReasonOf solver (CHPBPueblo c) l  = basicReasonOf solver c l
-  basicReasonOf solver (CHXORClause c) l = basicReasonOf solver c l
-
-  isPBRepresentable (CHClause c)    = isPBRepresentable c
-  isPBRepresentable (CHAtLeast c)   = isPBRepresentable c
-  isPBRepresentable (CHPBCounter c) = isPBRepresentable c
-  isPBRepresentable (CHPBPueblo c)  = isPBRepresentable c
-  isPBRepresentable (CHXORClause c) = isPBRepresentable c
-
-  toPBLinAtLeast (CHClause c)    = toPBLinAtLeast c
-  toPBLinAtLeast (CHAtLeast c)   = toPBLinAtLeast c
-  toPBLinAtLeast (CHPBCounter c) = toPBLinAtLeast c
-  toPBLinAtLeast (CHPBPueblo c)  = toPBLinAtLeast c
-  toPBLinAtLeast (CHXORClause c) = toPBLinAtLeast c
-
-  isSatisfied solver (CHClause c)    = isSatisfied solver c
-  isSatisfied solver (CHAtLeast c)   = isSatisfied solver c
-  isSatisfied solver (CHPBCounter c) = isSatisfied solver c
-  isSatisfied solver (CHPBPueblo c)  = isSatisfied solver c
-  isSatisfied solver (CHXORClause c) = isSatisfied solver c
-
-  constrIsProtected solver (CHClause c)    = constrIsProtected solver c
-  constrIsProtected solver (CHAtLeast c)   = constrIsProtected solver c
-  constrIsProtected solver (CHPBCounter c) = constrIsProtected solver c
-  constrIsProtected solver (CHPBPueblo c)  = constrIsProtected solver c
-  constrIsProtected solver (CHXORClause c) = constrIsProtected solver c
-
-  constrReadActivity (CHClause c)    = constrReadActivity c
-  constrReadActivity (CHAtLeast c)   = constrReadActivity c
-  constrReadActivity (CHPBCounter c) = constrReadActivity c
-  constrReadActivity (CHPBPueblo c)  = constrReadActivity c
-  constrReadActivity (CHXORClause c) = constrReadActivity c
-
-  constrWriteActivity (CHClause c)    aval = constrWriteActivity c aval
-  constrWriteActivity (CHAtLeast c)   aval = constrWriteActivity c aval
-  constrWriteActivity (CHPBCounter c) aval = constrWriteActivity c aval
-  constrWriteActivity (CHPBPueblo c)  aval = constrWriteActivity c aval
-  constrWriteActivity (CHXORClause c) aval = constrWriteActivity c aval
-
--- To avoid heap-allocation Maybe value, it returns -1 when not found.
-findForWatch :: Solver -> IOUArray Int Lit -> Int -> Int -> IO Int
-#ifndef __GLASGOW_HASKELL__
-findForWatch solver a beg end = go beg end
-  where
-    go :: Int -> Int -> IO Int
-    go i end | i > end = return (-1)
-    go i end = do
-      val <- litValue s =<< unsafeRead a i
-      if val /= lFalse
-        then return i
-        else go (i+1) end
-#else
-{- We performed worker-wrapper transfomation manually, since the worker
-   generated by GHC has type
-   "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)",
-   not "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)".
-   We want latter one to avoid heap-allocating Int value. -}
-findForWatch solver a (I# beg) (I# end) = IO $ \w ->
-  case go# beg end w of
-    (# w2, ret #) -> (# w2, I# ret #)
-  where
-    go# :: Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
-#if __GLASGOW_HASKELL__ < 708
-    go# i end w | i ># end = (# w, -1# #)
-#else
-    go# i end w | isTrue# (i ># end) = (# w, -1# #)
-#endif
-    go# i end w =
-      case unIO (litValue solver =<< unsafeRead a (I# i)) w of
-        (# w2, val #) ->
-          if val /= lFalse
-            then (# w2, i #)
-            else go# (i +# 1#) end w2
-
-    unIO (IO f) = f
-#endif
-
--- To avoid heap-allocating Maybe value, it returns -1 when not found.
-findForWatch2 :: Solver -> IOUArray Int Lit -> Int -> Int -> IO Int
-#ifndef __GLASGOW_HASKELL__
-findForWatch2 solver a beg end = go beg end
-  where
-    go :: Int -> Int -> IO Int
-    go i end | i > end = return (-1)
-    go i end = do
-      val <- litValue s =<< unsafeRead a i
-      if val == lUndef
-        then return i
-        else go (i+1) end
-#else
-{- We performed worker-wrapper transfomation manually, since the worker
-   generated by GHC has type
-   "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)",
-   not "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)".
-   We want latter one to avoid heap-allocating Int value. -}
-findForWatch2 solver a (I# beg) (I# end) = IO $ \w ->
-  case go# beg end w of
-    (# w2, ret #) -> (# w2, I# ret #)
-  where
-    go# :: Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
-#if __GLASGOW_HASKELL__ < 708
-    go# i end w | i ># end = (# w, -1# #)
-#else
-    go# i end w | isTrue# (i ># end) = (# w, -1# #)
-#endif
-    go# i end w =
-      case unIO (litValue solver =<< unsafeRead a (I# i)) w of
-        (# w2, val #) ->
-          if val == lUndef
-            then (# w2, i #)
-            else go# (i +# 1#) end w2
-
-    unIO (IO f) = f
-#endif
-
-{--------------------------------------------------------------------
-  Clause
---------------------------------------------------------------------}
-
-data ClauseHandler
-  = ClauseHandler
-  { claLits :: !(IOUArray Int Lit)
-  , claActivity :: !(IORef Double)
-  , claHash :: !Int
-  }
-
-instance Eq ClauseHandler where
-  (==) = (==) `on` claLits
-
-instance Hashable ClauseHandler where
-  hash = claHash
-  hashWithSalt = defaultHashWithSalt
-
-newClauseHandler :: Clause -> Bool -> IO ClauseHandler
-newClauseHandler ls learnt = do
-  let size = length ls
-  a <- newListArray (0, size-1) ls
-  act <- newIORef $! (if learnt then 0 else -1)
-  return (ClauseHandler a act (hash ls))
-
-instance ConstraintHandler ClauseHandler where
-  toConstraintHandler = CHClause
-
-  showConstraintHandler this = do
-    lits <- getElems (claLits this)
-    return (show lits)
-
-  attach solver this = do
-    -- BCP Queue should be empty at this point.
-    -- If not, duplicated propagation happens.
-    bcpCheckEmpty solver
-
-    (lb,ub) <- getBounds (claLits this)
-    assert (lb == 0) $ return ()
-    let size = ub-lb+1
-
-    if size == 0 then do
-      markBad solver
-      return False
-    else if size == 1 then do
-      lit0 <- unsafeRead (claLits this) 0
-      assignBy solver lit0 this
-    else do
-      ref <- newIORef 1
-      let f i = do
-            lit_i <- unsafeRead (claLits this) i
-            val_i <- litValue solver lit_i
-            if val_i /= lFalse then
-              return True
-            else do
-              j <- readIORef ref
-              k <- findForWatch solver (claLits this) j ub
-              case k of
-                -1 -> do
-                  return False
-                _ -> do
-                  lit_k <- unsafeRead (claLits this) k
-                  unsafeWrite (claLits this) i lit_k
-                  unsafeWrite (claLits this) k lit_i
-                  writeIORef ref $! (k+1)
-                  return True
-
-      b <- f 0
-      if b then do
-        lit0 <- unsafeRead (claLits this) 0
-        watchLit solver lit0 this
-        b2 <- f 1
-        if b2 then do
-          lit1 <- unsafeRead (claLits this) 1
-          watchLit solver lit1 this
-          return True
-        else do -- UNIT
-          -- We need to watch the most recently falsified literal
-          (i,_) <- liftM (maximumBy (comparing snd)) $ forM [1..ub] $ \l -> do
-            lit <- unsafeRead (claLits this) l
-            lv <- litLevel solver lit
-            return (l,lv)
-          lit1 <- unsafeRead (claLits this) 1
-          liti <- unsafeRead (claLits this) i
-          unsafeWrite (claLits this) 1 liti
-          unsafeWrite (claLits this) i lit1
-          watchLit solver liti this
-          assignBy solver lit0 this -- should always succeed
-      else do -- CONFLICT
-        ls <- liftM (map fst . sortBy (flip (comparing snd))) $ forM [lb..ub] $ \l -> do
-          lit <- unsafeRead (claLits this) l
-          lv <- litLevel solver lit
-          return (l,lv)
-        forM_ (zip [0..] ls) $ \(i,lit) -> do
-          unsafeWrite (claLits this) i lit
-        lit0 <- unsafeRead (claLits this) 0
-        lit1 <- unsafeRead (claLits this) 1
-        watchLit solver lit0 this
-        watchLit solver lit1 this
-        return False
-
-  watchedLiterals _ this = do
-    lits <- getElems (claLits this)
-    case lits of
-      l1:l2:_ -> return [l1, l2]
-      _ -> return []
-
-  watchedVariables _ _ = return []
-
-  basicPropagate !solver this this2 !falsifiedLit = do
-    preprocess
-
-    !lit0 <- unsafeRead a 0
-    !val0 <- litValue solver lit0
-    if val0 == lTrue then do
-      watchLit solver falsifiedLit this
-      return True
-    else do
-      (!lb,!ub) <- getBounds a
-      assert (lb==0) $ return ()
-      i <- findForWatch solver a 2 ub
-      case i of
-        -1 -> do
-          when debugMode $ logIO solver $ do
-             str <- showConstraintHandler this
-             return $ printf "basicPropagate: %s is unit" str
-          watchLit solver falsifiedLit this
-          assignBy solver lit0 this
-        _  -> do
-          !lit1 <- unsafeRead a 1
-          !liti <- unsafeRead a i
-          unsafeWrite a 1 liti
-          unsafeWrite a i lit1
-          watchLit solver liti this
-          return True
-
-    where
-      a = claLits this2
-
-      preprocess :: IO ()
-      preprocess = do
-        !l0 <- unsafeRead a 0
-        !l1 <- unsafeRead a 1
-        assert (l0==falsifiedLit || l1==falsifiedLit) $ return ()
-        when (l0==falsifiedLit) $ do
-          unsafeWrite a 0 l1
-          unsafeWrite a 1 l0
-
-  basicReasonOf _ this l = do
-    lits <- getElems (claLits this)
-    case l of
-      Nothing -> return lits
-      Just lit -> do
-        assert (lit == head lits) $ return ()
-        return $ tail lits
-
-  isPBRepresentable _ = return True
-
-  toPBLinAtLeast this = do
-    lits <- getElems (claLits this)
-    return ([(1,l) | l <- lits], 1)
-
-  isSatisfied solver this = do
-    lits <- getElems (claLits this)
-    vals <- mapM (litValue solver) lits
-    return $ lTrue `elem` vals
-
-  constrIsProtected _ this = do
-    size <- liftM rangeSize (getBounds (claLits this))
-    return $! size <= 2
-
-  constrReadActivity this = readIORef (claActivity this)
-
-  constrWriteActivity this aval = writeIORef (claActivity this) $! aval
-
-instantiateClause :: Solver -> Clause -> IO (Maybe Clause)
-instantiateClause solver = loop []
-  where
-    loop :: [Lit] -> [Lit] -> IO (Maybe Clause)
-    loop ret [] = return $ Just ret
-    loop ret (l:ls) = do
-      val <- litValue solver l
-      if val==lTrue then
-        return Nothing
-      else if val==lFalse then
-        loop ret ls
-      else
-        loop (l : ret) ls
-
-basicAttachClauseHandler :: Solver -> ClauseHandler -> IO Bool
-basicAttachClauseHandler solver this = do
-  lits <- getElems (claLits this)
-  case lits of
-    [] -> do
-      markBad solver
-      return False
-    [l1] -> do
-      assignBy solver l1 this
-    l1:l2:_ -> do
-      watchLit solver l1 this
-      watchLit solver l2 this
-      return True
-
-{--------------------------------------------------------------------
-  Cardinality Constraint
---------------------------------------------------------------------}
-
-data AtLeastHandler
-  = AtLeastHandler
-  { atLeastLits :: IOUArray Int Lit
-  , atLeastNum :: !Int
-  , atLeastActivity :: !(IORef Double)
-  , atLeastHash :: !Int
-  }
-
-instance Eq AtLeastHandler where
-  (==) = (==) `on` atLeastLits
-
-instance Hashable AtLeastHandler where
-  hash = atLeastHash
-  hashWithSalt = defaultHashWithSalt
-
-newAtLeastHandler :: [Lit] -> Int -> Bool -> IO AtLeastHandler
-newAtLeastHandler ls n learnt = do
-  let size = length ls
-  a <- newListArray (0, size-1) ls
-  act <- newIORef $! (if learnt then 0 else -1)
-  return (AtLeastHandler a n act (hash (ls,n)))
-
-instance ConstraintHandler AtLeastHandler where
-  toConstraintHandler = CHAtLeast
-
-  showConstraintHandler this = do
-    lits <- getElems (atLeastLits this)
-    return $ show lits ++ " >= " ++ show (atLeastNum this)
-
-  -- FIXME: simplify implementation
-  attach solver this = do
-    -- BCP Queue should be empty at this point.
-    -- If not, duplicated propagation happens.
-    bcpCheckEmpty solver
-
-    let a = atLeastLits this
-    (lb,ub) <- getBounds a
-    assert (lb == 0) $ return ()
-    let m = ub - lb + 1
-        n = atLeastNum this
-
-    if m < n then do
-      markBad solver
-      return False
-    else if m == n then do
-      let f i = do
-            lit <- unsafeRead a i
-            assignBy solver lit this
-      allM f [0..n-1]
-    else do -- m > n
-      let f !i !j
-            | i == n = do
-                -- NOT VIOLATED: n literals (0 .. n-1) are watched
-                k <- findForWatch solver a j ub
-                if k /= -1 then do
-                  -- NOT UNIT
-                  lit_n <- unsafeRead a n
-                  lit_k <- unsafeRead a k
-                  unsafeWrite a n lit_k
-                  unsafeWrite a k lit_n
-                  watchLit solver lit_k this
-                  -- n+1 literals (0 .. n) are watched.
-                else do
-                  -- UNIT
-                  forLoop 0 (<n) (+1) $ \l -> do
-                    lit <- unsafeRead a l
-                    _ <- assignBy solver lit this -- should always succeed
-                    return ()
-                  -- We need to watch the most recently falsified literal
-                  (l,_) <- liftM (maximumBy (comparing snd)) $ forM [n..ub] $ \l -> do
-                    lit <- unsafeRead a l
-                    lv <- litLevel solver lit
-                    when debugMode $ do
-                      val <- litValue solver lit
-                      unless (val == lFalse) $ error "AtLeastHandler.attach: should not happen"
-                    return (l,lv)
-                  lit_n <- unsafeRead a n
-                  lit_l <- unsafeRead a l
-                  unsafeWrite a n lit_l
-                  unsafeWrite a l lit_n
-                  watchLit solver lit_l this
-                  -- n+1 literals (0 .. n) are watched.
-                return True
-            | otherwise = do
-                assert (i < n && n <= j) $ return ()
-                lit_i <- unsafeRead a i
-                val_i <- litValue solver lit_i
-                if val_i /= lFalse then do
-                  watchLit solver lit_i this
-                  f (i+1) j
-                else do
-                  k <- findForWatch solver a j ub
-                  if k /= -1 then do
-                    lit_k <- unsafeRead a k
-                    unsafeWrite a i lit_k
-                    unsafeWrite a k lit_i
-                    watchLit solver lit_k this
-                    f (i+1) (k+1)
-                  else do
-                    -- CONFLICT
-                    -- We need to watch unassigned literals or most recently falsified literals.
-                    do xs <- liftM (sortBy (flip (comparing snd))) $ forM [i..ub] $ \l -> do
-                         lit <- readArray a l
-                         val <- litValue solver lit
-                         if val == lFalse then do
-                           lv <- litLevel solver lit
-                           return (lit, lv)
-                         else do
-                           return (lit, maxBound)
-                       forM_ (zip [i..ub] xs) $ \(l,(lit,_lv)) -> do
-                         writeArray a l lit
-                    forLoop i (<=n) (+1) $ \l -> do
-                      lit_l <- readArray a l
-                      watchLit solver lit_l this
-                    -- n+1 literals (0 .. n) are watched.
-                    return False
-      f 0 n
-
-  watchedLiterals _ this = do
-    lits <- getElems (atLeastLits this)
-    let n = atLeastNum this
-    let ws = if length lits > n then take (n+1) lits else []
-    return ws
-
-  watchedVariables _ _ = return []
-
-  basicPropagate solver this this2 falsifiedLit = do
-    preprocess
-
-    when debugMode $ do
-      litn <- readArray a n
-      unless (litn == falsifiedLit) $ error "AtLeastHandler.basicPropagate: should not happen"
-
-    (lb,ub) <- getBounds a
-    assert (lb==0) $ return ()
-    i <- findForWatch solver a (n+1) ub
-    case i of
-      -1 -> do
-        when debugMode $ logIO solver $ do
-          str <- showConstraintHandler this
-          return $ printf "basicPropagate: %s is unit" str
-        watchLit solver falsifiedLit this
-        let loop :: Int -> IO Bool
-            loop i
-              | i >= n = return True
-              | otherwise = do
-                  liti <- unsafeRead a i
-                  ret2 <- assignBy solver liti this
-                  if ret2
-                    then loop (i+1)
-                    else return False
-        loop 0
-      _ -> do
-        liti <- unsafeRead a i
-        litn <- unsafeRead a n
-        unsafeWrite a i litn
-        unsafeWrite a n liti
-        watchLit solver liti this
-        return True
-
-    where
-      a = atLeastLits this2
-      n = atLeastNum this2
-
-      preprocess :: IO ()
-      preprocess = loop 0
-        where
-          loop :: Int -> IO ()
-          loop i
-            | i >= n = return ()
-            | otherwise = do
-              li <- unsafeRead a i
-              if (li /= falsifiedLit) then
-                loop (i+1)
-              else do
-                ln <- unsafeRead a n
-                unsafeWrite a n li
-                unsafeWrite a i ln
-
-  basicReasonOf solver this concl = do
-    (lb,ub) <- getBounds (atLeastLits this)
-    assert (lb==0) $ return ()
-    let n = atLeastNum this
-    falsifiedLits <- mapM (readArray (atLeastLits this)) [n..ub] -- drop first n elements
-    when debugMode $ do
-      forM_ falsifiedLits $ \lit -> do
-        val <- litValue solver lit
-        unless (val == lFalse) $ do
-          error $ printf "AtLeastHandler.basicReasonOf: %d is %s (lFalse expected)" lit (show val)
-    case concl of
-      Nothing -> do
-        let go :: Int -> IO Lit
-            go i
-              | i >= n = error $ printf "AtLeastHandler.basicReasonOf: cannot find falsified literal in first %d elements" n
-              | otherwise = do
-                  lit <- readArray (atLeastLits this) i
-                  val <- litValue solver lit
-                  if val == lFalse
-                  then return lit
-                  else go (i+1)
-        lit <- go lb
-        return $ lit : falsifiedLits
-      Just lit -> do
-        when debugMode $ do
-          es <- getElems (atLeastLits this)
-          unless (lit `elem` take n es) $
-            error $ printf "AtLeastHandler.basicReasonOf: cannot find %d in first %d elements" n
-        return falsifiedLits
-
-  isPBRepresentable _ = return True
-
-  toPBLinAtLeast this = do
-    lits <- getElems (atLeastLits this)
-    return ([(1,l) | l <- lits], fromIntegral (atLeastNum this))
-
-  isSatisfied solver this = do
-    lits <- getElems (atLeastLits this)
-    vals <- mapM (litValue solver) lits
-    return $ length [v | v <- vals, v == lTrue] >= atLeastNum this
-
-  constrReadActivity this = readIORef (atLeastActivity this)
-
-  constrWriteActivity this aval = writeIORef (atLeastActivity this) $! aval
-
-instantiateAtLeast :: Solver -> AtLeast -> IO AtLeast
-instantiateAtLeast solver (xs,n) = loop ([],n) xs
-  where
-    loop :: AtLeast -> [Lit] -> IO AtLeast
-    loop ret [] = return ret
-    loop (ys,m) (l:ls) = do
-      val <- litValue solver l
-      if val == lTrue then
-        loop (ys, m-1) ls
-      else if val == lFalse then
-        loop (ys, m) ls
-      else
-        loop (l:ys, m) ls
-
-basicAttachAtLeastHandler :: Solver -> AtLeastHandler -> IO Bool
-basicAttachAtLeastHandler solver this = do
-  lits <- getElems (atLeastLits this)
-  let m = length lits
-      n = atLeastNum this
-  if m < n then do
-    markBad solver
-    return False
-  else if m == n then do
-    allM (\l -> assignBy solver l this) lits
-  else do -- m > n
-    forM_ (take (n+1) lits) $ \l -> watchLit solver l this
-    return True
-
-{--------------------------------------------------------------------
-  Pseudo Boolean Constraint
---------------------------------------------------------------------}
-
-newPBHandler :: Solver -> PBLinSum -> Integer -> Bool -> IO SomeConstraintHandler
-newPBHandler solver ts degree learnt = do
-  config <- readIORef (svPBHandlerType solver)
-  case config of
-    PBHandlerTypeCounter -> do
-      c <- newPBHandlerCounter ts degree learnt
-      return (toConstraintHandler c)
-    PBHandlerTypePueblo -> do
-      c <- newPBHandlerPueblo ts degree learnt
-      return (toConstraintHandler c)
-
-newPBHandlerPromoted :: Solver -> PBLinSum -> Integer -> Bool -> IO SomeConstraintHandler
-newPBHandlerPromoted solver lhs rhs learnt = do
-  case pbToAtLeast (lhs,rhs) of
-    Nothing -> newPBHandler solver lhs rhs learnt
-    Just (lhs2, rhs2) -> do
-      if rhs2 /= 1 then do
-        h <- newAtLeastHandler lhs2 rhs2 learnt
-        return $ toConstraintHandler h
-      else do
-        h <- newClauseHandler lhs2 learnt
-        return $ toConstraintHandler h
-
-instantiatePB :: Solver -> PBLinAtLeast -> IO PBLinAtLeast
-instantiatePB solver (xs,n) = loop ([],n) xs
-  where
-    loop :: PBLinAtLeast -> PBLinSum -> IO PBLinAtLeast
-    loop ret [] = return ret
-    loop (ys,m) ((c,l):ts) = do
-      val <- litValue solver l
-      if val == lTrue then
-        loop (ys, m-c) ts
-      else if val == lFalse then
-        loop (ys, m) ts
-      else
-        loop ((c,l):ys, m) ts
-
-pbOverSAT :: Solver -> PBLinAtLeast -> IO Bool
-pbOverSAT solver (lhs, rhs) = do
-  ss <- forM lhs $ \(c,l) -> do
-    v <- litValue solver l
-    if v /= lFalse
-      then return c
-      else return 0
-  return $! sum ss > rhs
-
-pbToAtLeast :: PBLinAtLeast -> Maybe AtLeast
-pbToAtLeast (lhs, rhs) = do
-  let cs = [c | (c,_) <- lhs]
-  guard $ Set.size (Set.fromList cs) == 1
-  let c = head cs
-  return $ (map snd lhs, fromInteger ((rhs+c-1) `div` c))
-
-{--------------------------------------------------------------------
-  Pseudo Boolean Constraint (Counter)
---------------------------------------------------------------------}   
-
-data PBHandlerCounter
-  = PBHandlerCounter
-  { pbTerms    :: !PBLinSum -- sorted in the decending order on coefficients.
-  , pbDegree   :: !Integer
-  , pbCoeffMap :: !(LitMap Integer)
-  , pbMaxSlack :: !Integer
-  , pbSlack    :: !(IORef Integer)
-  , pbActivity :: !(IORef Double)
-  , pbHash     :: !Int
-  }
-
-instance Eq PBHandlerCounter where
-  (==) = (==) `on` pbSlack
-
-instance Hashable PBHandlerCounter where
-  hash = pbHash
-  hashWithSalt = defaultHashWithSalt
-
-newPBHandlerCounter :: PBLinSum -> Integer -> Bool -> IO PBHandlerCounter
-newPBHandlerCounter ts degree learnt = do
-  let ts' = sortBy (flip compare `on` fst) ts
-      slack = sum (map fst ts) - degree      
-      m = IM.fromList [(l,c) | (c,l) <- ts]
-  s <- newIORef slack
-  act <- newIORef $! (if learnt then 0 else -1)
-  return (PBHandlerCounter ts' degree m slack s act (hash (ts,degree)))
-
-instance ConstraintHandler PBHandlerCounter where
-  toConstraintHandler = CHPBCounter
-
-  showConstraintHandler this = do
-    return $ show (pbTerms this) ++ " >= " ++ show (pbDegree this)
-
-  attach solver this = do
-    -- BCP queue should be empty at this point.
-    -- It is important for calculating slack.
-    bcpCheckEmpty solver
-    s <- liftM sum $ forM (pbTerms this) $ \(c,l) -> do
-      watchLit solver l this
-      val <- litValue solver l
-      if val == lFalse then do
-        addBacktrackCB solver (litVar l) $ modifyIORef' (pbSlack this) (+ c)
-        return 0
-      else do
-        return c
-    let slack = s - pbDegree this
-    writeIORef (pbSlack this) $! slack
-    if slack < 0 then
-      return False
-    else do
-      flip allM (pbTerms this) $ \(c,l) -> do
-        val <- litValue solver l
-        if c > slack && val == lUndef then do
-          assignBy solver l this
-        else
-          return True
-
-  watchedLiterals _ this = do
-    return $ map snd $ pbTerms this
-
-  watchedVariables _ _ = return []
-
-  basicPropagate solver this this2 falsifiedLit = do
-    watchLit solver falsifiedLit this
-    let c = pbCoeffMap this2 IM.! falsifiedLit
-    modifyIORef' (pbSlack this2) (subtract c)
-    addBacktrackCB solver (litVar falsifiedLit) $ modifyIORef' (pbSlack this2) (+ c)
-    s <- readIORef (pbSlack this2)
-    if s < 0 then
-      return False
-    else do
-      forM_ (takeWhile (\(c1,_) -> c1 > s) (pbTerms this2)) $ \(_,l1) -> do
-        v <- litValue solver l1
-        when (v == lUndef) $ do
-          assignBy solver l1 this
-          return ()
-      return True
-
-  basicReasonOf solver this l = do
-    case l of
-      Nothing -> do
-        let p _ = return True
-        f p (pbMaxSlack this) (pbTerms this)
-      Just lit -> do
-        idx <- varAssignNo solver (litVar lit)
-        -- PB制約の場合には複数回unitになる可能性があり、
-        -- litへの伝播以降に割り当てられたリテラルを含まないよう注意が必要
-        let p lit2 =do
-              idx2 <- varAssignNo solver (litVar lit2)
-              return $ idx2 < idx
-        let c = pbCoeffMap this IM.! lit
-        f p (pbMaxSlack this - c) (pbTerms this)
-    where
-      {-# INLINE f #-}
-      f :: (Lit -> IO Bool) -> Integer -> PBLinSum -> IO [Lit]
-      f p s xs = go s xs []
-        where
-          go :: Integer -> PBLinSum -> [Lit] -> IO [Lit]
-          go s _ ret | s < 0 = return ret
-          go _ [] _ = error "PBHandlerCounter.basicReasonOf: should not happen"
-          go s ((c,lit):xs) ret = do
-            val <- litValue solver lit
-            if val == lFalse then do
-              b <- p lit
-              if b
-              then go (s - c) xs (lit:ret)
-              else go s xs ret
-            else do
-              go s xs ret
-
-  isPBRepresentable _ = return True
-
-  toPBLinAtLeast this = do
-    return (pbTerms this, pbDegree this)
-
-  isSatisfied solver this = do
-    xs <- forM (pbTerms this) $ \(c,l) -> do
-      v <- litValue solver l
-      if v == lTrue
-        then return c
-        else return 0
-    return $ sum xs >= pbDegree this
-
-  constrWeight _ _ = return 0.5
-
-  constrReadActivity this = readIORef (pbActivity this)
-
-  constrWriteActivity this aval = writeIORef (pbActivity this) $! aval
-
-{--------------------------------------------------------------------
-  Pseudo Boolean Constraint (Pueblo)
---------------------------------------------------------------------}
-
-data PBHandlerPueblo
-  = PBHandlerPueblo
-  { puebloTerms     :: !PBLinSum
-  , puebloDegree    :: !Integer
-  , puebloMaxSlack  :: !Integer
-  , puebloWatches   :: !(IORef LitSet)
-  , puebloWatchSum  :: !(IORef Integer)
-  , puebloActivity  :: !(IORef Double)
-  , puebloHash      :: !Int
-  }
-
-instance Eq PBHandlerPueblo where
-  (==) = (==) `on` puebloWatchSum
-
-instance Hashable PBHandlerPueblo where
-  hash = puebloHash
-  hashWithSalt = defaultHashWithSalt
-
-puebloAMax :: PBHandlerPueblo -> Integer
-puebloAMax this =
-  case puebloTerms this of
-    (c,_):_ -> c
-    [] -> 0 -- should not happen?
-
-newPBHandlerPueblo :: PBLinSum -> Integer -> Bool -> IO PBHandlerPueblo
-newPBHandlerPueblo ts degree learnt = do
-  let ts' = sortBy (flip compare `on` fst) ts
-      slack = sum [c | (c,_) <- ts'] - degree
-  ws   <- newIORef IS.empty
-  wsum <- newIORef 0
-  act  <- newIORef $! (if learnt then 0 else -1)
-  return $ PBHandlerPueblo ts' degree slack ws wsum act (hash (ts,degree))
-
-puebloGetWatchSum :: PBHandlerPueblo -> IO Integer
-puebloGetWatchSum pb = readIORef (puebloWatchSum pb)
-
-puebloWatch :: Solver -> SomeConstraintHandler -> PBHandlerPueblo -> PBLinTerm -> IO ()
-puebloWatch solver constr !pb (c, lit) = do
-  watchLit solver lit constr
-  modifyIORef' (puebloWatches pb) (IS.insert lit)
-  modifyIORef' (puebloWatchSum pb) (+c)
-
-puebloUnwatch :: Solver -> PBHandlerPueblo -> PBLinTerm -> IO ()
-puebloUnwatch _solver pb (c, lit) = do
-  modifyIORef' (puebloWatches pb) (IS.delete lit)
-  modifyIORef' (puebloWatchSum pb) (subtract c)
-
-instance ConstraintHandler PBHandlerPueblo where
-  toConstraintHandler = CHPBPueblo
-
-  showConstraintHandler this = do
-    return $ show (puebloTerms this) ++ " >= " ++ show (puebloDegree this)
-
-  attach solver this = do
-    bcpCheckEmpty solver
-    let constr = toConstraintHandler this
-    ret <- puebloPropagate solver constr this
-
-    -- register to watch recently falsified literals to recover
-    -- "WatchSum >= puebloDegree this + puebloAMax this" when backtrack is performed.
-    wsum <- puebloGetWatchSum this
-    unless (wsum >= puebloDegree this + puebloAMax this) $ do
-      let f m tm@(_,lit) = do
-            val <- litValue solver lit
-            if val == lFalse then do
-              idx <- varAssignNo solver (litVar lit)
-              return (IM.insert idx tm m)
-            else
-              return m
-#if MIN_VERSION_containers(0,5,0)
-      xs <- liftM (map snd . IM.toDescList) $ foldM f IM.empty (puebloTerms this)
-#else
-      xs <- liftM (reverse . map snd . IM.toAscList) $ foldM f IM.empty (puebloTerms this)
-#endif
-      let g !_ [] = return ()
-          g !s (t@(c,l):ts) = do
-            addBacktrackCB solver (litVar l) $ puebloWatch solver constr this t
-            if s+c >= puebloDegree this + puebloAMax this then return ()
-            else g (s+c) ts
-      g wsum xs
-
-    return ret
-
-  watchedLiterals _ this = liftM IS.toList $ readIORef (puebloWatches this)
-
-  watchedVariables _ _ = return []
-
-  basicPropagate solver this this2 falsifiedLit = do
-    let t = fromJust $ find (\(_,l) -> l==falsifiedLit) (puebloTerms this2)
-    puebloUnwatch solver this2 t
-    ret <- puebloPropagate solver this this2
-    wsum <- puebloGetWatchSum this2
-    unless (wsum >= puebloDegree this2 + puebloAMax this2) $
-      addBacktrackCB solver (litVar falsifiedLit) $ puebloWatch solver this this2 t
-    return ret
-
-  basicReasonOf solver this l = do
-    case l of
-      Nothing -> do
-        let p _ = return True
-        f p (puebloMaxSlack this) (puebloTerms this)
-      Just lit -> do
-        idx <- varAssignNo solver (litVar lit)
-        -- PB制約の場合には複数回unitになる可能性があり、
-        -- litへの伝播以降に割り当てられたリテラルを含まないよう注意が必要
-        let p lit2 =do
-              idx2 <- varAssignNo solver (litVar lit2)
-              return $ idx2 < idx
-        let c = fst $ fromJust $ find (\(_,l) -> l == lit) (puebloTerms this)
-        f p (puebloMaxSlack this - c) (puebloTerms this)
-    where
-      {-# INLINE f #-}
-      f :: (Lit -> IO Bool) -> Integer -> PBLinSum -> IO [Lit]
-      f p s xs = go s xs []
-        where
-          go :: Integer -> PBLinSum -> [Lit] -> IO [Lit]
-          go s _ ret | s < 0 = return ret
-          go _ [] _ = error "PBHandlerPueblo.basicReasonOf: should not happen"
-          go s ((c,lit):xs) ret = do
-            val <- litValue solver lit
-            if val == lFalse then do
-              b <- p lit
-              if b
-              then go (s - c) xs (lit:ret)
-              else go s xs ret
-            else do
-              go s xs ret
-
-  isPBRepresentable _ = return True
-
-  toPBLinAtLeast this = do
-    return (puebloTerms this, puebloDegree this)
-
-  isSatisfied solver this = do
-    xs <- forM (puebloTerms this) $ \(c,l) -> do
-      v <- litValue solver l
-      if v == lTrue
-        then return c
-        else return 0
-    return $ sum xs >= puebloDegree this
-
-  constrWeight _ _ = return 0.5
-
-  constrReadActivity this = readIORef (puebloActivity this)
-
-  constrWriteActivity this aval = writeIORef (puebloActivity this) $! aval
-
-puebloPropagate :: Solver -> SomeConstraintHandler -> PBHandlerPueblo -> IO Bool
-puebloPropagate solver constr this = do
-  puebloUpdateWatchSum solver constr this
-  watchsum <- puebloGetWatchSum this
-  if puebloDegree this + puebloAMax this <= watchsum then
-    return True
-  else if watchsum < puebloDegree this then do
-    -- CONFLICT
-    return False
-  else do -- puebloDegree this <= watchsum < puebloDegree this + puebloAMax this
-    -- UNIT PROPAGATION
-    let f [] = return True
-        f ((c,lit) : ts) = do
-          watchsum <- puebloGetWatchSum this
-          if watchsum - c >= puebloDegree this then
-            return True
-          else do
-            val <- litValue solver lit
-            when (val == lUndef) $ do
-              b <- assignBy solver lit this
-              assert b $ return ()
-            f ts
-    f $ puebloTerms this
-
-puebloUpdateWatchSum :: Solver -> SomeConstraintHandler -> PBHandlerPueblo -> IO ()
-puebloUpdateWatchSum solver constr this = do
-  let f [] = return ()
-      f (t@(_,lit):ts) = do
-        watchSum <- puebloGetWatchSum this
-        if watchSum >= puebloDegree this + puebloAMax this then
-          return ()
-        else do
-          val <- litValue solver lit
-          watched <- liftM (lit `IS.member`) $ readIORef (puebloWatches this)
-          when (val /= lFalse && not watched) $ do
-            puebloWatch solver constr this t
-          f ts
-  f (puebloTerms this)
-
-{--------------------------------------------------------------------
-  XOR Clause
---------------------------------------------------------------------}
-
-data XORClauseHandler
-  = XORClauseHandler
-  { xorLits :: !(IOUArray Int Lit)
-  , xorActivity :: !(IORef Double)
-  , xorHash :: !Int
-  }
-
-instance Eq XORClauseHandler where
-  (==) = (==) `on` xorLits
-
-instance Hashable XORClauseHandler where
-  hash = xorHash
-  hashWithSalt = defaultHashWithSalt
-
-newXORClauseHandler :: [Lit] -> Bool -> IO XORClauseHandler
-newXORClauseHandler ls learnt = do
-  let size = length ls
-  a <- newListArray (0, size-1) ls
-  act <- newIORef $! (if learnt then 0 else -1)
-  return (XORClauseHandler a act (hash ls))
-
-instance ConstraintHandler XORClauseHandler where
-  toConstraintHandler = CHXORClause
-
-  showConstraintHandler this = do
-    lits <- getElems (xorLits this)
-    return ("XOR " ++ show lits)
-
-  attach solver this = do
-    -- BCP Queue should be empty at this point.
-    -- If not, duplicated propagation happens.
-    bcpCheckEmpty solver
-
-    let a = xorLits this
-    (lb,ub) <- getBounds a
-    assert (lb == 0) $ return ()
-    let size = ub-lb+1
-
-    if size == 0 then do
-      markBad solver
-      return False
-    else if size == 1 then do
-      lit0 <- unsafeRead a 0
-      assignBy solver lit0 this
-    else do
-      ref <- newIORef 1
-      let f i = do
-            lit_i <- unsafeRead a i
-            val_i <- litValue solver lit_i
-            if val_i == lUndef then
-              return True
-            else do
-              j <- readIORef ref
-              k <- findForWatch2 solver a j ub
-              case k of
-                -1 -> do
-                  return False
-                _ -> do
-                  lit_k <- unsafeRead a k
-                  unsafeWrite a i lit_k
-                  unsafeWrite a k lit_i
-                  writeIORef ref $! (k+1)
-                  return True
-
-      b <- f 0
-      if b then do
-        lit0 <- unsafeRead a 0
-        watchVar solver (litVar lit0) this
-        b2 <- f 1
-        if b2 then do
-          lit1 <- unsafeRead a 1
-          watchVar solver (litVar lit1) this
-          return True
-        else do -- UNIT
-          -- We need to watch the most recently falsified literal
-          (i,_) <- liftM (maximumBy (comparing snd)) $ forM [1..ub] $ \l -> do
-            lit <- unsafeRead a l
-            lv <- litLevel solver lit
-            return (l,lv)
-          lit1 <- unsafeRead a 1
-          liti <- unsafeRead a i
-          unsafeWrite a 1 liti
-          unsafeWrite a i lit1
-          watchVar solver (litVar liti) this
-          -- lit0 ⊕ y
-          y <- do
-            ref <- newIORef False
-            forLoop 1 (<=ub) (+1) $ \j -> do
-              lit_j <- unsafeRead a j
-              val_j <- litValue solver lit_j
-              modifyIORef' ref (/= fromJust (unliftBool val_j))
-            readIORef ref
-          assignBy solver (if y then litNot lit0 else lit0) this -- should always succeed
-      else do
-        ls <- liftM (map fst . sortBy (flip (comparing snd))) $ forM [lb..ub] $ \l -> do
-          lit <- unsafeRead a l
-          lv <- litLevel solver lit
-          return (l,lv)
-        forM_ (zip [0..] ls) $ \(i,lit) -> do
-          unsafeWrite a i lit
-        lit0 <- unsafeRead a 0
-        lit1 <- unsafeRead a 1
-        watchVar solver (litVar lit0) this
-        watchVar solver (litVar lit1) this
-        isSatisfied solver this
-
-  watchedLiterals _ _ = return []
-
-  watchedVariables _ this = do
-    lits <- getElems (xorLits this)
-    case lits of
-      l1:l2:_ -> return [litVar l1, litVar l2]
-      _ -> return []
-
-  -- FIXME: 伝播した変数から再度呼ばれて、再び伝播処理が起こってしまう
-  basicPropagate !solver this this2 !falsifiedLit = do
-    preprocess
-
-    !lit0 <- unsafeRead a 0
-    (!lb,!ub) <- getBounds a
-    assert (lb==0) $ return ()
-    i <- findForWatch2 solver a 2 ub
-    case i of
-      -1 -> do
-        when debugMode $ logIO solver $ do
-           str <- showConstraintHandler this
-           return $ printf "basicPropagate: %s is unit" str
-        watchVar solver v this
-        -- lit0 ⊕ y
-        y <- do
-          ref <- newIORef False
-          forLoop 1 (<=ub) (+1) $ \j -> do
-            lit_j <- unsafeRead a j
-            val_j <- litValue solver lit_j
-            modifyIORef' ref (/= fromJust (unliftBool val_j))
-          readIORef ref
-        assignBy solver (if y then litNot lit0 else lit0) this
-      _  -> do
-        !lit1 <- unsafeRead a 1
-        !liti <- unsafeRead a i
-        unsafeWrite a 1 liti
-        unsafeWrite a i lit1
-        watchVar solver (litVar liti) this
-        return True
-
-    where
-      v = litVar falsifiedLit
-      a = xorLits this2
-
-      preprocess :: IO ()
-      preprocess = do
-        !l0 <- unsafeRead a 0
-        !l1 <- unsafeRead a 1
-        assert (litVar l0 == v || litVar l1 == v) $ return ()
-        when (litVar l0 == v) $ do
-          unsafeWrite a 0 l1
-          unsafeWrite a 1 l0
-
-  basicReasonOf solver this l = do
-    lits <- getElems (xorLits this)
-    xs <-
-      case l of
-        Nothing -> mapM f lits
-        Just lit -> do
-         -- FIXME: 伝播処理が二回起こってしまうせいで、伝播結果のリテラルが先頭とは限らない
-         case lits of
-           l1:l2:ls
-             | litVar lit == litVar l1 -> mapM f (l2 : ls)
-             | litVar lit == litVar l2 -> mapM f (l1 : ls)
-           _ -> error "XORClauseHandler.basicReasonOf: should not happen"
-    return xs
-    where
-      f :: Lit -> IO Lit
-      f lit = do
-        let v = litVar lit
-        val <- varValue solver v
-        return $ literal v (not (fromJust (unliftBool val)))
-
-  isPBRepresentable _ = return False
-
-  toPBLinAtLeast _ = error "XORClauseHandler does not support toPBLinAtLeast"
-
-  isSatisfied solver this = do
-    lits <- getElems (xorLits this)
-    vals <- mapM (litValue solver) lits
-    let f x y
-          | x == lUndef || y == lUndef = lUndef
-          | otherwise = liftBool (x /= y)
-    return $ foldl' f lFalse vals == lTrue
-
-  constrIsProtected _ this = do
-    size <- liftM rangeSize (getBounds (xorLits this))
-    return $! size <= 2
-
-  constrReadActivity this = readIORef (xorActivity this)
-
-  constrWriteActivity this aval = writeIORef (xorActivity this) $! aval
-
-instantiateXORClause :: Solver -> XORClause -> IO XORClause
-instantiateXORClause solver (ls,b) = loop [] b ls
-  where
-    loop :: [Lit] -> Bool -> [Lit] -> IO XORClause
-    loop lhs !rhs [] = return (lhs, rhs)
-    loop lhs !rhs (l:ls) = do
-      val <- litValue solver l
-      if val==lTrue then
-        loop lhs (not rhs) ls
-      else if val==lFalse then
-        loop lhs rhs ls
-      else
-        loop (l : lhs) rhs ls
-
-basicAttachXORClauseHandler :: Solver -> XORClauseHandler -> IO Bool
-basicAttachXORClauseHandler solver this = do
-  lits <- getElems (xorLits this)
-  case lits of
-    [] -> do
-      markBad solver
-      return False
-    [l1] -> do
-      assignBy solver l1 this
-    l1:l2:_ -> do
-      watchVar solver (litVar l1) this
-      watchVar solver (litVar l2) this
-      return True
-
-{--------------------------------------------------------------------
-  Restart strategy
---------------------------------------------------------------------}
-
-data RestartStrategy = MiniSATRestarts | ArminRestarts | LubyRestarts
-  deriving (Show, Eq, Ord)
-
-mkRestartSeq :: RestartStrategy -> Int -> Double -> [Int]
-mkRestartSeq MiniSATRestarts = miniSatRestartSeq
-mkRestartSeq ArminRestarts   = arminRestartSeq
-mkRestartSeq LubyRestarts    = lubyRestartSeq
-
-miniSatRestartSeq :: Int -> Double -> [Int]
-miniSatRestartSeq start inc = iterate (ceiling . (inc *) . fromIntegral) start
-
-{-
-miniSatRestartSeq :: Int -> Double -> [Int]
-miniSatRestartSeq start inc = map round $ iterate (inc*) (fromIntegral start)
--}
-
-arminRestartSeq :: Int -> Double -> [Int]
-arminRestartSeq start inc = go (fromIntegral start) (fromIntegral start)
-  where  
-    go !inner !outer = round inner : go inner' outer'
-      where
-        (inner',outer') = 
-          if inner >= outer
-          then (fromIntegral start, outer * inc)
-          else (inner * inc, outer)
-
-lubyRestartSeq :: Int -> Double -> [Int]
-lubyRestartSeq start inc = map (ceiling . (fromIntegral start *) . luby inc) [0..]
-
-{-
-  Finite subsequences of the Luby-sequence:
-
-  0: 1
-  1: 1 1 2
-  2: 1 1 2 1 1 2 4
-  3: 1 1 2 1 1 2 4 1 1 2 1 1 2 4 8
-  ...
-
-
--}
-luby :: Double -> Integer -> Double
-luby y x = go2 size1 sequ1 x
-  where
-    -- Find the finite subsequence that contains index 'x', and the
-    -- size of that subsequence:
-    (size1, sequ1) = go 1 0
-
-    go :: Integer -> Integer -> (Integer, Integer)
-    go size sequ
-      | size < x+1 = go (2*size+1) (sequ+1)
-      | otherwise  = (size, sequ)
-
-    go2 :: Integer -> Integer -> Integer -> Double
-    go2 size sequ x2
-      | size-1 /= x2 = let size' = (size-1) `div` 2 in go2 size' (sequ - 1) (x2 `mod` size')
-      | otherwise = y ^ sequ
-
-
-{--------------------------------------------------------------------
-  utility
---------------------------------------------------------------------}
-
-allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-allM p = go
-  where
-    go [] = return True
-    go (x:xs) = do
-      b <- p x
-      if b
-        then go xs
-        else return False
-
-anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-anyM p = go
-  where
-    go [] = return False
-    go (x:xs) = do
-      b <- p x
-      if b
-        then return True
-        else go xs
-
-#if !MIN_VERSION_base(4,6,0)
-
-modifyIORef' :: IORef a -> (a -> a) -> IO ()
-modifyIORef' ref f = do
-  x <- readIORef ref
-  writeIORef ref $! f x
-
-#endif
-
-shift :: IORef [a] -> IO a
-shift ref = do
-  (x:xs) <- readIORef ref
-  writeIORef ref xs
-  return x
-
-defaultHashWithSalt :: Hashable a => Int -> a -> Int
-defaultHashWithSalt salt x = salt `combine` hash x
-#if MIN_VERSION_hashable(1,2,0)
-  where
-    combine :: Int -> Int -> Int
-    combine h1 h2 = (h1 * 16777619) `xor` h2
-#endif
-
-{--------------------------------------------------------------------
-  debug
---------------------------------------------------------------------}
-
-debugMode :: Bool
-debugMode = False
-
-checkSatisfied :: Solver -> IO ()
-checkSatisfied solver = do
-  cls <- readIORef (svConstrDB solver)
-  forM_ cls $ \c -> do
-    b <- isSatisfied solver c
-    unless b $ do
-      s <- showConstraintHandler c
-      log solver $ "BUG: " ++ s ++ " is violated"
-
-sanityCheck :: Solver -> IO ()
-sanityCheck _ | not debugMode = return ()
-sanityCheck solver = do
-  cls <- readIORef (svConstrDB solver)
-  forM_ cls $ \constr -> do
-    lits <- watchedLiterals solver constr
-    forM_ lits $ \l -> do
-      ws <- watches solver l
-      unless (constr `elem` ws) $ error $ printf "sanityCheck:A:%s" (show lits)
-
-  vs <- variables solver
-  let lits = [l | v <- vs, l <- [literal v True, literal v False]]
-  forM_ lits $ \l -> do
-    cs <- watches solver l
-    forM_ cs $ \constr -> do
-      lits2 <- watchedLiterals solver constr
-      unless (l `elem` lits2) $ do
-        error $ printf "sanityCheck:C:%d %s" l (show lits2)
+  , setTheory
+
+  -- * Solving
+  , solve
+  , solveWith
+  , BudgetExceeded (..)
+
+  -- * Extract results
+  , Model
+  , getModel
+  , getFailedAssumptions
+
+  -- * Solver configulation
+  , RestartStrategy (..)
+  , setRestartStrategy
+  , defaultRestartStrategy
+  , setRestartFirst
+  , defaultRestartFirst
+  , setRestartInc
+  , defaultRestartInc
+  , setLearntSizeFirst
+  , defaultLearntSizeFirst
+  , setLearntSizeInc
+  , defaultLearntSizeInc
+  , setCCMin
+  , defaultCCMin
+  , LearningStrategy (..)
+  , setLearningStrategy
+  , defaultLearningStrategy
+  , setEnablePhaseSaving
+  , getEnablePhaseSaving
+  , defaultEnablePhaseSaving
+  , setEnableForwardSubsumptionRemoval
+  , getEnableForwardSubsumptionRemoval
+  , defaultEnableForwardSubsumptionRemoval
+  , setEnableBackwardSubsumptionRemoval
+  , getEnableBackwardSubsumptionRemoval
+  , defaultEnableBackwardSubsumptionRemoval
+  , setVarPolarity
+  , setLogger
+  , setCheckModel
+  , setRandomFreq
+  , defaultRandomFreq
+  , setRandomGen
+  , getRandomGen
+  , setConfBudget
+  , PBHandlerType (..)
+  , setPBHandlerType
+  , defaultPBHandlerType
+  , setPBSplitClausePart
+  , getPBSplitClausePart
+  , defaultPBSplitClausePart
+
+  -- * Read state
+  , getNVars
+  , getNConstraints
+  , getNLearntConstraints
+  , getVarFixed
+  , getLitFixed
+
+  -- * Read state (deprecated)
+  , nVars
+  , nAssigns
+  , nConstraints
+  , nLearnt  
+
+  -- * Internal API
+  , varBumpActivity
+  , varDecayActivity
+  ) where
+
+import Prelude hiding (log)
+import Control.Loop
+import Control.Monad
+import Control.Exception
+#if MIN_VERSION_array(0,5,0)
+import Data.Array.IO
+#else
+import Data.Array.IO hiding (unsafeFreeze)
+#endif
+import Data.Array.Unsafe (unsafeFreeze)
+import Data.Array.Base (unsafeRead, unsafeWrite)
+#if MIN_VERSION_hashable(1,2,0)
+import Data.Bits (xor) -- for defining 'combine' function
+#endif
+import Data.Function (on)
+import Data.Hashable
+import Data.HashSet (HashSet)
+import qualified Data.HashSet as HashSet
+import Data.IORef
+import Data.List
+import Data.Maybe
+import Data.Ord
+import qualified Data.IntMap as IM
+import qualified Data.IntSet as IS
+import qualified Data.Set as Set
+import ToySolver.Internal.Data.IOURef
+import qualified ToySolver.Internal.Data.IndexedPriorityQueue as PQ
+import qualified ToySolver.Internal.Data.Vec as Vec
+import Data.Time
+import Data.Typeable
+import System.CPUTime
+import qualified System.Random as Rand
+import Text.Printf
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Types (IO (..))
+import GHC.Exts hiding (Constraint)
+#endif
+
+import ToySolver.Data.LBool
+import ToySolver.SAT.Types
+import ToySolver.SAT.TheorySolver
+
+{--------------------------------------------------------------------
+  internal data structures
+--------------------------------------------------------------------}
+
+type Level = Int
+
+levelRoot :: Level
+levelRoot = 0
+
+data VarData
+  = VarData
+  { vdPolarity   :: !(IORef Bool)
+  , vdPosLitData :: !LitData
+  , vdNegLitData :: !LitData
+  -- | will be invoked once when the variable is assigned
+  , vdWatches    :: !(IORef [SomeConstraintHandler])
+  , vdActivity   :: !(IOURef VarActivity)
+  , vdValue :: !(IORef LBool)
+  , vdTrailIndex :: !(IOURef Int)
+  , vdLevel :: !(IOURef Level)
+  , vdReason :: !(IORef (Maybe SomeConstraintHandler))
+  , vdOnUnassigned :: !(IORef [SomeConstraintHandler])
+  }
+
+data LitData
+  = LitData
+  { -- | will be invoked when this literal is falsified
+    ldWatches   :: !(IORef [SomeConstraintHandler])
+  , ldOccurList :: !(IORef (HashSet SomeConstraintHandler))
+  }
+
+newVarData :: IO VarData
+newVarData = do
+  polarity <- newIORef True
+  pos <- newLitData
+  neg <- newLitData
+  watches <- newIORef []
+  activity <- newIOURef 0
+
+  val <- newIORef lUndef
+  idx <- newIOURef maxBound
+  lv <- newIOURef maxBound
+  reason <- newIORef Nothing
+  onUnassigned <- newIORef []
+
+  return $
+    VarData
+    { vdPolarity = polarity
+    , vdPosLitData = pos
+    , vdNegLitData = neg
+    , vdWatches = watches
+    , vdActivity = activity
+    , vdValue = val
+    , vdTrailIndex = idx
+    , vdLevel = lv
+    , vdReason = reason
+    , vdOnUnassigned = onUnassigned
+    }
+
+newLitData :: IO LitData
+newLitData = do
+  ws <- newIORef []
+  occ <- newIORef HashSet.empty
+  return $ LitData ws occ
+
+varData :: Solver -> Var -> IO VarData
+varData solver !v = Vec.unsafeRead (svVarData solver) (v-1)
+
+litData :: Solver -> Lit -> IO LitData
+litData solver !l =
+  -- litVar による heap allocation を避けるために、
+  -- litPolarityによる分岐後にvarDataを呼ぶ。
+  if litPolarity l then do
+    vd <- varData solver l
+    return $ vdPosLitData vd
+  else do
+    vd <- varData solver (negate l)
+    return $ vdNegLitData vd
+
+{-# INLINE varValue #-}
+varValue :: Solver -> Var -> IO LBool
+varValue solver !v = do
+  vd <- varData solver v
+  readIORef (vdValue vd)
+
+{-# INLINE litValue #-}
+litValue :: Solver -> Lit -> IO LBool
+litValue solver !l = do
+  -- litVar による heap allocation を避けるために、
+  -- litPolarityによる分岐後にvarDataを呼ぶ。
+  if litPolarity l then
+    varValue solver l
+  else do
+    m <- varValue solver (negate l)
+    return $! lnot m
+
+getVarFixed :: Solver -> Var -> IO LBool
+getVarFixed solver !v = do
+  vd <- varData solver v
+  lv <- readIOURef (vdLevel vd)
+  if lv == levelRoot then
+    readIORef (vdValue vd)
+  else
+    return lUndef
+
+getLitFixed :: Solver -> Var -> IO LBool
+getLitFixed solver !l = do
+  -- litVar による heap allocation を避けるために、
+  -- litPolarityによる分岐後にvarDataを呼ぶ。
+  if litPolarity l then
+    getVarFixed solver l
+  else do
+    m <- getVarFixed solver (negate l)
+    return $! lnot m
+
+getNFixed :: Solver -> IO Int
+getNFixed solver = do
+  lv <- getDecisionLevel solver
+  if lv == levelRoot then
+    Vec.getSize (svTrail solver)
+  else
+    Vec.unsafeRead (svTrailLimit solver) 0
+
+varLevel :: Solver -> Var -> IO Level
+varLevel solver !v = do
+  vd <- varData solver v
+  val <- readIORef (vdValue vd)
+  when (val == lUndef) $ error ("ToySolver.SAT.varLevel: unassigned var " ++ show v)
+  readIOURef (vdLevel vd)
+
+litLevel :: Solver -> Lit -> IO Level
+litLevel solver l = varLevel solver (litVar l)
+
+varReason :: Solver -> Var -> IO (Maybe SomeConstraintHandler)
+varReason solver !v = do
+  vd <- varData solver v
+  val <- readIORef (vdValue vd)
+  when (val == lUndef) $ error ("ToySolver.SAT.varReason: unassigned var " ++ show v)
+  readIORef (vdReason vd)
+
+varAssignNo :: Solver -> Var -> IO Int
+varAssignNo solver !v = do
+  vd <- varData solver v
+  val <- readIORef (vdValue vd)
+  when (val == lUndef) $ error ("ToySolver.SAT.varAssignNo: unassigned var " ++ show v)
+  readIOURef (vdTrailIndex vd)
+
+-- | Solver instance
+data Solver
+  = Solver
+  { svOk           :: !(IORef Bool)
+
+  , svVarQueue     :: !PQ.PriorityQueue
+  , svTrail        :: !(Vec.UVec Lit)
+  , svTrailLimit   :: !(Vec.UVec Lit)
+  , svTrailNPropagated :: !(IOURef Int)
+
+  , svVarData      :: !(Vec.Vec VarData)
+  , svConstrDB     :: !(IORef [SomeConstraintHandler])
+  , svLearntDB     :: !(IORef (Int,[SomeConstraintHandler]))
+
+  -- Theory
+  , svTheorySolver  :: !(IORef (Maybe TheorySolver))
+  , svTheoryChecked :: !(IOURef Int)
+
+  -- Result
+  , svModel        :: !(IORef (Maybe Model))
+  , svFailedAssumptions :: !(IORef [Lit])
+
+  -- Statistics
+  , svNDecision    :: !(IOURef Int)
+  , svNRandomDecision :: !(IOURef Int)
+  , svNConflict    :: !(IOURef Int)
+  , svNRestart     :: !(IOURef Int)
+  , svNLearntGC    :: !(IOURef Int)
+  , svNRemovedConstr :: !(IOURef Int)
+
+  -- Configulation
+
+  -- | Inverse of the variable activity decay factor. (default 1 / 0.95)
+  , svVarDecay     :: !(IOURef Double)
+
+  -- | Amount to bump next variable with.
+  , svVarInc       :: !(IOURef Double)
+
+  -- | Inverse of the constraint activity decay factor. (1 / 0.999)
+  , svConstrDecay  :: !(IOURef Double)
+
+  -- | Amount to bump next constraint with.
+  , svConstrInc    :: !(IOURef Double)
+
+  , svRestartStrategy :: !(IORef RestartStrategy)
+
+  -- | The initial restart limit. (default 100)
+  , svRestartFirst :: !(IORef Int)
+
+  -- | The factor with which the restart limit is multiplied in each restart. (default 1.5)
+  , svRestartInc :: !(IORef Double)
+
+  -- | The initial limit for learnt constraints.
+  , svLearntSizeFirst :: !(IORef Int)
+
+  -- | The limit for learnt constraints is multiplied with this factor periodically. (default 1.1)
+  , svLearntSizeInc :: !(IORef Double)
+
+  -- | Controls conflict constraint minimization (0=none, 1=local, 2=recursive)
+  , svCCMin :: !(IORef Int)
+
+  , svEnablePhaseSaving :: !(IORef Bool)
+  , svEnableForwardSubsumptionRemoval :: !(IORef Bool)
+
+  , svLearningStrategy :: !(IORef LearningStrategy)
+
+  , svPBHandlerType :: !(IORef PBHandlerType)
+  , svPBSplitClausePart :: !(IORef Bool)
+
+  , svEnableBackwardSubsumptionRemoval :: !(IORef Bool)
+
+  , svCheckModel :: !(IORef Bool)
+
+  , svRandomFreq :: !(IORef Double)
+
+  , svRandomGen  :: !(IORef Rand.StdGen)
+
+  , svConfBudget :: !(IOURef Int)
+
+  -- Logging
+  , svLogger :: !(IORef (Maybe (String -> IO ())))
+  , svStartWC    :: !(IORef UTCTime)
+  , svLastStatWC :: !(IORef UTCTime)
+
+  -- Working spaces
+  , svAssumptions     :: !(Vec.UVec Lit)
+  , svLearntLim       :: !(IORef Int)
+  , svLearntLimAdjCnt :: !(IORef Int)
+  , svLearntLimSeq    :: !(IORef [(Int,Int)])
+  }
+
+markBad :: Solver -> IO ()
+markBad solver = do
+  writeIORef (svOk solver) False
+  bcpClear solver
+
+bcpDequeue :: Solver -> IO (Maybe Lit)
+bcpDequeue solver = do
+  n <- Vec.getSize (svTrail solver)
+  m <- readIOURef (svTrailNPropagated solver)
+  if m==n then
+    return Nothing
+  else do
+    -- m < n
+    lit <- Vec.unsafeRead (svTrail solver) m
+    modifyIOURef (svTrailNPropagated solver) (+1)
+    return (Just lit)
+
+bcpIsEmpty :: Solver -> IO Bool
+bcpIsEmpty solver = do
+  p <- readIOURef (svTrailNPropagated solver)
+  n <- Vec.getSize (svTrail solver)
+  return $! n == p
+
+bcpCheckEmpty :: Solver -> IO ()
+bcpCheckEmpty solver = do
+  empty <- bcpIsEmpty solver
+  unless empty $
+    error "BUG: BCP Queue should be empty at this point"
+
+bcpClear :: Solver -> IO ()
+bcpClear solver = do
+  m <- Vec.getSize (svTrail solver)
+  writeIOURef (svTrailNPropagated solver) m
+
+assignBy :: Solver -> Lit -> SomeConstraintHandler -> IO Bool
+assignBy solver lit c = do
+  lv <- getDecisionLevel solver
+  let !c2 = if lv == levelRoot
+            then Nothing
+            else Just c
+  assign_ solver lit c2
+
+assign :: Solver -> Lit -> IO Bool
+assign solver lit = assign_ solver lit Nothing
+
+assign_ :: Solver -> Lit -> Maybe SomeConstraintHandler -> IO Bool
+assign_ solver !lit reason = assert (validLit lit) $ do
+  vd <- varData solver (litVar lit)
+  let val = liftBool (litPolarity lit)
+
+  val0 <- readIORef (vdValue vd)
+  if val0 /= lUndef then do    
+    return $ val == val0
+  else do
+    idx <- Vec.getSize (svTrail solver)
+    lv <- getDecisionLevel solver
+
+    writeIORef (vdValue vd) val
+    writeIOURef (vdTrailIndex vd) idx
+    writeIOURef (vdLevel vd) lv
+    writeIORef (vdReason vd) reason
+
+    Vec.push (svTrail solver) lit
+
+    when debugMode $ logIO solver $ do
+      let r = case reason of
+                Nothing -> ""
+                Just _ -> " by propagation"
+      return $ printf "assign(level=%d): %d%s" lv lit r
+
+    return True
+
+unassign :: Solver -> Var -> IO ()
+unassign solver !v = assert (validVar v) $ do
+  vd <- varData solver v
+  val <- readIORef (vdValue vd)
+  when (val == lUndef) $ error "unassign: should not happen"
+
+  flag <- getEnablePhaseSaving solver
+  when flag $ writeIORef (vdPolarity vd) $! fromJust (unliftBool val)
+
+  writeIORef (vdValue vd) lUndef
+  writeIOURef (vdTrailIndex vd) maxBound
+  writeIOURef (vdLevel vd) maxBound
+  writeIORef (vdReason vd) Nothing
+
+  let !l = if val == lTrue then v else -v
+  cs <- readIORef (vdOnUnassigned vd)
+  writeIORef (vdOnUnassigned vd) []
+  forM_ cs $ \c ->
+    constrOnUnassigned solver c c l
+
+  PQ.enqueue (svVarQueue solver) v
+
+addOnUnassigned :: Solver -> SomeConstraintHandler -> Lit -> IO ()
+addOnUnassigned solver constr !l = do
+  vd <- varData solver (litVar l)
+  val <- readIORef (vdValue vd)
+  when (val == lUndef) $ error "addOnUnassigned: should not happen"
+  modifyIORef (vdOnUnassigned vd) (constr :)
+
+-- | Register the constraint to be notified when the literal becames false.
+watchLit :: Solver -> Lit -> SomeConstraintHandler -> IO ()
+watchLit solver !lit c = do
+  ld <- litData solver lit
+  modifyIORef (ldWatches ld) (c : )
+
+-- | Register the constraint to be notified when the variable is assigned.
+watchVar :: Solver -> Var -> SomeConstraintHandler -> IO ()
+watchVar solver !var c = do
+  vd <- varData solver var
+  modifyIORef (vdWatches vd) (c : )
+
+unwatchLit :: Solver -> Lit -> SomeConstraintHandler -> IO ()
+unwatchLit solver !lit c = do
+  ld <- litData solver lit
+  modifyIORef (ldWatches ld) (delete c)
+
+unwatchVar :: Solver -> Lit -> SomeConstraintHandler -> IO ()
+unwatchVar solver !lit c = do
+  vd <- varData solver lit
+  modifyIORef (vdWatches vd) (delete c)
+
+-- | Returns list of constraints that are watching the literal.
+watches :: Solver -> Lit -> IO [SomeConstraintHandler]
+watches solver !lit = do
+  ld <- litData solver lit
+  readIORef (ldWatches ld)
+
+addToDB :: ConstraintHandler c => Solver -> c -> IO ()
+addToDB solver c = do
+  let c2 = toConstraintHandler c
+  modifyIORef (svConstrDB solver) (c2 : )
+  when debugMode $ logIO solver $ do
+    str <- showConstraintHandler c
+    return $ printf "constraint %s is added" str
+
+  b <- isPBRepresentable c
+  when b $ do
+    (lhs,_) <- toPBLinAtLeast c
+    forM_ lhs $ \(_,lit) -> do
+       ld <- litData solver lit
+       modifyIORef' (ldOccurList ld) (HashSet.insert c2)
+
+addToLearntDB :: ConstraintHandler c => Solver -> c -> IO ()
+addToLearntDB solver c = do
+  modifyIORef (svLearntDB solver) $ \(n,xs) -> (n+1, toConstraintHandler c : xs)
+  when debugMode $ logIO solver $ do
+    str <- showConstraintHandler c
+    return $ printf "constraint %s is added" str
+
+reduceDB :: Solver -> IO ()
+reduceDB solver = do
+  (_,cs) <- readIORef (svLearntDB solver)
+
+  xs <- forM cs $ \c -> do
+    p <- constrIsProtected solver c
+    w <- constrWeight solver c
+    actval <- constrReadActivity c
+    return (c, (p, w*actval))
+
+  -- Note that False <= True
+  let ys = sortBy (comparing snd) xs
+      (zs,ws) = splitAt (length ys `div` 2) ys
+
+  let loop [] ret = return ret
+      loop ((c,(isShort,_)) : rest) ret = do
+        flag <- if isShort
+                then return True
+                else isLocked solver c
+        if flag then
+          loop rest (c:ret)
+        else do
+          detach solver c
+          loop rest ret
+  zs2 <- loop zs []
+
+  let cs2 = zs2 ++ map fst ws
+      n2 = length cs2
+
+  -- log solver $ printf "learnt constraints deletion: %d -> %d" n n2
+  writeIORef (svLearntDB solver) (n2,cs2)
+
+type VarActivity = Double
+
+varActivity :: Solver -> Var -> IO VarActivity
+varActivity solver !v = do
+  vd <- varData solver v
+  readIOURef (vdActivity vd)
+
+varDecayActivity :: Solver -> IO ()
+varDecayActivity solver = do
+  d <- readIOURef (svVarDecay solver)
+  modifyIOURef (svVarInc solver) (d*)
+
+varBumpActivity :: Solver -> Var -> IO ()
+varBumpActivity solver !v = do
+  inc <- readIOURef (svVarInc solver)
+  vd <- varData solver v
+  modifyIOURef (vdActivity vd) (+inc)
+  PQ.update (svVarQueue solver) v
+  aval <- readIOURef (vdActivity vd)
+  when (aval > 1e20) $
+    -- Rescale
+    varRescaleAllActivity solver
+
+varRescaleAllActivity :: Solver -> IO ()
+varRescaleAllActivity solver = do
+  vs <- variables solver
+  forM_ vs $ \v -> do
+    vd <- varData solver v
+    modifyIOURef (vdActivity vd) (* 1e-20)
+  modifyIOURef (svVarInc solver) (* 1e-20)
+
+variables :: Solver -> IO [Var]
+variables solver = do
+  n <- getNVars solver
+  return [1 .. n]
+
+-- | number of variables of the problem.
+getNVars :: Solver -> IO Int
+getNVars solver = Vec.getSize (svVarData solver)
+
+{-# DEPRECATED nVars "Use getNVars instead" #-}
+-- | number of variables of the problem.
+nVars :: Solver -> IO Int
+nVars = getNVars
+
+-- | number of assigned 
+getNAssigned :: Solver -> IO Int
+getNAssigned solver = Vec.getSize (svTrail solver)
+
+{-# DEPRECATED nAssigns "nAssigns is deprecated" #-}
+-- | number of assigned variables.
+nAssigns :: Solver -> IO Int
+nAssigns = getNAssigned
+
+-- | number of constraints.
+getNConstraints :: Solver -> IO Int
+getNConstraints solver = do
+  xs <- readIORef (svConstrDB solver)
+  return $ length xs
+
+{-# DEPRECATED nConstraints "Use getNConstraints instead" #-}
+-- | number of constraints.
+nConstraints :: Solver -> IO Int
+nConstraints = getNConstraints
+
+-- | number of learnt constrints.
+getNLearntConstraints :: Solver -> IO Int
+getNLearntConstraints solver = do
+  (n,_) <- readIORef (svLearntDB solver)
+  return n
+
+{-# DEPRECATED nLearnt "Use getNLearntConstraints instead" #-}
+-- | number of learnt constrints.
+nLearnt :: Solver -> IO Int
+nLearnt = getNLearntConstraints
+
+learntConstraints :: Solver -> IO [SomeConstraintHandler]
+learntConstraints solver = do
+  (_,cs) <- readIORef (svLearntDB solver)
+  return cs
+
+{--------------------------------------------------------------------
+  Solver
+--------------------------------------------------------------------}
+
+-- | Create a new Solver instance.
+newSolver :: IO Solver
+newSolver = do
+ rec
+  ok   <- newIORef True
+  trail <- Vec.new
+  trail_lim <- Vec.new
+  trail_nprop <- newIOURef 0
+  vars <- Vec.new
+  vqueue <- PQ.newPriorityQueueBy (ltVar solver)
+  db  <- newIORef []
+  db2 <- newIORef (0,[])
+  as  <- Vec.new
+  m   <- newIORef Nothing
+  ndecision <- newIOURef 0
+  nranddec  <- newIOURef 0
+  nconflict <- newIOURef 0
+  nrestart  <- newIOURef 0
+  nlearntgc <- newIOURef 0
+  nremoved  <- newIOURef 0
+
+  constrDecay <- newIOURef (1 / 0.999)
+  constrInc   <- newIOURef 1
+  varDecay <- newIOURef (1 / 0.95)
+  varInc   <- newIOURef 1
+  restartStrat <- newIORef defaultRestartStrategy
+  restartFirst <- newIORef defaultRestartFirst
+  restartInc <- newIORef defaultRestartInc
+  learning <- newIORef defaultLearningStrategy
+  learntSizeFirst <- newIORef defaultLearntSizeFirst
+  learntSizeInc <- newIORef defaultLearntSizeInc
+  ccMin <- newIORef defaultCCMin
+  checkModel <- newIORef False
+  pbHandlerType <- newIORef defaultPBHandlerType
+  pbSplitClausePart <- newIORef defaultPBSplitClausePart
+  enablePhaseSaving <- newIORef defaultEnablePhaseSaving
+  enableForwardSubsumptionRemoval <- newIORef defaultEnableForwardSubsumptionRemoval
+  enableBackwardSubsumptionRemoval <- newIORef defaultEnableBackwardSubsumptionRemoval
+
+  learntLim       <- newIORef undefined
+  learntLimAdjCnt <- newIORef (-1)
+  learntLimSeq    <- newIORef undefined
+
+  logger <- newIORef Nothing
+  startWC    <- newIORef undefined
+  lastStatWC <- newIORef undefined
+
+  randfreq <- newIORef defaultRandomFreq
+  randgen  <- newIORef =<< Rand.newStdGen
+
+  failed <- newIORef []
+
+  confBudget <- newIOURef (-1)
+
+  tsolver <- newIORef Nothing
+  tchecked <- newIOURef 0
+
+  let solver =
+        Solver
+        { svOk = ok
+        , svVarQueue   = vqueue
+        , svTrail      = trail
+        , svTrailLimit = trail_lim
+        , svTrailNPropagated = trail_nprop
+        , svVarData    = vars
+        , svConstrDB   = db
+        , svLearntDB   = db2
+
+        -- Theory
+        , svTheorySolver  = tsolver
+        , svTheoryChecked = tchecked
+
+        -- Result
+        , svModel      = m
+        , svFailedAssumptions = failed
+
+        -- Statistics        
+        , svNDecision  = ndecision
+        , svNRandomDecision = nranddec
+        , svNConflict  = nconflict
+        , svNRestart   = nrestart
+        , svNLearntGC  = nlearntgc
+        , svNRemovedConstr = nremoved
+
+        -- Configulation
+        , svVarDecay    = varDecay
+        , svVarInc      = varInc
+        , svConstrDecay = constrDecay
+        , svConstrInc   = constrInc
+        , svRestartStrategy = restartStrat
+        , svRestartFirst = restartFirst
+        , svRestartInc   = restartInc
+        , svLearningStrategy = learning
+        , svLearntSizeFirst = learntSizeFirst
+        , svLearntSizeInc = learntSizeInc
+        , svCCMin = ccMin
+        , svEnablePhaseSaving = enablePhaseSaving
+        , svEnableForwardSubsumptionRemoval = enableForwardSubsumptionRemoval
+        , svPBHandlerType   = pbHandlerType
+        , svPBSplitClausePart = pbSplitClausePart
+        , svEnableBackwardSubsumptionRemoval = enableBackwardSubsumptionRemoval
+        , svCheckModel = checkModel
+        , svRandomFreq = randfreq
+        , svRandomGen  = randgen
+        , svConfBudget = confBudget
+
+        -- Logging
+        , svLogger = logger
+        , svStartWC    = startWC
+        , svLastStatWC = lastStatWC
+
+        -- Working space
+        , svAssumptions     = as
+        , svLearntLim       = learntLim
+        , svLearntLimAdjCnt = learntLimAdjCnt
+        , svLearntLimSeq    = learntLimSeq
+        }
+ return solver
+
+ltVar :: Solver -> Var -> Var -> IO Bool
+ltVar solver v1 v2 = do
+  a1 <- varActivity solver v1
+  a2 <- varActivity solver v2
+  return $! a1 > a2
+
+{--------------------------------------------------------------------
+  Problem specification
+--------------------------------------------------------------------}
+
+-- |Add a new variable
+newVar :: Solver -> IO Var
+newVar solver = do
+  n <- Vec.getSize (svVarData solver)
+  let v = n + 1
+  vd <- newVarData
+  Vec.push (svVarData solver) vd
+  PQ.enqueue (svVarQueue solver) v
+  return v
+
+-- |Add variables. @newVars solver n = replicateM n (newVar solver)@
+newVars :: Solver -> Int -> IO [Var]
+newVars solver n = do
+  nv <- getNVars solver
+  resizeVarCapacity solver (nv+n)
+  replicateM n (newVar solver)
+
+-- |Add variables. @newVars_ solver n = newVars solver n >> return ()@
+newVars_ :: Solver -> Int -> IO ()
+newVars_ solver n = do
+  nv <- getNVars solver
+  resizeVarCapacity solver (nv+n)
+  replicateM_ n (newVar solver)
+
+-- |Pre-allocate internal buffer for @n@ variables.
+resizeVarCapacity :: Solver -> Int -> IO ()
+resizeVarCapacity solver n = do
+  Vec.resizeCapacity (svVarData solver) n
+  PQ.resizeHeapCapacity (svVarQueue solver) n
+  PQ.resizeTableCapacity (svVarQueue solver) (n+1)
+
+-- |Add a clause to the solver.
+addClause :: Solver -> Clause -> IO ()
+addClause solver lits = do
+  d <- getDecisionLevel solver
+  assert (d == levelRoot) $ return ()
+
+  ok <- readIORef (svOk solver)
+  when ok $ do
+    m <- instantiateClause (getLitFixed solver) lits
+    case normalizeClause =<< m of
+      Nothing -> return ()
+      Just [] -> markBad solver
+      Just [lit] -> do
+        {- We do not call 'removeBackwardSubsumedBy' here,
+           because subsumed constraints will be removed by 'simplify'. -}
+        ret <- assign solver lit
+        assert ret $ return ()
+        ret2 <- deduce solver
+        case ret2 of
+          Nothing -> return ()
+          Just _ -> markBad solver
+      Just lits2 -> do
+        subsumed <- checkForwardSubsumption solver lits
+        unless subsumed $ do
+          removeBackwardSubsumedBy solver ([(1,lit) | lit <- lits2], 1)
+          clause <- newClauseHandler lits2 False
+          addToDB solver clause
+          _ <- basicAttachClauseHandler solver clause
+          return ()
+
+-- | Add a cardinality constraints /atleast({l1,l2,..},n)/.
+addAtLeast :: Solver -- ^ The 'Solver' argument.
+           -> [Lit]  -- ^ set of literals /{l1,l2,..}/ (duplicated elements are ignored)
+           -> Int    -- ^ /n/.
+           -> IO ()
+addAtLeast solver lits n = do
+  d <- getDecisionLevel solver
+  assert (d == levelRoot) $ return ()
+
+  ok <- readIORef (svOk solver)
+  when ok $ do
+    (lits',n') <- liftM normalizeAtLeast $ instantiateAtLeast (getLitFixed solver) (lits,n)
+    let len = length lits'
+
+    if n' <= 0 then return ()
+    else if n' > len then markBad solver
+    else if n' == 1 then addClause solver lits'
+    else if n' == len then do
+      {- We do not call 'removeBackwardSubsumedBy' here,
+         because subsumed constraints will be removed by 'simplify'. -}
+      forM_ lits' $ \l -> do
+        ret <- assign solver l
+        assert ret $ return ()
+      ret2 <- deduce solver
+      case ret2 of
+        Nothing -> return ()
+        Just _ -> markBad solver
+    else do -- n' < len
+      removeBackwardSubsumedBy solver ([(1,lit) | lit <- lits'], fromIntegral n')
+      c <- newAtLeastHandler lits' n' False
+      addToDB solver c
+      _ <- basicAttachAtLeastHandler solver c
+      return ()
+
+-- | Add a cardinality constraints /atmost({l1,l2,..},n)/.
+addAtMost :: Solver -- ^ The 'Solver' argument
+          -> [Lit]  -- ^ set of literals /{l1,l2,..}/ (duplicated elements are ignored)
+          -> Int    -- ^ /n/
+          -> IO ()
+addAtMost solver lits n =
+  addAtLeast solver (map litNot lits) (length lits - n)
+
+-- | Add a cardinality constraints /exactly({l1,l2,..},n)/.
+addExactly :: Solver -- ^ The 'Solver' argument
+           -> [Lit]  -- ^ set of literals /{l1,l2,..}/ (duplicated elements are ignored)
+           -> Int    -- ^ /n/
+           -> IO ()
+addExactly solver lits n = do
+  addAtLeast solver lits n
+  addAtMost solver lits n
+
+-- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … ≥ n/.
+addPBAtLeast :: Solver          -- ^ The 'Solver' argument.
+             -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
+             -> Integer         -- ^ /n/
+             -> IO ()
+addPBAtLeast solver ts n = do
+  d <- getDecisionLevel solver
+  assert (d == levelRoot) $ return ()
+
+  ok <- readIORef (svOk solver)
+  when ok $ do
+    (ts',n') <- liftM normalizePBLinAtLeast $ instantiatePBLinAtLeast (getLitFixed solver) (ts,n)
+  
+    case pbToAtLeast (ts',n') of
+      Just (lhs',rhs') -> addAtLeast solver lhs' rhs'
+      Nothing -> do
+        let cs = map fst ts'
+            slack = sum cs - n'
+        if n' <= 0 then return ()
+        else if slack < 0 then markBad solver
+        else do
+          removeBackwardSubsumedBy solver (ts', n')          
+          (ts'',n'') <- do
+            b <- getPBSplitClausePart solver
+            if b
+            then pbSplitClausePart solver (ts',n')
+            else return (ts',n')
+
+          c <- newPBHandler solver ts'' n'' False
+          let constr = toConstraintHandler c
+          addToDB solver constr
+          ret <- attach solver constr
+          if not ret then do
+            markBad solver
+          else do
+            ret2 <- deduce solver
+            case ret2 of
+              Nothing -> return ()
+              Just _ -> markBad solver
+
+-- | See documentation of 'setPBSplitClausePart'.
+pbSplitClausePart :: Solver -> ([(Integer,Lit)], Integer) -> IO ([(Integer,Lit)], Integer)
+pbSplitClausePart solver (lhs,rhs) = do
+  let (ts1,ts2) = partition (\(c,_) -> c >= rhs) lhs
+  if length ts1 < 2 then
+    return (lhs,rhs)    
+  else do
+    sel <- newVar solver
+    addClause solver $ -sel : [l | (_,l) <- ts1]
+    return ((rhs,sel) : ts2, rhs)
+
+-- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … ≤ n/.
+addPBAtMost :: Solver          -- ^ The 'Solver' argument.
+            -> [(Integer,Lit)] -- ^ list of @[(c1,l1),(c2,l2),…]@
+            -> Integer         -- ^ /n/
+            -> IO ()
+addPBAtMost solver ts n = addPBAtLeast solver [(-c,l) | (c,l) <- ts] (negate n)
+
+-- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … = n/.
+addPBExactly :: Solver          -- ^ The 'Solver' argument.
+             -> [(Integer,Lit)] -- ^ list of terms @[(c1,l1),(c2,l2),…]@
+             -> Integer         -- ^ /n/
+             -> IO ()
+addPBExactly solver ts n = do
+  (ts2,n2) <- liftM normalizePBLinExactly $ instantiatePBLinExactly (getLitFixed solver) (ts,n)
+  addPBAtLeast solver ts2 n2
+  addPBAtMost solver ts2 n2
+
+-- | Add a soft pseudo boolean constraints /sel ⇒ c1*l1 + c2*l2 + … ≥ n/.
+addPBAtLeastSoft
+  :: Solver          -- ^ The 'Solver' argument.
+  -> Lit             -- ^ Selector literal @sel@
+  -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
+  -> Integer         -- ^ /n/
+  -> IO ()
+addPBAtLeastSoft solver sel lhs rhs = do
+  (lhs', rhs') <- liftM normalizePBLinAtLeast $ instantiatePBLinAtLeast (getLitFixed solver) (lhs,rhs)
+  addPBAtLeast solver ((rhs', litNot sel) : lhs') rhs'
+
+-- | Add a soft pseudo boolean constraints /sel ⇒ c1*l1 + c2*l2 + … ≤ n/.
+addPBAtMostSoft
+  :: Solver          -- ^ The 'Solver' argument.
+  -> Lit             -- ^ Selector literal @sel@
+  -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
+  -> Integer         -- ^ /n/
+  -> IO ()
+addPBAtMostSoft solver sel lhs rhs =
+  addPBAtLeastSoft solver sel [(negate c, lit) | (c,lit) <- lhs] (negate rhs)
+
+-- | Add a soft pseudo boolean constraints /sel ⇒ c1*l1 + c2*l2 + … = n/.
+addPBExactlySoft
+  :: Solver          -- ^ The 'Solver' argument.
+  -> Lit             -- ^ Selector literal @sel@
+  -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@
+  -> Integer         -- ^ /n/
+  -> IO ()
+addPBExactlySoft solver sel lhs rhs = do
+  (lhs2, rhs2) <- liftM normalizePBLinExactly $ instantiatePBLinExactly (getLitFixed solver) (lhs,rhs)
+  addPBAtLeastSoft solver sel lhs2 rhs2
+  addPBAtMostSoft solver sel lhs2 rhs2
+
+-- | Add a parity constraint /l1 ⊕ l2 ⊕ … ⊕ ln = rhs/
+addXORClause
+  :: Solver -- ^ The 'Solver' argument.
+  -> [Lit]  -- ^ literals @[l1, l2, …, ln]@
+  -> Bool   -- ^ /rhs/
+  -> IO ()
+addXORClause solver lits rhs = do
+  d <- getDecisionLevel solver
+  assert (d == levelRoot) $ return ()
+
+  ok <- readIORef (svOk solver)
+  when ok $ do
+    xcl <- instantiateXORClause (getLitFixed solver) (lits,rhs)
+    case normalizeXORClause xcl of
+      ([], True) -> markBad solver
+      ([], False) -> return ()
+      ([l], b) -> addClause solver [if b then l else litNot l]
+      (l:ls, b) -> do
+        c <- newXORClauseHandler ((if b then l else litNot l) : ls) False
+        addToDB solver c
+        _ <- basicAttachXORClauseHandler solver c
+        return ()
+
+-- | Add a soft parity constraint /sel ⇒ l1 ⊕ l2 ⊕ … ⊕ ln = rhs/
+addXORClauseSoft
+  :: Solver -- ^ The 'Solver' argument.
+  -> Lit    -- ^ Selector literal @sel@
+  -> [Lit]  -- ^ literals @[l1, l2, …, ln]@
+  -> Bool   -- ^ /rhs/
+  -> IO ()
+addXORClauseSoft solver sel lits rhs = do
+  reified <- newVar solver
+  addXORClause solver (litNot reified : lits) rhs
+  addClause solver [litNot sel, reified] -- sel ⇒ reified
+
+{--------------------------------------------------------------------
+  Problem solving
+--------------------------------------------------------------------}
+
+-- | Solve constraints.
+-- Returns 'True' if the problem is SATISFIABLE.
+-- Returns 'False' if the problem is UNSATISFIABLE.
+solve :: Solver -> IO Bool
+solve solver = do
+  Vec.clear (svAssumptions solver)
+  solve_ solver
+
+-- | Solve constraints under assuptions.
+-- Returns 'True' if the problem is SATISFIABLE.
+-- Returns 'False' if the problem is UNSATISFIABLE.
+solveWith :: Solver
+          -> [Lit]    -- ^ Assumptions
+          -> IO Bool
+solveWith solver ls = do
+  Vec.clear (svAssumptions solver)
+  mapM_ (Vec.push (svAssumptions solver)) ls
+  solve_ solver
+
+solve_ :: Solver -> IO Bool
+solve_ solver = do
+  log solver "Solving starts ..."
+  resetStat solver
+  writeIORef (svModel solver) Nothing
+  writeIORef (svFailedAssumptions solver) []
+
+  ok <- readIORef (svOk solver)
+  if not ok then
+    return False
+  else do
+    when debugMode $ dumpVarActivity solver
+    d <- getDecisionLevel solver
+    assert (d == levelRoot) $ return ()
+
+    nv <- getNVars solver
+    Vec.resizeCapacity (svTrail solver) nv
+
+    restartStrategy <- readIORef (svRestartStrategy solver)
+    restartFirst  <- readIORef (svRestartFirst solver)
+    restartInc    <- readIORef (svRestartInc solver)
+    let restartSeq =
+          if restartFirst > 0
+          then mkRestartSeq restartStrategy restartFirst restartInc
+          else repeat 0
+
+    let learntSizeAdj = do
+          (size,adj) <- shift (svLearntLimSeq solver)
+          writeIORef (svLearntLim solver) size
+          writeIORef (svLearntLimAdjCnt solver) adj
+        onConflict = do
+          cnt <- readIORef (svLearntLimAdjCnt solver)
+          if (cnt==0)
+          then learntSizeAdj
+          else writeIORef (svLearntLimAdjCnt solver) $! cnt-1
+
+    cnt <- readIORef (svLearntLimAdjCnt solver)
+    when (cnt == -1) $ do
+      learntSizeFirst <- readIORef (svLearntSizeFirst solver)
+      learntSizeInc   <- readIORef (svLearntSizeInc solver)
+      nc <- getNConstraints solver
+      let initialLearntLim = if learntSizeFirst > 0 then learntSizeFirst else max ((nc + nv) `div` 3) 16
+          learntSizeSeq    = iterate (ceiling . (learntSizeInc*) . fromIntegral) initialLearntLim
+          learntSizeAdjSeq = iterate (\x -> (x * 3) `div` 2) (100::Int)
+      writeIORef (svLearntLimSeq solver) (zip learntSizeSeq learntSizeAdjSeq)
+      learntSizeAdj
+
+    let loop [] = error "solve_: should not happen"
+        loop (conflict_lim:rs) = do
+          printStat solver True
+          ret <- search solver conflict_lim onConflict
+          case ret of
+            SRFinished x -> return $ Just x
+            SRBudgetExceeded -> return Nothing
+            SRRestart -> do
+              modifyIOURef (svNRestart solver) (+1)
+              backtrackTo solver levelRoot
+              loop rs
+
+    printStatHeader solver
+
+    startCPU <- getCPUTime
+    startWC  <- getCurrentTime
+    writeIORef (svStartWC solver) startWC
+    result <- loop restartSeq
+    endCPU <- getCPUTime
+    endWC  <- getCurrentTime
+
+    when (result == Just True) $ do
+      checkModel <- readIORef (svCheckModel solver)
+      when checkModel $ checkSatisfied solver
+      constructModel solver
+
+    backtrackTo solver levelRoot
+
+    when debugMode $ dumpVarActivity solver
+    when debugMode $ dumpConstrActivity solver
+    printStat solver True
+    (log solver . printf "#cpu_time = %.3fs") (fromIntegral (endCPU - startCPU) / 10^(12::Int) :: Double)
+    (log solver . printf "#wall_clock_time = %.3fs") (realToFrac (endWC `diffUTCTime` startWC) :: Double)
+    (log solver . printf "#decision = %d") =<< readIOURef (svNDecision solver)
+    (log solver . printf "#random_decision = %d") =<< readIOURef (svNRandomDecision solver)
+    (log solver . printf "#conflict = %d") =<< readIOURef (svNConflict solver)
+    (log solver . printf "#restart = %d")  =<< readIOURef (svNRestart solver)
+
+    case result of
+      Just x  -> return x
+      Nothing -> throw BudgetExceeded
+
+data BudgetExceeded = BudgetExceeded
+  deriving (Show, Typeable)
+
+instance Exception BudgetExceeded
+
+data SearchResult
+  = SRFinished Bool
+  | SRRestart
+  | SRBudgetExceeded
+
+search :: Solver -> Int -> IO () -> IO SearchResult
+search solver !conflict_lim onConflict = do
+  conflictCounter <- newIORef 0
+  let 
+    loop :: IO SearchResult
+    loop = do
+      conflict <- deduce solver
+      case conflict of
+        Just constr -> do
+          ret <- handleConflict conflictCounter constr
+          case ret of
+            Just sr -> return sr
+            Nothing -> loop
+        Nothing -> do
+          lv <- getDecisionLevel solver
+          when (lv == levelRoot) $ simplify solver
+          checkGC
+          r <- pickAssumption
+          case r of
+            Nothing -> return (SRFinished False)
+            Just lit
+              | lit /= litUndef -> decide solver lit >> loop
+              | otherwise -> do
+                  lit2 <- pickBranchLit solver
+                  if lit2 == litUndef
+                    then return (SRFinished True)
+                    else decide solver lit2 >> loop
+  loop
+
+  where
+    checkGC :: IO ()
+    checkGC = do
+      n <- getNLearntConstraints solver
+      m <- getNAssigned solver
+      learnt_lim <- readIORef (svLearntLim solver)
+      when (learnt_lim >= 0 && n - m > learnt_lim) $ do
+        modifyIOURef (svNLearntGC solver) (+1)
+        reduceDB solver
+
+    pickAssumption :: IO (Maybe Lit)
+    pickAssumption = do
+      s <- Vec.getSize (svAssumptions solver)
+      let go = do
+              d <- getDecisionLevel solver
+              if not (d < s) then
+                return (Just litUndef)
+              else do
+                l <- Vec.unsafeRead (svAssumptions solver) d
+                val <- litValue solver l
+                if val == lTrue then do
+                  -- dummy decision level
+                  pushDecisionLevel solver
+                  go
+                else if val == lFalse then do
+                  -- conflict with assumption
+                  core <- analyzeFinal solver l
+                  writeIORef (svFailedAssumptions solver) core
+                  return Nothing
+                else
+                  return (Just l)
+      go
+
+    handleConflict :: IORef Int -> SomeConstraintHandler -> IO (Maybe SearchResult)
+    handleConflict conflictCounter constr = do
+      varDecayActivity solver
+      constrDecayActivity solver
+      onConflict
+
+      modifyIOURef (svNConflict solver) (+1)
+      d <- getDecisionLevel solver
+
+      when debugMode $ logIO solver $ do
+        str <- showConstraintHandler constr
+        return $ printf "conflict(level=%d): %s" d str
+
+      modifyIORef' conflictCounter (+1)
+      c <- readIORef conflictCounter
+
+      modifyIOURef (svConfBudget solver) $ \confBudget ->
+        if confBudget > 0 then confBudget - 1 else confBudget
+      confBudget <- readIOURef (svConfBudget solver)
+
+      when (c `mod` 100 == 0) $ do
+        printStat solver False
+
+      if d == levelRoot then do
+        markBad solver
+        return $ Just (SRFinished False)
+      else if confBudget==0 then
+        return $ Just SRBudgetExceeded
+      else if conflict_lim > 0 && c >= conflict_lim then
+        return $ Just SRRestart
+      else do
+        strat <- readIORef (svLearningStrategy solver)
+        case strat of
+          LearningClause -> learnClause constr >> return Nothing
+          LearningHybrid -> learnHybrid conflictCounter constr
+
+    learnClause :: SomeConstraintHandler -> IO ()
+    learnClause constr = do
+      (learntClause, level) <- analyzeConflict solver constr
+      backtrackTo solver level
+      case learntClause of
+        [] -> error "search(LearningClause): should not happen"
+        [lit] -> do
+          ret <- assign solver lit
+          assert ret $ return ()
+          return ()
+        lit:_ -> do
+          cl <- newClauseHandler learntClause True
+          let constr = toConstraintHandler cl
+          addToLearntDB solver constr
+          basicAttachClauseHandler solver cl
+          assignBy solver lit constr
+          constrBumpActivity solver constr
+
+    learnHybrid :: IORef Int -> SomeConstraintHandler -> IO (Maybe SearchResult)
+    learnHybrid conflictCounter constr = do
+      ((learntClause, clauseLevel), (pb, pbLevel)) <- analyzeConflictHybrid solver constr
+      let minLevel = min clauseLevel pbLevel
+      backtrackTo solver minLevel
+
+      case learntClause of
+        [] -> error "search(LearningHybrid): should not happen"
+        [lit] -> do
+          _ <- assign solver lit -- This should always succeed.
+          return ()
+        lit:_ -> do
+          cl <- newClauseHandler learntClause True
+          let constr = toConstraintHandler cl
+          addToLearntDB solver constr
+          basicAttachClauseHandler solver cl
+          constrBumpActivity solver constr
+          when (minLevel == clauseLevel) $ do
+            _ <- assignBy solver lit constr -- This should always succeed.
+            return ()
+
+      ret <- deduce solver
+      case ret of
+        Just conflicted -> do
+          handleConflict conflictCounter conflicted
+          -- TODO: should also learn the PB constraint?
+        Nothing -> do
+          let (lhs,rhs) = pb
+          h <- newPBHandlerPromoted solver lhs rhs True
+          case h of
+            CHClause _ -> do
+              {- We don't want to add additional clause,
+                 since it would be subsumed by already added one. -}
+              return Nothing
+            _ -> do
+              addToLearntDB solver h
+              ret2 <- attach solver h
+              constrBumpActivity solver h
+              if ret2 then
+                return Nothing
+              else
+                handleConflict conflictCounter h
+
+-- | After 'solve' returns True, it returns an satisfying assignment.
+getModel :: Solver -> IO Model
+getModel solver = do
+  m <- readIORef (svModel solver)
+  return (fromJust m)
+
+-- | After 'solveWith' returns False, it returns a set of assumptions
+-- that leads to contradiction. In particular, if it returns an empty
+-- set, the problem is unsatisiable without any assumptions.
+getFailedAssumptions :: Solver -> IO [Lit]
+getFailedAssumptions solver = readIORef (svFailedAssumptions solver)
+
+{--------------------------------------------------------------------
+  Simplification
+--------------------------------------------------------------------}
+
+-- | Simplify the constraint database according to the current top-level assigment.
+simplify :: Solver -> IO ()
+simplify solver = do
+  let loop [] rs !n     = return (rs,n)
+      loop (y:ys) rs !n = do
+        b1 <- isSatisfied solver y
+        b2 <- isLocked solver y
+        if b1 && not b2 then do
+          detach solver y
+          loop ys rs (n+1)
+        else loop ys (y:rs) n
+
+  -- simplify original constraint DB
+  do
+    xs <- readIORef (svConstrDB solver)
+    (ys,n) <- loop xs [] (0::Int)
+    modifyIOURef (svNRemovedConstr solver) (+n)
+    writeIORef (svConstrDB solver) ys
+
+  -- simplify learnt constraint DB
+  do
+    (m,xs) <- readIORef (svLearntDB solver)
+    (ys,n) <- loop xs [] (0::Int)
+    writeIORef (svLearntDB solver) (m-n, ys)
+
+{-
+References:
+L. Zhang, "On subsumption removal and On-the-Fly CNF simplification,"
+Theory and Applications of Satisfiability Testing (2005), pp. 482-489.
+-}
+
+checkForwardSubsumption :: Solver -> Clause -> IO Bool
+checkForwardSubsumption solver lits = do
+  flag <- getEnableForwardSubsumptionRemoval solver
+  if not flag then
+    return False
+  else do
+    withEnablePhaseSaving solver False $ do
+      bracket_
+        (pushDecisionLevel solver)
+        (backtrackTo solver levelRoot) $ do
+          b <- allM (\lit -> assign solver (litNot lit)) lits
+          if b then
+            liftM isJust (deduce solver)
+          else do
+            when debugMode $ log solver ("forward subsumption: " ++ show lits)
+            return True
+  where
+    withEnablePhaseSaving solver flag m =
+      bracket
+        (getEnablePhaseSaving solver)
+        (setEnablePhaseSaving solver)
+        (\_ -> setEnablePhaseSaving solver flag >> m)
+
+removeBackwardSubsumedBy :: Solver -> PBLinAtLeast -> IO ()
+removeBackwardSubsumedBy solver pb = do
+  flag <- getEnableBackwardSubsumptionRemoval solver
+  when flag $ do
+    xs <- backwardSubsumedBy solver pb
+    when debugMode $ do
+      forM_ (HashSet.toList xs) $ \c -> do
+        s <- showConstraintHandler c
+        log solver (printf "backward subsumption: %s is subsumed by %s\n" s (show pb))
+    removeConstraintHandlers solver xs
+
+backwardSubsumedBy :: Solver -> PBLinAtLeast -> IO (HashSet SomeConstraintHandler)
+backwardSubsumedBy solver pb@(lhs,_) = do
+  xs <- forM lhs $ \(_,lit) -> do
+    ld <- litData solver lit
+    readIORef (ldOccurList ld)
+  case xs of
+    [] -> return HashSet.empty
+    s:ss -> do
+      let p c = do
+            -- Note that @isPBRepresentable c@ is always True here,
+            -- because only such constraints are added to occur list.
+            -- See 'addToDB'.
+            pb2 <- instantiatePBLinAtLeast (getLitFixed solver) =<< toPBLinAtLeast c
+            return $ pbSubsume pb pb2
+      liftM HashSet.fromList
+        $ filterM p
+        $ HashSet.toList
+        $ foldl' HashSet.intersection s ss
+
+removeConstraintHandlers :: Solver -> HashSet SomeConstraintHandler -> IO ()
+removeConstraintHandlers _ zs | HashSet.null zs = return ()
+removeConstraintHandlers solver zs = do
+  let loop [] rs !n     = return (rs,n)
+      loop (c:cs) rs !n = do
+        if c `HashSet.member` zs then do
+          detach solver c
+          loop cs rs (n+1)
+        else loop cs (c:rs) n
+  xs <- readIORef (svConstrDB solver)
+  (ys,n) <- loop xs [] (0::Int)
+  modifyIOURef (svNRemovedConstr solver) (+n)
+  writeIORef (svConstrDB solver) ys
+
+{--------------------------------------------------------------------
+  Parameter settings.
+--------------------------------------------------------------------}
+
+setRestartStrategy :: Solver -> RestartStrategy -> IO ()
+setRestartStrategy solver s = writeIORef (svRestartStrategy solver) s
+
+-- | default value for @RestartStrategy@.
+defaultRestartStrategy :: RestartStrategy
+defaultRestartStrategy = MiniSATRestarts
+
+-- | The initial restart limit. (default 100)
+-- Zero and negative values are used to disable restart.
+setRestartFirst :: Solver -> Int -> IO ()
+setRestartFirst solver !n = writeIORef (svRestartFirst solver) n
+
+-- | default value for @RestartFirst@.
+defaultRestartFirst :: Int
+defaultRestartFirst = 100
+
+-- | The factor with which the restart limit is multiplied in each restart. (default 1.5)
+-- 
+-- This must be @>1@.
+setRestartInc :: Solver -> Double -> IO ()
+setRestartInc solver !r
+  | r > 1 = writeIORef (svRestartInc solver) r
+  | otherwise = error "setRestartInc: RestartInc must be >1"
+
+-- | default value for @RestartInc@.
+defaultRestartInc :: Double
+defaultRestartInc = 1.5
+
+data LearningStrategy
+  = LearningClause
+  | LearningHybrid
+  deriving (Show, Eq, Ord, Enum, Bounded)
+
+setLearningStrategy :: Solver -> LearningStrategy -> IO ()
+setLearningStrategy solver l = writeIORef (svLearningStrategy solver) $! l
+
+defaultLearningStrategy :: LearningStrategy
+defaultLearningStrategy = LearningClause
+
+-- | The initial limit for learnt clauses.
+-- 
+-- Negative value means computing default value from problem instance.
+setLearntSizeFirst :: Solver -> Int -> IO ()
+setLearntSizeFirst solver !x = writeIORef (svLearntSizeFirst solver) x
+
+-- | default value for @LearntSizeFirst@.
+defaultLearntSizeFirst :: Int
+defaultLearntSizeFirst = -1
+
+-- | The limit for learnt clauses is multiplied with this factor each restart. (default 1.1)
+-- 
+-- This must be @>1@.
+setLearntSizeInc :: Solver -> Double -> IO ()
+setLearntSizeInc solver !r
+  | r > 1 = writeIORef (svLearntSizeInc solver) r
+  | otherwise = error "setLearntSizeInc: LearntSizeInc must be >1"
+
+-- | default value for @LearntSizeInc@.
+defaultLearntSizeInc :: Double
+defaultLearntSizeInc = 1.1
+
+-- | Controls conflict clause minimization (0=none, 1=basic, 2=deep)
+setCCMin :: Solver -> Int -> IO ()
+setCCMin solver !v = writeIORef (svCCMin solver) v
+
+-- | default value for @CCMin@.
+defaultCCMin :: Int
+defaultCCMin = 2
+
+-- | The default polarity of a variable.
+setVarPolarity :: Solver -> Var -> Bool -> IO ()
+setVarPolarity solver v val = do
+  vd <- varData solver v
+  writeIORef (vdPolarity vd) val
+
+setCheckModel :: Solver -> Bool -> IO ()
+setCheckModel solver flag = do
+  writeIORef (svCheckModel solver) flag
+
+-- | The frequency with which the decision heuristic tries to choose a random variable
+setRandomFreq :: Solver -> Double -> IO ()
+setRandomFreq solver r = do
+  writeIORef (svRandomFreq solver) r
+
+defaultRandomFreq :: Double
+defaultRandomFreq = 0.005
+
+-- | Set random generator used by the random variable selection
+setRandomGen :: Solver -> Rand.StdGen -> IO ()
+setRandomGen solver = writeIORef (svRandomGen solver)
+
+-- | Get random generator used by the random variable selection
+getRandomGen :: Solver -> IO Rand.StdGen
+getRandomGen solver = readIORef (svRandomGen solver)
+
+setConfBudget :: Solver -> Maybe Int -> IO ()
+setConfBudget solver (Just b) | b >= 0 = writeIOURef (svConfBudget solver) b
+setConfBudget solver _ = writeIOURef (svConfBudget solver) (-1)
+
+data PBHandlerType = PBHandlerTypeCounter | PBHandlerTypePueblo
+  deriving (Show, Eq, Ord, Enum, Bounded)
+
+defaultPBHandlerType :: PBHandlerType
+defaultPBHandlerType = PBHandlerTypeCounter
+
+setPBHandlerType :: Solver -> PBHandlerType -> IO ()
+setPBHandlerType solver ht = do
+  writeIORef (svPBHandlerType solver) ht
+
+-- | Split PB-constraints into a PB part and a clause part.
+--
+-- Example from minisat+ paper:
+--
+-- * 4 x1 + 4 x2 + 4 x3 + 4 x4 + 2y1 + y2 + y3 ≥ 4
+-- 
+-- would be split into
+--
+-- * x1 + x2 + x3 + x4 + ¬z ≥ 1 (clause part)
+--
+-- * 2 y1 + y2 + y3 + 4 z ≥ 4 (PB part)
+--
+-- where z is a newly introduced variable, not present in any other constraint.
+-- 
+-- Reference:
+-- 
+-- * N . Eéen and N. Sörensson. Translating Pseudo-Boolean Constraints into SAT. JSAT 2:1–26, 2006.
+-- 
+setPBSplitClausePart :: Solver -> Bool -> IO ()
+setPBSplitClausePart solver b =
+  writeIORef (svPBSplitClausePart solver) b
+
+-- | See documentation of 'setPBSplitClausePart'.
+getPBSplitClausePart :: Solver -> IO Bool
+getPBSplitClausePart solver = readIORef (svPBSplitClausePart solver)
+
+-- | See documentation of 'setPBSplitClausePart'.
+defaultPBSplitClausePart :: Bool
+defaultPBSplitClausePart = False
+
+setEnablePhaseSaving :: Solver -> Bool -> IO ()
+setEnablePhaseSaving solver flag = do
+  writeIORef (svEnablePhaseSaving solver) flag
+
+getEnablePhaseSaving :: Solver -> IO Bool
+getEnablePhaseSaving solver = do
+  readIORef (svEnablePhaseSaving solver)
+
+defaultEnablePhaseSaving :: Bool
+defaultEnablePhaseSaving = True
+
+setEnableForwardSubsumptionRemoval :: Solver -> Bool -> IO ()
+setEnableForwardSubsumptionRemoval solver flag = do
+  writeIORef (svEnableForwardSubsumptionRemoval solver) flag
+
+getEnableForwardSubsumptionRemoval :: Solver -> IO Bool
+getEnableForwardSubsumptionRemoval solver = do
+  readIORef (svEnableForwardSubsumptionRemoval solver)
+
+defaultEnableForwardSubsumptionRemoval :: Bool
+defaultEnableForwardSubsumptionRemoval = False
+
+setEnableBackwardSubsumptionRemoval :: Solver -> Bool -> IO ()
+setEnableBackwardSubsumptionRemoval solver flag = do
+  writeIORef (svEnableBackwardSubsumptionRemoval solver) flag
+
+getEnableBackwardSubsumptionRemoval :: Solver -> IO Bool
+getEnableBackwardSubsumptionRemoval solver = do
+  readIORef (svEnableBackwardSubsumptionRemoval solver)
+
+defaultEnableBackwardSubsumptionRemoval :: Bool
+defaultEnableBackwardSubsumptionRemoval = False
+
+{--------------------------------------------------------------------
+  API for implementation of @solve@
+--------------------------------------------------------------------}
+
+pickBranchLit :: Solver -> IO Lit
+pickBranchLit !solver = do
+  let vqueue = svVarQueue solver
+
+  -- Random decision
+  let withRandGen :: (Rand.StdGen -> (a, Rand.StdGen)) -> IO a
+      withRandGen f = do
+        randgen  <- readIORef (svRandomGen solver)
+        let (r, randgen') = f randgen
+        writeIORef (svRandomGen solver) randgen'
+        return r
+  !randfreq <- readIORef (svRandomFreq solver)
+  !size <- PQ.queueSize vqueue
+  !r <- withRandGen Rand.random
+  var <-
+    if (r < randfreq && size >= 2) then do
+      a <- PQ.getHeapArray vqueue
+      i <- withRandGen $ Rand.randomR (0, size-1)
+      var <- readArray a i
+      val <- varValue solver var
+      if val == lUndef then do
+        modifyIOURef (svNRandomDecision solver) (1+)
+        return var
+      else return litUndef
+    else
+      return litUndef
+
+  -- Activity based decision
+  let loop :: IO Var
+      loop = do
+        m <- PQ.dequeue vqueue
+        case m of
+          Nothing -> return litUndef
+          Just var2 -> do
+            val2 <- varValue solver var2
+            if val2 /= lUndef
+              then loop
+              else return var2
+  var2 <-
+    if var==litUndef
+    then loop
+    else return var
+
+  if var2==litUndef then
+    return litUndef
+  else do
+    vd <- varData solver var2
+    -- TODO: random polarity
+    p <- readIORef (vdPolarity vd)
+    return $! literal var2 p
+
+decide :: Solver -> Lit -> IO ()
+decide solver !lit = do
+  modifyIOURef (svNDecision solver) (+1)
+  pushDecisionLevel solver
+  when debugMode $ do
+    val <- litValue solver lit
+    when (val /= lUndef) $ error "decide: should not happen"
+  assign solver lit
+  return ()
+
+deduce :: Solver -> IO (Maybe SomeConstraintHandler)
+deduce solver = do
+  m <- deduceB solver
+  case m of
+    Just _ -> return m
+    Nothing -> do
+      m2 <- deduceT solver
+      case m2 of
+        Just _ -> return m2
+        Nothing -> do
+          empty <- bcpIsEmpty solver
+          if empty then
+            return Nothing
+          else
+            deduce solver
+
+deduceB :: Solver -> IO (Maybe SomeConstraintHandler)
+deduceB solver = loop
+  where
+    loop :: IO (Maybe SomeConstraintHandler)
+    loop = do
+      r <- bcpDequeue solver
+      case r of
+        Nothing -> return Nothing
+        Just lit -> do
+          ret <- processLit lit
+          case ret of
+            Just _ -> return ret
+            Nothing -> do
+              ret <- processVar (litVar lit)
+              case ret of
+                Just _ -> return ret
+                Nothing -> loop
+
+    processLit :: Lit -> IO (Maybe SomeConstraintHandler)
+    processLit !lit = do
+      let falsifiedLit = litNot lit
+      ld <- litData solver falsifiedLit
+      let wsref = ldWatches ld
+      let loop2 [] = return Nothing
+          loop2 (w:ws) = do
+            ok <- propagate solver w falsifiedLit
+            if ok then
+              loop2 ws
+            else do
+              modifyIORef wsref (++ws)
+              return (Just w)
+      ws <- readIORef wsref
+      writeIORef wsref []
+      loop2 ws
+
+    processVar :: Lit -> IO (Maybe SomeConstraintHandler)
+    processVar !lit = do
+      let falsifiedLit = litNot lit
+      vd <- varData solver (litVar lit)
+      let wsref = vdWatches vd
+      let loop2 [] = return Nothing
+          loop2 (w:ws) = do
+            ok <- propagate solver w falsifiedLit
+            if ok
+              then loop2 ws
+              else do
+                modifyIORef wsref (++ws)
+                return (Just w)
+      ws <- readIORef wsref
+      writeIORef wsref []
+      loop2 ws
+
+analyzeConflict :: ConstraintHandler c => Solver -> c -> IO (Clause, Level)
+analyzeConflict solver constr = do
+  d <- getDecisionLevel solver
+
+  let split :: [Lit] -> IO (LitSet, LitSet)
+      split = go (IS.empty, IS.empty)
+        where
+          go (xs,ys) [] = return (xs,ys)
+          go (xs,ys) (l:ls) = do
+            lv <- litLevel solver l
+            if lv == levelRoot then
+              go (xs,ys) ls
+            else if lv >= d then
+              go (IS.insert l xs, ys) ls
+            else
+              go (xs, IS.insert l ys) ls
+
+  let loop :: LitSet -> LitSet -> IO LitSet
+      loop lits1 lits2
+        | sz==1 = do
+            return $ lits1 `IS.union` lits2
+        | sz>=2 = do
+            l <- peekTrail solver
+            if litNot l `IS.notMember` lits1 then do
+              popTrail solver
+              loop lits1 lits2
+            else do
+              m <- varReason solver (litVar l)
+              case m of
+                Nothing -> error "analyzeConflict: should not happen"
+                Just constr2 -> do
+                  constrBumpActivity solver constr2
+                  xs <- reasonOf solver constr2 (Just l)
+                  forM_ xs $ \lit -> varBumpActivity solver (litVar lit)
+                  popTrail solver
+                  (ys,zs) <- split xs
+                  loop (IS.delete (litNot l) lits1 `IS.union` ys)
+                       (lits2 `IS.union` zs)
+        | otherwise = error "analyzeConflict: should not happen: reason of current level is empty"
+        where
+          sz = IS.size lits1
+
+  constrBumpActivity solver constr
+  conflictClause <- reasonOf solver constr Nothing
+  forM_ conflictClause $ \lit -> varBumpActivity solver (litVar lit)
+  (ys,zs) <- split conflictClause
+  lits <- loop ys zs
+
+  lits2 <- minimizeConflictClause solver lits
+
+  xs <- liftM (sortBy (flip (comparing snd))) $
+    forM (IS.toList lits2) $ \l -> do
+      lv <- litLevel solver l
+      return (l,lv)
+
+  let level = case xs of
+                [] -> error "analyzeConflict: should not happen"
+                [_] -> levelRoot
+                _:(_,lv):_ -> lv
+  return (map fst xs, level)
+
+-- { p } ∪ { pにfalseを割り当てる原因のassumption }
+analyzeFinal :: Solver -> Lit -> IO [Lit]
+analyzeFinal solver p = do
+  let go :: Int -> VarSet -> [Lit] -> IO [Lit]
+      go i seen result
+        | i < 0 = return result
+        | otherwise = do
+            l <- Vec.unsafeRead (svTrail solver) i
+            lv <- litLevel solver l
+            if lv == levelRoot then
+              return result
+            else if litVar l `IS.member` seen then do
+              r <- varReason solver (litVar l)
+              case r of
+                Nothing -> do
+                  let seen' = IS.delete (litVar l) seen
+                  go (i-1) seen' (l : result)
+                Just constr  -> do
+                  c <- reasonOf solver constr (Just l)
+                  let seen' = IS.delete (litVar l) seen `IS.union` IS.fromList [litVar l2 | l2 <- c]
+                  go (i-1) seen' result
+            else
+              go (i-1) seen result
+  n <- Vec.getSize (svTrail solver)
+  go (n-1) (IS.singleton (litVar p)) [p]
+
+analyzeConflictHybrid :: ConstraintHandler c => Solver -> c -> IO ((Clause, Level), (PBLinAtLeast, Level))
+analyzeConflictHybrid solver constr = do
+  d <- getDecisionLevel solver
+
+  let split :: [Lit] -> IO (LitSet, LitSet)
+      split = go (IS.empty, IS.empty)
+        where
+          go (xs,ys) [] = return (xs,ys)
+          go (xs,ys) (l:ls) = do
+            lv <- litLevel solver l
+            if lv == levelRoot then
+              go (xs,ys) ls
+            else if lv >= d then
+              go (IS.insert l xs, ys) ls
+            else
+              go (xs, IS.insert l ys) ls
+
+  let loop :: LitSet -> LitSet -> PBLinAtLeast -> IO (LitSet, PBLinAtLeast)
+      loop lits1 lits2 pb
+        | sz==1 = do
+            return $ (lits1 `IS.union` lits2, pb)
+        | sz>=2 = do
+            l <- peekTrail solver
+            m <- varReason solver (litVar l)
+            case m of
+              Nothing -> error "analyzeConflictHybrid: should not happen"
+              Just constr2 -> do
+                xs <- reasonOf solver constr2 (Just l)
+                (lits1',lits2') <-
+                  if litNot l `IS.notMember` lits1 then
+                    return (lits1,lits2)
+                  else do
+                    constrBumpActivity solver constr2
+                    forM_ xs $ \lit -> varBumpActivity solver (litVar lit)
+                    (ys,zs) <- split xs
+                    return  (IS.delete (litNot l) lits1 `IS.union` ys, lits2 `IS.union` zs)
+
+                pb' <- if any (\(_,l2) -> litNot l == l2) (fst pb)
+                       then do
+                         pb2 <- do
+                           b <- isPBRepresentable constr2
+                           if not b then do
+                             return $ clauseToPBLinAtLeast (l:xs)
+                           else do
+                             pb2 <- toPBLinAtLeast constr2
+                             o <- pbOverSAT solver pb2
+                             if o then
+                               return $ clauseToPBLinAtLeast (l:xs)
+                             else
+                               return pb2
+                         return $ cutResolve pb pb2 (litVar l)
+                       else return pb
+
+                popTrail solver
+                loop lits1' lits2' pb'
+
+        | otherwise = error "analyzeConflictHybrid: should not happen: reason of current level is empty"
+        where
+          sz = IS.size lits1
+
+  constrBumpActivity solver constr
+  conflictClause <- reasonOf solver constr Nothing
+  pbConfl <- do
+    b <- isPBRepresentable constr
+    if b then
+      toPBLinAtLeast constr
+    else
+      return (clauseToPBLinAtLeast conflictClause)
+  forM_ conflictClause $ \lit -> varBumpActivity solver (litVar lit)
+  (ys,zs) <- split conflictClause
+  (lits, pb) <- loop ys zs pbConfl
+
+  lits2 <- minimizeConflictClause solver lits
+
+  xs <- liftM (sortBy (flip (comparing snd))) $
+    forM (IS.toList lits2) $ \l -> do
+      lv <- litLevel solver l
+      return (l,lv)
+
+  let level = case xs of
+                [] -> error "analyzeConflict: should not happen"
+                [_] -> levelRoot
+                _:(_,lv):_ -> lv
+  pblevel <- pbBacktrackLevel solver pb
+  return ((map fst xs, level), (pb, pblevel))
+
+pbBacktrackLevel :: Solver -> PBLinAtLeast -> IO Level
+pbBacktrackLevel _ ([], rhs) = assert (rhs > 0) $ return levelRoot
+pbBacktrackLevel solver (lhs, rhs) = do
+  levelToLiterals <- liftM (IM.unionsWith IM.union) $ forM lhs $ \(_,lit) -> do
+    val <- litValue solver lit
+    if val /= lUndef then do
+      level <- litLevel solver lit
+      return $ IM.singleton level (IM.singleton lit val)
+    else
+      return $ IM.empty
+
+  let replay [] _ _ = error "pbBacktrackLevel: should not happen"
+      replay ((lv,lv_lits) : lvs) lhs slack = do
+        let slack_lv = slack - sum [c | (c,lit) <- lhs, IM.lookup lit lv_lits == Just lFalse]
+            lhs_lv   = [tm | tm@(_,lit) <- lhs, IM.notMember lit lv_lits]
+        if slack_lv < 0 then
+          return lv -- CONFLICT
+        else if any (\(c,_) -> c > slack_lv) lhs_lv then
+          return lv -- UNIT
+        else
+          replay lvs lhs_lv slack_lv
+
+  let initial_slack = sum [c | (c,_) <- lhs] - rhs
+  replay (IM.toList levelToLiterals) lhs initial_slack
+
+minimizeConflictClause :: Solver -> LitSet -> IO LitSet
+minimizeConflictClause solver lits = do
+  ccmin <- readIORef (svCCMin solver)
+  if ccmin >= 2 then
+    minimizeConflictClauseRecursive solver lits
+  else if ccmin >= 1 then
+    minimizeConflictClauseLocal solver lits
+  else
+    return lits
+
+minimizeConflictClauseLocal :: Solver -> LitSet -> IO LitSet
+minimizeConflictClauseLocal solver lits = do
+  let xs = IS.toAscList lits
+  ys <- filterM (liftM not . isRedundant) xs
+  when debugMode $ do
+    log solver "minimizeConflictClauseLocal:"
+    log solver $ show xs
+    log solver $ show ys
+  return $ IS.fromAscList $ ys
+
+  where
+    isRedundant :: Lit -> IO Bool
+    isRedundant lit = do
+      c <- varReason solver (litVar lit)
+      case c of
+        Nothing -> return False
+        Just c2 -> do
+          ls <- reasonOf solver c2 (Just (litNot lit))
+          allM test ls
+
+    test :: Lit -> IO Bool
+    test lit = do
+      lv <- litLevel solver lit
+      return $ lv == levelRoot || lit `IS.member` lits
+
+minimizeConflictClauseRecursive :: Solver -> LitSet -> IO LitSet
+minimizeConflictClauseRecursive solver lits = do
+  let
+    isRedundant :: Lit -> IO Bool
+    isRedundant lit = do
+      c <- varReason solver (litVar lit)
+      case c of
+        Nothing -> return False
+        Just c2 -> do
+          ls <- reasonOf solver c2 (Just (litNot lit))
+          go ls IS.empty
+
+    go :: [Lit] -> IS.IntSet -> IO Bool
+    go [] _ = return True
+    go (lit : ls) seen = do
+      lv <- litLevel solver lit
+      if lv == levelRoot || lit `IS.member` lits || lit `IS.member` seen then
+        go ls seen
+      else do
+        c <- varReason solver (litVar lit)
+        case c of
+          Nothing -> return False
+          Just c2 -> do
+            ls2 <- reasonOf solver c2 (Just (litNot lit))
+            go (ls2 ++ ls) (IS.insert lit seen)
+
+  let xs = IS.toAscList lits
+  ys <- filterM (liftM not . isRedundant) xs
+  when debugMode $ do
+    log solver "minimizeConflictClauseRecursive:"
+    log solver $ show xs
+    log solver $ show ys
+  return $ IS.fromAscList $ ys
+
+peekTrail :: Solver -> IO Lit
+peekTrail solver = do
+  n <- Vec.getSize (svTrail solver)
+  Vec.unsafeRead (svTrail solver) (n-1)
+
+popTrail :: Solver -> IO Lit
+popTrail solver = do
+  l <- Vec.unsafePop (svTrail solver)
+  unassign solver (litVar l)
+  return l
+
+getDecisionLevel ::Solver -> IO Int
+getDecisionLevel solver = Vec.getSize (svTrailLimit solver)
+
+pushDecisionLevel :: Solver -> IO ()
+pushDecisionLevel solver = do
+  Vec.push (svTrailLimit solver) =<< Vec.getSize (svTrail solver)
+  mt <- getTheory solver
+  case mt of
+    Nothing -> return ()
+    Just t -> thPushBacktrackPoint t
+
+popDecisionLevel :: Solver -> IO ()
+popDecisionLevel solver = do
+  n <- Vec.unsafePop (svTrailLimit solver)
+  let loop = do
+        m <- Vec.getSize (svTrail solver)
+        when (m > n) $ do
+          popTrail solver
+          loop
+  loop
+  mt <- getTheory solver
+  case mt of
+    Nothing -> return ()
+    Just t -> thPopBacktrackPoint t
+
+-- | Revert to the state at given level
+-- (keeping all assignment at @level@ but not beyond).
+backtrackTo :: Solver -> Int -> IO ()
+backtrackTo solver level = do
+  when debugMode $ log solver $ printf "backtrackTo: %d" level
+  loop
+  bcpClear solver
+  mt <- getTheory solver
+  case mt of
+    Nothing -> return ()
+    Just _ -> do
+      n <- Vec.getSize (svTrail solver)
+      writeIOURef (svTheoryChecked solver) n
+  where
+    loop :: IO ()
+    loop = do
+      lv <- getDecisionLevel solver
+      when (lv > level) $ do
+        popDecisionLevel solver        
+        loop
+
+constructModel :: Solver -> IO ()
+constructModel solver = do
+  n <- getNVars solver
+  (marr::IOUArray Var Bool) <- newArray_ (1,n)
+  forLoop 1 (<=n) (+1) $ \v -> do
+    vd <- varData solver v
+    val <- readIORef (vdValue vd)
+    writeArray marr v (fromJust (unliftBool val))
+  m <- unsafeFreeze marr
+  writeIORef (svModel solver) (Just m)
+
+constrDecayActivity :: Solver -> IO ()
+constrDecayActivity solver = do
+  d <- readIOURef (svConstrDecay solver)
+  modifyIOURef (svConstrInc solver) (d*)
+
+constrBumpActivity :: ConstraintHandler a => Solver -> a -> IO ()
+constrBumpActivity solver this = do
+  aval <- constrReadActivity this
+  when (aval >= 0) $ do -- learnt clause
+    inc <- readIOURef (svConstrInc solver)
+    let aval2 = aval+inc
+    constrWriteActivity this $! aval2
+    when (aval2 > 1e20) $
+      -- Rescale
+      constrRescaleAllActivity solver
+
+constrRescaleAllActivity :: Solver -> IO ()
+constrRescaleAllActivity solver = do
+  xs <- learntConstraints solver
+  forM_ xs $ \c -> do
+    aval <- constrReadActivity c
+    when (aval >= 0) $
+      constrWriteActivity c $! (aval * 1e-20)
+  modifyIOURef (svConstrInc solver) (* 1e-20)
+
+resetStat :: Solver -> IO ()
+resetStat solver = do
+  writeIOURef (svNDecision solver) 0
+  writeIOURef (svNRandomDecision solver) 0
+  writeIOURef (svNConflict solver) 0
+  writeIOURef (svNRestart solver) 0
+  writeIOURef (svNLearntGC solver) 0
+
+printStatHeader :: Solver -> IO ()
+printStatHeader solver = do
+  log solver $ "============================[ Search Statistics ]============================"
+  log solver $ " Time | Restart | Decision | Conflict |      LEARNT     | Fixed    | Removed "
+  log solver $ "      |         |          |          |    Limit     GC | Var      | Constra "
+  log solver $ "============================================================================="
+
+printStat :: Solver -> Bool -> IO ()
+printStat solver force = do
+  nowWC <- getCurrentTime
+  b <- if force
+       then return True
+       else do
+         lastWC <- readIORef (svLastStatWC solver)
+         return $ (nowWC `diffUTCTime` lastWC) > 1
+  when b $ do
+    startWC   <- readIORef (svStartWC solver)
+    let tm = showTimeDiff $ nowWC `diffUTCTime` startWC
+    restart   <- readIOURef (svNRestart solver)
+    dec       <- readIOURef (svNDecision solver)
+    conflict  <- readIOURef (svNConflict solver)
+    learntLim <- readIORef (svLearntLim solver)
+    learntGC  <- readIOURef (svNLearntGC solver)
+    fixed     <- getNFixed solver
+    removed   <- readIOURef (svNRemovedConstr solver)
+    log solver $ printf "%s | %7d | %8d | %8d | %8d %6d | %8d | %8d"
+      tm restart dec conflict learntLim learntGC fixed removed
+    writeIORef (svLastStatWC solver) nowWC
+
+showTimeDiff :: NominalDiffTime -> String
+showTimeDiff sec
+  | si <  100  = printf "%4.1fs" (fromRational s :: Double)
+  | si <= 9999 = printf "%4ds" si
+  | mi <  100  = printf "%4.1fm" (fromRational m :: Double)
+  | mi <= 9999 = printf "%4dm" mi
+  | hi <  100  = printf "%4.1fs" (fromRational h :: Double)
+  | otherwise  = printf "%4dh" hi
+  where
+    s :: Rational
+    s = realToFrac sec
+
+    si :: Integer
+    si = round s
+
+    m :: Rational
+    m = s / 60
+
+    mi :: Integer
+    mi = round m
+
+    h :: Rational
+    h = m / 60
+
+    hi :: Integer
+    hi = round h
+
+{--------------------------------------------------------------------
+  constraint implementation
+--------------------------------------------------------------------}
+
+class (Eq a, Hashable a) => ConstraintHandler a where
+  toConstraintHandler :: a -> SomeConstraintHandler
+
+  showConstraintHandler :: a -> IO String
+
+  constrAttach :: Solver -> SomeConstraintHandler -> a -> IO Bool
+
+  constrDetach :: Solver -> SomeConstraintHandler -> a -> IO ()
+
+  constrIsLocked :: Solver -> SomeConstraintHandler -> a -> IO Bool
+
+  -- | invoked with the watched literal when the literal is falsified.
+  -- 'watch' で 'toConstraint' を呼び出して heap allocation が発生するのを
+  -- 避けるために、元の 'SomeConstraintHandler' も渡しておく。
+  constrPropagate :: Solver -> SomeConstraintHandler -> a -> Lit -> IO Bool
+
+  -- | deduce a clause C∨l from the constraint and return C.
+  -- C and l should be false and true respectively under the current
+  -- assignment.
+  constrReasonOf :: Solver -> a -> Maybe Lit -> IO Clause
+
+  constrOnUnassigned :: Solver -> SomeConstraintHandler -> a -> Lit -> IO ()
+
+  isPBRepresentable :: a -> IO Bool
+  toPBLinAtLeast :: a -> IO PBLinAtLeast
+
+  isSatisfied :: Solver -> a -> IO Bool
+
+  constrIsProtected :: Solver -> a -> IO Bool
+  constrIsProtected _ _ = return False
+
+  constrWeight :: Solver -> a -> IO Double
+  constrWeight _ _ = return 1.0
+
+  constrReadActivity :: a -> IO Double
+
+  constrWriteActivity :: a -> Double -> IO ()
+
+attach :: Solver -> SomeConstraintHandler -> IO Bool
+attach solver c = constrAttach solver c c
+
+detach :: Solver -> SomeConstraintHandler -> IO ()
+detach solver c = do
+  constrDetach solver c c
+  b <- isPBRepresentable c
+  when b $ do
+    (lhs,_) <- toPBLinAtLeast c
+    forM_ lhs $ \(_,lit) -> do
+      ld <- litData solver lit
+      modifyIORef' (ldOccurList ld) (HashSet.delete c)
+
+-- | invoked with the watched literal when the literal is falsified.
+propagate :: Solver -> SomeConstraintHandler -> Lit -> IO Bool
+propagate solver c l = constrPropagate solver c c l
+
+-- | deduce a clause C∨l from the constraint and return C.
+-- C and l should be false and true respectively under the current
+-- assignment.
+reasonOf :: ConstraintHandler a => Solver -> a -> Maybe Lit -> IO Clause
+reasonOf solver c x = do
+  when debugMode $
+    case x of
+      Nothing -> return ()
+      Just lit -> do
+        val <- litValue solver lit
+        unless (lTrue == val) $ do
+          str <- showConstraintHandler c
+          error (printf "reasonOf: value of literal %d should be True but %s (constrReasonOf %s %s)" lit (show val) str (show x))
+  cl <- constrReasonOf solver c x
+  when debugMode $ do
+    forM_ cl $ \lit -> do
+      val <- litValue solver lit
+      unless (lFalse == val) $ do
+        str <- showConstraintHandler c
+        error (printf "reasonOf: value of literal %d should be False but %s (constrReasonOf %s %s)" lit (show val) str (show x))
+  return cl
+
+isLocked :: Solver -> SomeConstraintHandler -> IO Bool
+isLocked solver c = constrIsLocked solver c c
+
+data SomeConstraintHandler
+  = CHClause !ClauseHandler
+  | CHAtLeast !AtLeastHandler
+  | CHPBCounter !PBHandlerCounter
+  | CHPBPueblo !PBHandlerPueblo
+  | CHXORClause !XORClauseHandler
+  | CHTheory !TheoryHandler
+  deriving Eq
+
+instance Hashable SomeConstraintHandler where
+  hashWithSalt s (CHClause c)    = s `hashWithSalt` (0::Int) `hashWithSalt` c
+  hashWithSalt s (CHAtLeast c)   = s `hashWithSalt` (1::Int) `hashWithSalt` c
+  hashWithSalt s (CHPBCounter c) = s `hashWithSalt` (2::Int) `hashWithSalt` c
+  hashWithSalt s (CHPBPueblo c)  = s `hashWithSalt` (3::Int) `hashWithSalt` c
+  hashWithSalt s (CHXORClause c) = s `hashWithSalt` (4::Int) `hashWithSalt` c
+  hashWithSalt s (CHTheory c)    = s `hashWithSalt` (5::Int) `hashWithSalt` c
+
+instance ConstraintHandler SomeConstraintHandler where
+  toConstraintHandler = id
+
+  showConstraintHandler (CHClause c)    = showConstraintHandler c
+  showConstraintHandler (CHAtLeast c)   = showConstraintHandler c
+  showConstraintHandler (CHPBCounter c) = showConstraintHandler c
+  showConstraintHandler (CHPBPueblo c)  = showConstraintHandler c
+  showConstraintHandler (CHXORClause c) = showConstraintHandler c
+  showConstraintHandler (CHTheory c)    = showConstraintHandler c
+
+  constrAttach solver this (CHClause c)    = constrAttach solver this c
+  constrAttach solver this (CHAtLeast c)   = constrAttach solver this c
+  constrAttach solver this (CHPBCounter c) = constrAttach solver this c
+  constrAttach solver this (CHPBPueblo c)  = constrAttach solver this c
+  constrAttach solver this (CHXORClause c) = constrAttach solver this c
+  constrAttach solver this (CHTheory c)    = constrAttach solver this c
+
+  constrDetach solver this (CHClause c)    = constrDetach solver this c
+  constrDetach solver this (CHAtLeast c)   = constrDetach solver this c
+  constrDetach solver this (CHPBCounter c) = constrDetach solver this c
+  constrDetach solver this (CHPBPueblo c)  = constrDetach solver this c
+  constrDetach solver this (CHXORClause c) = constrDetach solver this c
+  constrDetach solver this (CHTheory c)    = constrDetach solver this c
+
+  constrIsLocked solver this (CHClause c)    = constrIsLocked solver this c
+  constrIsLocked solver this (CHAtLeast c)   = constrIsLocked solver this c
+  constrIsLocked solver this (CHPBCounter c) = constrIsLocked solver this c
+  constrIsLocked solver this (CHPBPueblo c)  = constrIsLocked solver this c
+  constrIsLocked solver this (CHXORClause c) = constrIsLocked solver this c
+  constrIsLocked solver this (CHTheory c)    = constrIsLocked solver this c
+
+  constrPropagate solver this (CHClause c)  lit   = constrPropagate solver this c lit
+  constrPropagate solver this (CHAtLeast c) lit   = constrPropagate solver this c lit
+  constrPropagate solver this (CHPBCounter c) lit = constrPropagate solver this c lit
+  constrPropagate solver this (CHPBPueblo c) lit  = constrPropagate solver this c lit
+  constrPropagate solver this (CHXORClause c) lit = constrPropagate solver this c lit
+  constrPropagate solver this (CHTheory c) lit    = constrPropagate solver this c lit
+
+  constrReasonOf solver (CHClause c)  l   = constrReasonOf solver c l
+  constrReasonOf solver (CHAtLeast c) l   = constrReasonOf solver c l
+  constrReasonOf solver (CHPBCounter c) l = constrReasonOf solver c l
+  constrReasonOf solver (CHPBPueblo c) l  = constrReasonOf solver c l
+  constrReasonOf solver (CHXORClause c) l = constrReasonOf solver c l
+  constrReasonOf solver (CHTheory c) l    = constrReasonOf solver c l
+
+  constrOnUnassigned solver this (CHClause c)  l   = constrOnUnassigned solver this c l
+  constrOnUnassigned solver this (CHAtLeast c) l   = constrOnUnassigned solver this c l
+  constrOnUnassigned solver this (CHPBCounter c) l = constrOnUnassigned solver this c l
+  constrOnUnassigned solver this (CHPBPueblo c) l  = constrOnUnassigned solver this c l
+  constrOnUnassigned solver this (CHXORClause c) l = constrOnUnassigned solver this c l
+  constrOnUnassigned solver this (CHTheory c) l    = constrOnUnassigned solver this c l
+
+  isPBRepresentable (CHClause c)    = isPBRepresentable c
+  isPBRepresentable (CHAtLeast c)   = isPBRepresentable c
+  isPBRepresentable (CHPBCounter c) = isPBRepresentable c
+  isPBRepresentable (CHPBPueblo c)  = isPBRepresentable c
+  isPBRepresentable (CHXORClause c) = isPBRepresentable c
+  isPBRepresentable (CHTheory c)    = isPBRepresentable c
+
+  toPBLinAtLeast (CHClause c)    = toPBLinAtLeast c
+  toPBLinAtLeast (CHAtLeast c)   = toPBLinAtLeast c
+  toPBLinAtLeast (CHPBCounter c) = toPBLinAtLeast c
+  toPBLinAtLeast (CHPBPueblo c)  = toPBLinAtLeast c
+  toPBLinAtLeast (CHXORClause c) = toPBLinAtLeast c
+  toPBLinAtLeast (CHTheory c)    = toPBLinAtLeast c
+
+  isSatisfied solver (CHClause c)    = isSatisfied solver c
+  isSatisfied solver (CHAtLeast c)   = isSatisfied solver c
+  isSatisfied solver (CHPBCounter c) = isSatisfied solver c
+  isSatisfied solver (CHPBPueblo c)  = isSatisfied solver c
+  isSatisfied solver (CHXORClause c) = isSatisfied solver c
+  isSatisfied solver (CHTheory c)    = isSatisfied solver c
+
+  constrIsProtected solver (CHClause c)    = constrIsProtected solver c
+  constrIsProtected solver (CHAtLeast c)   = constrIsProtected solver c
+  constrIsProtected solver (CHPBCounter c) = constrIsProtected solver c
+  constrIsProtected solver (CHPBPueblo c)  = constrIsProtected solver c
+  constrIsProtected solver (CHXORClause c) = constrIsProtected solver c
+  constrIsProtected solver (CHTheory c)    = constrIsProtected solver c
+
+  constrReadActivity (CHClause c)    = constrReadActivity c
+  constrReadActivity (CHAtLeast c)   = constrReadActivity c
+  constrReadActivity (CHPBCounter c) = constrReadActivity c
+  constrReadActivity (CHPBPueblo c)  = constrReadActivity c
+  constrReadActivity (CHXORClause c) = constrReadActivity c
+  constrReadActivity (CHTheory c)    = constrReadActivity c
+
+  constrWriteActivity (CHClause c)    aval = constrWriteActivity c aval
+  constrWriteActivity (CHAtLeast c)   aval = constrWriteActivity c aval
+  constrWriteActivity (CHPBCounter c) aval = constrWriteActivity c aval
+  constrWriteActivity (CHPBPueblo c)  aval = constrWriteActivity c aval
+  constrWriteActivity (CHXORClause c) aval = constrWriteActivity c aval
+  constrWriteActivity (CHTheory c)    aval = constrWriteActivity c aval
+
+isReasonOf :: Solver -> SomeConstraintHandler -> Lit -> IO Bool
+isReasonOf solver c lit = do
+  val <- litValue solver lit
+  if val == lUndef then
+    return False
+  else do
+    m <- varReason solver (litVar lit)
+    case m of
+      Nothing -> return False
+      Just c2  -> return $! c == c2
+
+-- To avoid heap-allocation Maybe value, it returns -1 when not found.
+findForWatch :: Solver -> IOUArray Int Lit -> Int -> Int -> IO Int
+#ifndef __GLASGOW_HASKELL__
+findForWatch solver a beg end = go beg end
+  where
+    go :: Int -> Int -> IO Int
+    go i end | i > end = return (-1)
+    go i end = do
+      val <- litValue s =<< unsafeRead a i
+      if val /= lFalse
+        then return i
+        else go (i+1) end
+#else
+{- We performed worker-wrapper transfomation manually, since the worker
+   generated by GHC has type
+   "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)",
+   not "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)".
+   We want latter one to avoid heap-allocating Int value. -}
+findForWatch solver a (I# beg) (I# end) = IO $ \w ->
+  case go# beg end w of
+    (# w2, ret #) -> (# w2, I# ret #)
+  where
+    go# :: Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
+#if __GLASGOW_HASKELL__ < 708
+    go# i end w | i ># end = (# w, -1# #)
+#else
+    go# i end w | isTrue# (i ># end) = (# w, -1# #)
+#endif
+    go# i end w =
+      case unIO (litValue solver =<< unsafeRead a (I# i)) w of
+        (# w2, val #) ->
+          if val /= lFalse
+            then (# w2, i #)
+            else go# (i +# 1#) end w2
+
+    unIO (IO f) = f
+#endif
+
+-- To avoid heap-allocating Maybe value, it returns -1 when not found.
+findForWatch2 :: Solver -> IOUArray Int Lit -> Int -> Int -> IO Int
+#ifndef __GLASGOW_HASKELL__
+findForWatch2 solver a beg end = go beg end
+  where
+    go :: Int -> Int -> IO Int
+    go i end | i > end = return (-1)
+    go i end = do
+      val <- litValue s =<< unsafeRead a i
+      if val == lUndef
+        then return i
+        else go (i+1) end
+#else
+{- We performed worker-wrapper transfomation manually, since the worker
+   generated by GHC has type
+   "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int #)",
+   not "Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)".
+   We want latter one to avoid heap-allocating Int value. -}
+findForWatch2 solver a (I# beg) (I# end) = IO $ \w ->
+  case go# beg end w of
+    (# w2, ret #) -> (# w2, I# ret #)
+  where
+    go# :: Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
+#if __GLASGOW_HASKELL__ < 708
+    go# i end w | i ># end = (# w, -1# #)
+#else
+    go# i end w | isTrue# (i ># end) = (# w, -1# #)
+#endif
+    go# i end w =
+      case unIO (litValue solver =<< unsafeRead a (I# i)) w of
+        (# w2, val #) ->
+          if val == lUndef
+            then (# w2, i #)
+            else go# (i +# 1#) end w2
+
+    unIO (IO f) = f
+#endif
+
+{--------------------------------------------------------------------
+  Clause
+--------------------------------------------------------------------}
+
+data ClauseHandler
+  = ClauseHandler
+  { claLits :: !(IOUArray Int Lit)
+  , claActivity :: !(IORef Double)
+  , claHash :: !Int
+  }
+
+claGetSize :: ClauseHandler -> IO Int
+claGetSize cla = do
+  (lb,ub) <- getBounds (claLits cla)
+  assert (lb == 0) $ return ()
+  return $! ub-lb+1
+
+instance Eq ClauseHandler where
+  (==) = (==) `on` claLits
+
+instance Hashable ClauseHandler where
+  hash = claHash
+  hashWithSalt = defaultHashWithSalt
+
+newClauseHandler :: Clause -> Bool -> IO ClauseHandler
+newClauseHandler ls learnt = do
+  let size = length ls
+  a <- newListArray (0, size-1) ls
+  act <- newIORef $! (if learnt then 0 else -1)
+  return (ClauseHandler a act (hash ls))
+
+instance ConstraintHandler ClauseHandler where
+  toConstraintHandler = CHClause
+
+  showConstraintHandler this = do
+    lits <- getElems (claLits this)
+    return (show lits)
+
+  constrAttach solver this this2 = do
+    -- BCP Queue should be empty at this point.
+    -- If not, duplicated propagation happens.
+    bcpCheckEmpty solver
+
+    size <- claGetSize this2
+    if size == 0 then do
+      markBad solver
+      return False
+    else if size == 1 then do
+      lit0 <- unsafeRead (claLits this2) 0
+      assignBy solver lit0 this
+    else do
+      ref <- newIORef 1
+      let f i = do
+            lit_i <- unsafeRead (claLits this2) i
+            val_i <- litValue solver lit_i
+            if val_i /= lFalse then
+              return True
+            else do
+              j <- readIORef ref
+              k <- findForWatch solver (claLits this2) j (size - 1)
+              case k of
+                -1 -> do
+                  return False
+                _ -> do
+                  lit_k <- unsafeRead (claLits this2) k
+                  unsafeWrite (claLits this2) i lit_k
+                  unsafeWrite (claLits this2) k lit_i
+                  writeIORef ref $! (k+1)
+                  return True
+
+      b <- f 0
+      if b then do
+        lit0 <- unsafeRead (claLits this2) 0
+        watchLit solver lit0 this
+        b2 <- f 1
+        if b2 then do
+          lit1 <- unsafeRead (claLits this2) 1
+          watchLit solver lit1 this
+          return True
+        else do -- UNIT
+          -- We need to watch the most recently falsified literal
+          (i,_) <- liftM (maximumBy (comparing snd)) $ forM [1..size-1] $ \l -> do
+            lit <- unsafeRead (claLits this2) l
+            lv <- litLevel solver lit
+            return (l,lv)
+          lit1 <- unsafeRead (claLits this2) 1
+          liti <- unsafeRead (claLits this2) i
+          unsafeWrite (claLits this2) 1 liti
+          unsafeWrite (claLits this2) i lit1
+          watchLit solver liti this
+          assignBy solver lit0 this -- should always succeed
+      else do -- CONFLICT
+        ls <- liftM (map fst . sortBy (flip (comparing snd))) $ forM [0..size-1] $ \l -> do
+          lit <- unsafeRead (claLits this2) l
+          lv <- litLevel solver lit
+          return (l,lv)
+        forM_ (zip [0..] ls) $ \(i,lit) -> do
+          unsafeWrite (claLits this2) i lit
+        lit0 <- unsafeRead (claLits this2) 0
+        lit1 <- unsafeRead (claLits this2) 1
+        watchLit solver lit0 this
+        watchLit solver lit1 this
+        return False
+
+  constrDetach solver this this2 = do
+    size <- claGetSize this2
+    when (size >= 2) $ do
+      lit0 <- unsafeRead (claLits this2) 0
+      lit1 <- unsafeRead (claLits this2) 1
+      unwatchLit solver lit0 this
+      unwatchLit solver lit1 this
+
+  constrIsLocked solver this this2 = do
+    size <- claGetSize this2
+    if size < 2 then
+      return False
+    else do
+      lit <- unsafeRead (claLits this2) 0
+      isReasonOf solver this lit
+
+  constrPropagate !solver this this2 !falsifiedLit = do
+    preprocess
+
+    !lit0 <- unsafeRead a 0
+    !val0 <- litValue solver lit0
+    if val0 == lTrue then do
+      watchLit solver falsifiedLit this
+      return True
+    else do
+      size <- claGetSize this2
+      i <- findForWatch solver a 2 (size - 1)
+      case i of
+        -1 -> do
+          when debugMode $ logIO solver $ do
+             str <- showConstraintHandler this
+             return $ printf "constrPropagate: %s is unit" str
+          watchLit solver falsifiedLit this
+          assignBy solver lit0 this
+        _  -> do
+          !lit1 <- unsafeRead a 1
+          !liti <- unsafeRead a i
+          unsafeWrite a 1 liti
+          unsafeWrite a i lit1
+          watchLit solver liti this
+          return True
+
+    where
+      a = claLits this2
+
+      preprocess :: IO ()
+      preprocess = do
+        !l0 <- unsafeRead a 0
+        !l1 <- unsafeRead a 1
+        assert (l0==falsifiedLit || l1==falsifiedLit) $ return ()
+        when (l0==falsifiedLit) $ do
+          unsafeWrite a 0 l1
+          unsafeWrite a 1 l0
+
+  constrReasonOf _ this l = do
+    lits <- getElems (claLits this)
+    case l of
+      Nothing -> return lits
+      Just lit -> do
+        assert (lit == head lits) $ return ()
+        return $ tail lits
+
+  constrOnUnassigned _solver _this _this2 _lit = return ()
+
+  isPBRepresentable _ = return True
+
+  toPBLinAtLeast this = do
+    lits <- getElems (claLits this)
+    return ([(1,l) | l <- lits], 1)
+
+  isSatisfied solver this = do
+    lits <- getElems (claLits this)
+    vals <- mapM (litValue solver) lits
+    return $ lTrue `elem` vals
+
+  constrIsProtected _ this = do
+    size <- claGetSize this
+    return $! size <= 2
+
+  constrReadActivity this = readIORef (claActivity this)
+
+  constrWriteActivity this aval = writeIORef (claActivity this) $! aval
+
+basicAttachClauseHandler :: Solver -> ClauseHandler -> IO Bool
+basicAttachClauseHandler solver this = do
+  let constr = toConstraintHandler this
+  lits <- getElems (claLits this)
+  case lits of
+    [] -> do
+      markBad solver
+      return False
+    [l1] -> do
+      assignBy solver l1 constr
+    l1:l2:_ -> do
+      watchLit solver l1 constr
+      watchLit solver l2 constr
+      return True
+
+{--------------------------------------------------------------------
+  Cardinality Constraint
+--------------------------------------------------------------------}
+
+data AtLeastHandler
+  = AtLeastHandler
+  { atLeastLits :: IOUArray Int Lit
+  , atLeastNum :: !Int
+  , atLeastActivity :: !(IORef Double)
+  , atLeastHash :: !Int
+  }
+
+instance Eq AtLeastHandler where
+  (==) = (==) `on` atLeastLits
+
+instance Hashable AtLeastHandler where
+  hash = atLeastHash
+  hashWithSalt = defaultHashWithSalt
+
+newAtLeastHandler :: [Lit] -> Int -> Bool -> IO AtLeastHandler
+newAtLeastHandler ls n learnt = do
+  let size = length ls
+  a <- newListArray (0, size-1) ls
+  act <- newIORef $! (if learnt then 0 else -1)
+  return (AtLeastHandler a n act (hash (ls,n)))
+
+instance ConstraintHandler AtLeastHandler where
+  toConstraintHandler = CHAtLeast
+
+  showConstraintHandler this = do
+    lits <- getElems (atLeastLits this)
+    return $ show lits ++ " >= " ++ show (atLeastNum this)
+
+  -- FIXME: simplify implementation
+  constrAttach solver this this2 = do
+    -- BCP Queue should be empty at this point.
+    -- If not, duplicated propagation happens.
+    bcpCheckEmpty solver
+
+    let a = atLeastLits this2
+    (lb,ub) <- getBounds a
+    assert (lb == 0) $ return ()
+    let m = ub - lb + 1
+        n = atLeastNum this2
+
+    if m < n then do
+      markBad solver
+      return False
+    else if m == n then do
+      let f i = do
+            lit <- unsafeRead a i
+            assignBy solver lit this
+      allM f [0..n-1]
+    else do -- m > n
+      let f !i !j
+            | i == n = do
+                -- NOT VIOLATED: n literals (0 .. n-1) are watched
+                k <- findForWatch solver a j ub
+                if k /= -1 then do
+                  -- NOT UNIT
+                  lit_n <- unsafeRead a n
+                  lit_k <- unsafeRead a k
+                  unsafeWrite a n lit_k
+                  unsafeWrite a k lit_n
+                  watchLit solver lit_k this
+                  -- n+1 literals (0 .. n) are watched.
+                else do
+                  -- UNIT
+                  forLoop 0 (<n) (+1) $ \l -> do
+                    lit <- unsafeRead a l
+                    _ <- assignBy solver lit this -- should always succeed
+                    return ()
+                  -- We need to watch the most recently falsified literal
+                  (l,_) <- liftM (maximumBy (comparing snd)) $ forM [n..ub] $ \l -> do
+                    lit <- unsafeRead a l
+                    lv <- litLevel solver lit
+                    when debugMode $ do
+                      val <- litValue solver lit
+                      unless (val == lFalse) $ error "AtLeastHandler.attach: should not happen"
+                    return (l,lv)
+                  lit_n <- unsafeRead a n
+                  lit_l <- unsafeRead a l
+                  unsafeWrite a n lit_l
+                  unsafeWrite a l lit_n
+                  watchLit solver lit_l this
+                  -- n+1 literals (0 .. n) are watched.
+                return True
+            | otherwise = do
+                assert (i < n && n <= j) $ return ()
+                lit_i <- unsafeRead a i
+                val_i <- litValue solver lit_i
+                if val_i /= lFalse then do
+                  watchLit solver lit_i this
+                  f (i+1) j
+                else do
+                  k <- findForWatch solver a j ub
+                  if k /= -1 then do
+                    lit_k <- unsafeRead a k
+                    unsafeWrite a i lit_k
+                    unsafeWrite a k lit_i
+                    watchLit solver lit_k this
+                    f (i+1) (k+1)
+                  else do
+                    -- CONFLICT
+                    -- We need to watch unassigned literals or most recently falsified literals.
+                    do xs <- liftM (sortBy (flip (comparing snd))) $ forM [i..ub] $ \l -> do
+                         lit <- readArray a l
+                         val <- litValue solver lit
+                         if val == lFalse then do
+                           lv <- litLevel solver lit
+                           return (lit, lv)
+                         else do
+                           return (lit, maxBound)
+                       forM_ (zip [i..ub] xs) $ \(l,(lit,_lv)) -> do
+                         writeArray a l lit
+                    forLoop i (<=n) (+1) $ \l -> do
+                      lit_l <- readArray a l
+                      watchLit solver lit_l this
+                    -- n+1 literals (0 .. n) are watched.
+                    return False
+      f 0 n
+
+  constrDetach solver this this2 = do
+    lits <- getElems (atLeastLits this2)
+    let n = atLeastNum this2
+    when (length lits > n) $ do
+      forLoop 0 (<=n) (+1) $ \i -> do
+        lit <- unsafeRead (atLeastLits this2) i
+        unwatchLit solver lit this
+
+  constrIsLocked solver this this2 = do
+    (lb,ub) <- getBounds (atLeastLits this2)
+    let size = ub - lb + 1
+        n = atLeastNum this2
+        loop i
+          | i > n = return False
+          | otherwise = do
+              l <- unsafeRead (atLeastLits this2) i
+              b <- isReasonOf solver this l
+              if b then return True else loop (i+1)
+    if size >= n+1 then
+      loop 0
+    else
+      return False
+
+  constrPropagate solver this this2 falsifiedLit = do
+    preprocess
+
+    when debugMode $ do
+      litn <- readArray a n
+      unless (litn == falsifiedLit) $ error "AtLeastHandler.constrPropagate: should not happen"
+
+    (lb,ub) <- getBounds a
+    assert (lb==0) $ return ()
+    i <- findForWatch solver a (n+1) ub
+    case i of
+      -1 -> do
+        when debugMode $ logIO solver $ do
+          str <- showConstraintHandler this
+          return $ printf "constrPropagate: %s is unit" str
+        watchLit solver falsifiedLit this
+        let loop :: Int -> IO Bool
+            loop i
+              | i >= n = return True
+              | otherwise = do
+                  liti <- unsafeRead a i
+                  ret2 <- assignBy solver liti this
+                  if ret2
+                    then loop (i+1)
+                    else return False
+        loop 0
+      _ -> do
+        liti <- unsafeRead a i
+        litn <- unsafeRead a n
+        unsafeWrite a i litn
+        unsafeWrite a n liti
+        watchLit solver liti this
+        return True
+
+    where
+      a = atLeastLits this2
+      n = atLeastNum this2
+
+      preprocess :: IO ()
+      preprocess = loop 0
+        where
+          loop :: Int -> IO ()
+          loop i
+            | i >= n = return ()
+            | otherwise = do
+              li <- unsafeRead a i
+              if (li /= falsifiedLit) then
+                loop (i+1)
+              else do
+                ln <- unsafeRead a n
+                unsafeWrite a n li
+                unsafeWrite a i ln
+
+  constrReasonOf solver this concl = do
+    (lb,ub) <- getBounds (atLeastLits this)
+    assert (lb==0) $ return ()
+    let n = atLeastNum this
+    falsifiedLits <- mapM (readArray (atLeastLits this)) [n..ub] -- drop first n elements
+    when debugMode $ do
+      forM_ falsifiedLits $ \lit -> do
+        val <- litValue solver lit
+        unless (val == lFalse) $ do
+          error $ printf "AtLeastHandler.constrReasonOf: %d is %s (lFalse expected)" lit (show val)
+    case concl of
+      Nothing -> do
+        let go :: Int -> IO Lit
+            go i
+              | i >= n = error $ printf "AtLeastHandler.constrReasonOf: cannot find falsified literal in first %d elements" n
+              | otherwise = do
+                  lit <- readArray (atLeastLits this) i
+                  val <- litValue solver lit
+                  if val == lFalse
+                  then return lit
+                  else go (i+1)
+        lit <- go lb
+        return $ lit : falsifiedLits
+      Just lit -> do
+        when debugMode $ do
+          es <- getElems (atLeastLits this)
+          unless (lit `elem` take n es) $
+            error $ printf "AtLeastHandler.constrReasonOf: cannot find %d in first %d elements" n
+        return falsifiedLits
+
+  constrOnUnassigned _solver _this _this2 _lit = return ()
+
+  isPBRepresentable _ = return True
+
+  toPBLinAtLeast this = do
+    lits <- getElems (atLeastLits this)
+    return ([(1,l) | l <- lits], fromIntegral (atLeastNum this))
+
+  isSatisfied solver this = do
+    lits <- getElems (atLeastLits this)
+    vals <- mapM (litValue solver) lits
+    return $ length [v | v <- vals, v == lTrue] >= atLeastNum this
+
+  constrReadActivity this = readIORef (atLeastActivity this)
+
+  constrWriteActivity this aval = writeIORef (atLeastActivity this) $! aval
+
+basicAttachAtLeastHandler :: Solver -> AtLeastHandler -> IO Bool
+basicAttachAtLeastHandler solver this = do
+  lits <- getElems (atLeastLits this)
+  let m = length lits
+      n = atLeastNum this
+      constr = toConstraintHandler this
+  if m < n then do
+    markBad solver
+    return False
+  else if m == n then do
+    allM (\l -> assignBy solver l constr) lits
+  else do -- m > n
+    forM_ (take (n+1) lits) $ \l -> watchLit solver l constr
+    return True
+
+{--------------------------------------------------------------------
+  Pseudo Boolean Constraint
+--------------------------------------------------------------------}
+
+newPBHandler :: Solver -> PBLinSum -> Integer -> Bool -> IO SomeConstraintHandler
+newPBHandler solver ts degree learnt = do
+  config <- readIORef (svPBHandlerType solver)
+  case config of
+    PBHandlerTypeCounter -> do
+      c <- newPBHandlerCounter ts degree learnt
+      return (toConstraintHandler c)
+    PBHandlerTypePueblo -> do
+      c <- newPBHandlerPueblo ts degree learnt
+      return (toConstraintHandler c)
+
+newPBHandlerPromoted :: Solver -> PBLinSum -> Integer -> Bool -> IO SomeConstraintHandler
+newPBHandlerPromoted solver lhs rhs learnt = do
+  case pbToAtLeast (lhs,rhs) of
+    Nothing -> newPBHandler solver lhs rhs learnt
+    Just (lhs2, rhs2) -> do
+      if rhs2 /= 1 then do
+        h <- newAtLeastHandler lhs2 rhs2 learnt
+        return $ toConstraintHandler h
+      else do
+        h <- newClauseHandler lhs2 learnt
+        return $ toConstraintHandler h
+
+pbOverSAT :: Solver -> PBLinAtLeast -> IO Bool
+pbOverSAT solver (lhs, rhs) = do
+  ss <- forM lhs $ \(c,l) -> do
+    v <- litValue solver l
+    if v /= lFalse
+      then return c
+      else return 0
+  return $! sum ss > rhs
+
+pbToAtLeast :: PBLinAtLeast -> Maybe AtLeast
+pbToAtLeast (lhs, rhs) = do
+  let cs = [c | (c,_) <- lhs]
+  guard $ Set.size (Set.fromList cs) == 1
+  let c = head cs
+  return $ (map snd lhs, fromInteger ((rhs+c-1) `div` c))
+
+{--------------------------------------------------------------------
+  Pseudo Boolean Constraint (Counter)
+--------------------------------------------------------------------}   
+
+data PBHandlerCounter
+  = PBHandlerCounter
+  { pbTerms    :: !PBLinSum -- sorted in the decending order on coefficients.
+  , pbDegree   :: !Integer
+  , pbCoeffMap :: !(LitMap Integer)
+  , pbMaxSlack :: !Integer
+  , pbSlack    :: !(IORef Integer)
+  , pbActivity :: !(IORef Double)
+  , pbHash     :: !Int
+  }
+
+instance Eq PBHandlerCounter where
+  (==) = (==) `on` pbSlack
+
+instance Hashable PBHandlerCounter where
+  hash = pbHash
+  hashWithSalt = defaultHashWithSalt
+
+newPBHandlerCounter :: PBLinSum -> Integer -> Bool -> IO PBHandlerCounter
+newPBHandlerCounter ts degree learnt = do
+  let ts' = sortBy (flip compare `on` fst) ts
+      slack = sum (map fst ts) - degree      
+      m = IM.fromList [(l,c) | (c,l) <- ts]
+  s <- newIORef slack
+  act <- newIORef $! (if learnt then 0 else -1)
+  return (PBHandlerCounter ts' degree m slack s act (hash (ts,degree)))
+
+instance ConstraintHandler PBHandlerCounter where
+  toConstraintHandler = CHPBCounter
+
+  showConstraintHandler this = do
+    return $ show (pbTerms this) ++ " >= " ++ show (pbDegree this)
+
+  constrAttach solver this this2 = do
+    -- BCP queue should be empty at this point.
+    -- It is important for calculating slack.
+    bcpCheckEmpty solver
+    s <- liftM sum $ forM (pbTerms this2) $ \(c,l) -> do
+      watchLit solver l this
+      val <- litValue solver l
+      if val == lFalse then do
+        addOnUnassigned solver this l
+        return 0
+      else do
+        return c
+    let slack = s - pbDegree this2
+    writeIORef (pbSlack this2) $! slack
+    if slack < 0 then
+      return False
+    else do
+      flip allM (pbTerms this2) $ \(c,l) -> do
+        val <- litValue solver l
+        if c > slack && val == lUndef then do
+          assignBy solver l this
+        else
+          return True
+
+  constrDetach solver this this2 = do
+    forM_ (pbTerms this2) $ \(_,l) -> do
+      unwatchLit solver l this
+
+  constrIsLocked solver this this2 = do
+    anyM (\(_,l) -> isReasonOf solver this l) (pbTerms this2)
+
+  constrPropagate solver this this2 falsifiedLit = do
+    watchLit solver falsifiedLit this
+    let c = pbCoeffMap this2 IM.! falsifiedLit
+    modifyIORef' (pbSlack this2) (subtract c)
+    addOnUnassigned solver this falsifiedLit
+    s <- readIORef (pbSlack this2)
+    if s < 0 then
+      return False
+    else do
+      forM_ (takeWhile (\(c1,_) -> c1 > s) (pbTerms this2)) $ \(_,l1) -> do
+        v <- litValue solver l1
+        when (v == lUndef) $ do
+          assignBy solver l1 this
+          return ()
+      return True
+
+  constrReasonOf solver this l = do
+    case l of
+      Nothing -> do
+        let p _ = return True
+        f p (pbMaxSlack this) (pbTerms this)
+      Just lit -> do
+        idx <- varAssignNo solver (litVar lit)
+        -- PB制約の場合には複数回unitになる可能性があり、
+        -- litへの伝播以降に割り当てられたリテラルを含まないよう注意が必要
+        let p lit2 =do
+              idx2 <- varAssignNo solver (litVar lit2)
+              return $ idx2 < idx
+        let c = pbCoeffMap this IM.! lit
+        f p (pbMaxSlack this - c) (pbTerms this)
+    where
+      {-# INLINE f #-}
+      f :: (Lit -> IO Bool) -> Integer -> PBLinSum -> IO [Lit]
+      f p s xs = go s xs []
+        where
+          go :: Integer -> PBLinSum -> [Lit] -> IO [Lit]
+          go s _ ret | s < 0 = return ret
+          go _ [] _ = error "PBHandlerCounter.constrReasonOf: should not happen"
+          go s ((c,lit):xs) ret = do
+            val <- litValue solver lit
+            if val == lFalse then do
+              b <- p lit
+              if b
+              then go (s - c) xs (lit:ret)
+              else go s xs ret
+            else do
+              go s xs ret
+
+  constrOnUnassigned _solver _this this2 lit = do
+    let c = pbCoeffMap this2 IM.! (- lit)
+    modifyIORef' (pbSlack this2) (+ c)
+
+  isPBRepresentable _ = return True
+
+  toPBLinAtLeast this = do
+    return (pbTerms this, pbDegree this)
+
+  isSatisfied solver this = do
+    xs <- forM (pbTerms this) $ \(c,l) -> do
+      v <- litValue solver l
+      if v == lTrue
+        then return c
+        else return 0
+    return $ sum xs >= pbDegree this
+
+  constrWeight _ _ = return 0.5
+
+  constrReadActivity this = readIORef (pbActivity this)
+
+  constrWriteActivity this aval = writeIORef (pbActivity this) $! aval
+
+{--------------------------------------------------------------------
+  Pseudo Boolean Constraint (Pueblo)
+--------------------------------------------------------------------}
+
+data PBHandlerPueblo
+  = PBHandlerPueblo
+  { puebloTerms     :: !PBLinSum
+  , puebloDegree    :: !Integer
+  , puebloMaxSlack  :: !Integer
+  , puebloWatches   :: !(IORef LitSet)
+  , puebloWatchSum  :: !(IORef Integer)
+  , puebloActivity  :: !(IORef Double)
+  , puebloHash      :: !Int
+  }
+
+instance Eq PBHandlerPueblo where
+  (==) = (==) `on` puebloWatchSum
+
+instance Hashable PBHandlerPueblo where
+  hash = puebloHash
+  hashWithSalt = defaultHashWithSalt
+
+puebloAMax :: PBHandlerPueblo -> Integer
+puebloAMax this =
+  case puebloTerms this of
+    (c,_):_ -> c
+    [] -> 0 -- should not happen?
+
+newPBHandlerPueblo :: PBLinSum -> Integer -> Bool -> IO PBHandlerPueblo
+newPBHandlerPueblo ts degree learnt = do
+  let ts' = sortBy (flip compare `on` fst) ts
+      slack = sum [c | (c,_) <- ts'] - degree
+  ws   <- newIORef IS.empty
+  wsum <- newIORef 0
+  act  <- newIORef $! (if learnt then 0 else -1)
+  return $ PBHandlerPueblo ts' degree slack ws wsum act (hash (ts,degree))
+
+puebloGetWatchSum :: PBHandlerPueblo -> IO Integer
+puebloGetWatchSum pb = readIORef (puebloWatchSum pb)
+
+puebloWatch :: Solver -> SomeConstraintHandler -> PBHandlerPueblo -> PBLinTerm -> IO ()
+puebloWatch solver constr !pb (c, lit) = do
+  watchLit solver lit constr
+  modifyIORef' (puebloWatches pb) (IS.insert lit)
+  modifyIORef' (puebloWatchSum pb) (+c)
+
+puebloUnwatch :: Solver -> PBHandlerPueblo -> PBLinTerm -> IO ()
+puebloUnwatch _solver pb (c, lit) = do
+  modifyIORef' (puebloWatches pb) (IS.delete lit)
+  modifyIORef' (puebloWatchSum pb) (subtract c)
+
+instance ConstraintHandler PBHandlerPueblo where
+  toConstraintHandler = CHPBPueblo
+
+  showConstraintHandler this = do
+    return $ show (puebloTerms this) ++ " >= " ++ show (puebloDegree this)
+
+  constrAttach solver this this2 = do
+    bcpCheckEmpty solver
+    ret <- puebloPropagate solver this this2
+
+    -- register to watch recently falsified literals to recover
+    -- "WatchSum >= puebloDegree this + puebloAMax this" when backtrack is performed.
+    wsum <- puebloGetWatchSum this2
+    unless (wsum >= puebloDegree this2 + puebloAMax this2) $ do
+      let f m tm@(_,lit) = do
+            val <- litValue solver lit
+            if val == lFalse then do
+              idx <- varAssignNo solver (litVar lit)
+              return (IM.insert idx tm m)
+            else
+              return m
+#if MIN_VERSION_containers(0,5,0)
+      xs <- liftM (map snd . IM.toDescList) $ foldM f IM.empty (puebloTerms this2)
+#else
+      xs <- liftM (reverse . map snd . IM.toAscList) $ foldM f IM.empty (puebloTerms this2)
+#endif
+      let g !_ [] = return ()
+          g !s ((c,l):ts) = do
+            addOnUnassigned solver this l
+            if s+c >= puebloDegree this2 + puebloAMax this2 then return ()
+            else g (s+c) ts
+      g wsum xs
+
+    return ret
+
+  constrDetach solver this this2 = do
+    ws <- readIORef (puebloWatches this2)
+    forM_ (IS.toList ws) $ \l -> do
+      unwatchLit solver l this
+
+  constrIsLocked solver this this2 = do
+    anyM (\(_,l) -> isReasonOf solver this l) (puebloTerms this2)
+
+  constrPropagate solver this this2 falsifiedLit = do
+    let t = fromJust $ find (\(_,l) -> l==falsifiedLit) (puebloTerms this2)
+    puebloUnwatch solver this2 t
+    ret <- puebloPropagate solver this this2
+    wsum <- puebloGetWatchSum this2
+    unless (wsum >= puebloDegree this2 + puebloAMax this2) $
+      addOnUnassigned solver this falsifiedLit
+    return ret
+
+  constrReasonOf solver this l = do
+    case l of
+      Nothing -> do
+        let p _ = return True
+        f p (puebloMaxSlack this) (puebloTerms this)
+      Just lit -> do
+        idx <- varAssignNo solver (litVar lit)
+        -- PB制約の場合には複数回unitになる可能性があり、
+        -- litへの伝播以降に割り当てられたリテラルを含まないよう注意が必要
+        let p lit2 =do
+              idx2 <- varAssignNo solver (litVar lit2)
+              return $ idx2 < idx
+        let c = fst $ fromJust $ find (\(_,l) -> l == lit) (puebloTerms this)
+        f p (puebloMaxSlack this - c) (puebloTerms this)
+    where
+      {-# INLINE f #-}
+      f :: (Lit -> IO Bool) -> Integer -> PBLinSum -> IO [Lit]
+      f p s xs = go s xs []
+        where
+          go :: Integer -> PBLinSum -> [Lit] -> IO [Lit]
+          go s _ ret | s < 0 = return ret
+          go _ [] _ = error "PBHandlerPueblo.constrReasonOf: should not happen"
+          go s ((c,lit):xs) ret = do
+            val <- litValue solver lit
+            if val == lFalse then do
+              b <- p lit
+              if b
+              then go (s - c) xs (lit:ret)
+              else go s xs ret
+            else do
+              go s xs ret
+
+  constrOnUnassigned solver this this2 lit = do
+    let t = fromJust $ find (\(_,l) -> l == - lit) (puebloTerms this2)
+    puebloWatch solver this this2 t
+
+  isPBRepresentable _ = return True
+
+  toPBLinAtLeast this = do
+    return (puebloTerms this, puebloDegree this)
+
+  isSatisfied solver this = do
+    xs <- forM (puebloTerms this) $ \(c,l) -> do
+      v <- litValue solver l
+      if v == lTrue
+        then return c
+        else return 0
+    return $ sum xs >= puebloDegree this
+
+  constrWeight _ _ = return 0.5
+
+  constrReadActivity this = readIORef (puebloActivity this)
+
+  constrWriteActivity this aval = writeIORef (puebloActivity this) $! aval
+
+puebloPropagate :: Solver -> SomeConstraintHandler -> PBHandlerPueblo -> IO Bool
+puebloPropagate solver constr this = do
+  puebloUpdateWatchSum solver constr this
+  watchsum <- puebloGetWatchSum this
+  if puebloDegree this + puebloAMax this <= watchsum then
+    return True
+  else if watchsum < puebloDegree this then do
+    -- CONFLICT
+    return False
+  else do -- puebloDegree this <= watchsum < puebloDegree this + puebloAMax this
+    -- UNIT PROPAGATION
+    let f [] = return True
+        f ((c,lit) : ts) = do
+          watchsum <- puebloGetWatchSum this
+          if watchsum - c >= puebloDegree this then
+            return True
+          else do
+            val <- litValue solver lit
+            when (val == lUndef) $ do
+              b <- assignBy solver lit constr
+              assert b $ return ()
+            f ts
+    f $ puebloTerms this
+
+puebloUpdateWatchSum :: Solver -> SomeConstraintHandler -> PBHandlerPueblo -> IO ()
+puebloUpdateWatchSum solver constr this = do
+  let f [] = return ()
+      f (t@(_,lit):ts) = do
+        watchSum <- puebloGetWatchSum this
+        if watchSum >= puebloDegree this + puebloAMax this then
+          return ()
+        else do
+          val <- litValue solver lit
+          watched <- liftM (lit `IS.member`) $ readIORef (puebloWatches this)
+          when (val /= lFalse && not watched) $ do
+            puebloWatch solver constr this t
+          f ts
+  f (puebloTerms this)
+
+{--------------------------------------------------------------------
+  XOR Clause
+--------------------------------------------------------------------}
+
+data XORClauseHandler
+  = XORClauseHandler
+  { xorLits :: !(IOUArray Int Lit)
+  , xorActivity :: !(IORef Double)
+  , xorHash :: !Int
+  }
+
+instance Eq XORClauseHandler where
+  (==) = (==) `on` xorLits
+
+instance Hashable XORClauseHandler where
+  hash = xorHash
+  hashWithSalt = defaultHashWithSalt
+
+newXORClauseHandler :: [Lit] -> Bool -> IO XORClauseHandler
+newXORClauseHandler ls learnt = do
+  let size = length ls
+  a <- newListArray (0, size-1) ls
+  act <- newIORef $! (if learnt then 0 else -1)
+  return (XORClauseHandler a act (hash ls))
+
+instance ConstraintHandler XORClauseHandler where
+  toConstraintHandler = CHXORClause
+
+  showConstraintHandler this = do
+    lits <- getElems (xorLits this)
+    return ("XOR " ++ show lits)
+
+  constrAttach solver this this2 = do
+    -- BCP Queue should be empty at this point.
+    -- If not, duplicated propagation happens.
+    bcpCheckEmpty solver
+
+    let a = xorLits this2
+    (lb,ub) <- getBounds a
+    assert (lb == 0) $ return ()
+    let size = ub-lb+1
+
+    if size == 0 then do
+      markBad solver
+      return False
+    else if size == 1 then do
+      lit0 <- unsafeRead a 0
+      assignBy solver lit0 this
+    else do
+      ref <- newIORef 1
+      let f i = do
+            lit_i <- unsafeRead a i
+            val_i <- litValue solver lit_i
+            if val_i == lUndef then
+              return True
+            else do
+              j <- readIORef ref
+              k <- findForWatch2 solver a j ub
+              case k of
+                -1 -> do
+                  return False
+                _ -> do
+                  lit_k <- unsafeRead a k
+                  unsafeWrite a i lit_k
+                  unsafeWrite a k lit_i
+                  writeIORef ref $! (k+1)
+                  return True
+
+      b <- f 0
+      if b then do
+        lit0 <- unsafeRead a 0
+        watchVar solver (litVar lit0) this
+        b2 <- f 1
+        if b2 then do
+          lit1 <- unsafeRead a 1
+          watchVar solver (litVar lit1) this
+          return True
+        else do -- UNIT
+          -- We need to watch the most recently falsified literal
+          (i,_) <- liftM (maximumBy (comparing snd)) $ forM [1..ub] $ \l -> do
+            lit <- unsafeRead a l
+            lv <- litLevel solver lit
+            return (l,lv)
+          lit1 <- unsafeRead a 1
+          liti <- unsafeRead a i
+          unsafeWrite a 1 liti
+          unsafeWrite a i lit1
+          watchVar solver (litVar liti) this
+          -- lit0 ⊕ y
+          y <- do
+            ref <- newIORef False
+            forLoop 1 (<=ub) (+1) $ \j -> do
+              lit_j <- unsafeRead a j
+              val_j <- litValue solver lit_j
+              modifyIORef' ref (/= fromJust (unliftBool val_j))
+            readIORef ref
+          assignBy solver (if y then litNot lit0 else lit0) this -- should always succeed
+      else do
+        ls <- liftM (map fst . sortBy (flip (comparing snd))) $ forM [lb..ub] $ \l -> do
+          lit <- unsafeRead a l
+          lv <- litLevel solver lit
+          return (l,lv)
+        forM_ (zip [0..] ls) $ \(i,lit) -> do
+          unsafeWrite a i lit
+        lit0 <- unsafeRead a 0
+        lit1 <- unsafeRead a 1
+        watchVar solver (litVar lit0) this
+        watchVar solver (litVar lit1) this
+        isSatisfied solver this2
+
+  constrDetach solver this this2 = do
+    (lb,ub) <- getBounds (xorLits this2)
+    let size = ub-lb+1
+    when (size >= 2) $ do
+      lit0 <- unsafeRead (xorLits this2) 0
+      lit1 <- unsafeRead (xorLits this2) 1
+      unwatchVar solver (litVar lit0) this
+      unwatchVar solver (litVar lit1) this
+
+  constrIsLocked solver this this2 = do
+    lit0 <- unsafeRead (xorLits this2) 0
+    lit1 <- unsafeRead (xorLits this2) 1
+    b0 <- isReasonOf solver this lit0
+    b1 <- isReasonOf solver this lit1
+    return $ b0 || b1
+
+  constrPropagate !solver this this2 !falsifiedLit = do
+    b <- constrIsLocked solver this this2
+    if b then
+      return True
+    else do
+      preprocess
+  
+      !lit0 <- unsafeRead a 0
+      (!lb,!ub) <- getBounds a
+      assert (lb==0) $ return ()
+      i <- findForWatch2 solver a 2 ub
+      case i of
+        -1 -> do
+          when debugMode $ logIO solver $ do
+             str <- showConstraintHandler this
+             return $ printf "constrPropagate: %s is unit" str
+          watchVar solver v this
+          -- lit0 ⊕ y
+          y <- do
+            ref <- newIORef False
+            forLoop 1 (<=ub) (+1) $ \j -> do
+              lit_j <- unsafeRead a j
+              val_j <- litValue solver lit_j
+              modifyIORef' ref (/= fromJust (unliftBool val_j))
+            readIORef ref
+          assignBy solver (if y then litNot lit0 else lit0) this
+        _  -> do
+          !lit1 <- unsafeRead a 1
+          !liti <- unsafeRead a i
+          unsafeWrite a 1 liti
+          unsafeWrite a i lit1
+          watchVar solver (litVar liti) this
+          return True
+
+    where
+      v = litVar falsifiedLit
+      a = xorLits this2
+
+      preprocess :: IO ()
+      preprocess = do
+        !l0 <- unsafeRead a 0
+        !l1 <- unsafeRead a 1
+        assert (litVar l0 == v || litVar l1 == v) $ return ()
+        when (litVar l0 == v) $ do
+          unsafeWrite a 0 l1
+          unsafeWrite a 1 l0
+
+  constrReasonOf solver this l = do
+    lits <- getElems (xorLits this)
+    xs <-
+      case l of
+        Nothing -> mapM f lits
+        Just lit -> do          
+         case lits of
+           l1:ls -> do
+             assert (litVar lit == litVar l1) $ return ()
+             mapM f ls
+           _ -> error "XORClauseHandler.constrReasonOf: should not happen"
+    return xs
+    where
+      f :: Lit -> IO Lit
+      f lit = do
+        let v = litVar lit
+        val <- varValue solver v
+        return $ literal v (not (fromJust (unliftBool val)))
+
+  constrOnUnassigned _solver _this _this2 _lit = return ()
+
+  isPBRepresentable _ = return False
+
+  toPBLinAtLeast _ = error "XORClauseHandler does not support toPBLinAtLeast"
+
+  isSatisfied solver this = do
+    lits <- getElems (xorLits this)
+    vals <- mapM (litValue solver) lits
+    let f x y
+          | x == lUndef || y == lUndef = lUndef
+          | otherwise = liftBool (x /= y)
+    return $ foldl' f lFalse vals == lTrue
+
+  constrIsProtected _ this = do
+    size <- liftM rangeSize (getBounds (xorLits this))
+    return $! size <= 2
+
+  constrReadActivity this = readIORef (xorActivity this)
+
+  constrWriteActivity this aval = writeIORef (xorActivity this) $! aval
+
+basicAttachXORClauseHandler :: Solver -> XORClauseHandler -> IO Bool
+basicAttachXORClauseHandler solver this = do
+  lits <- getElems (xorLits this)
+  let constr = toConstraintHandler this
+  case lits of
+    [] -> do
+      markBad solver
+      return False
+    [l1] -> do
+      assignBy solver l1 constr
+    l1:l2:_ -> do
+      watchVar solver (litVar l1) constr
+      watchVar solver (litVar l2) constr
+      return True
+
+{--------------------------------------------------------------------
+  Arbitrary Boolean Theory
+--------------------------------------------------------------------}
+
+setTheory :: Solver -> TheorySolver -> IO ()
+setTheory solver tsolver = do
+  d <- getDecisionLevel solver
+  assert (d == levelRoot) $ return ()
+
+  m <- readIORef (svTheorySolver solver)
+  case m of
+    Just _ -> do
+      error $ "ToySolver.SAT.setTheory: cannot replace TheorySolver"
+    Nothing -> do
+      writeIORef (svTheorySolver solver) (Just tsolver)
+      ret <- deduce solver
+      case ret of
+        Nothing -> return ()
+        Just _ -> markBad solver
+
+getTheory :: Solver -> IO (Maybe TheorySolver)
+getTheory solver = readIORef (svTheorySolver solver)
+
+deduceT :: Solver -> IO (Maybe SomeConstraintHandler)
+deduceT solver = do
+  mt <- readIORef (svTheorySolver solver)
+  case mt of
+    Nothing -> return Nothing
+    Just t -> do
+      n <- Vec.getSize (svTrail solver)
+      let h = CHTheory TheoryHandler
+          callback l = assignBy solver l h
+          loop i = do
+            if i < n then do
+              l <- Vec.unsafeRead (svTrail solver) i
+              ok <- thAssertLit t callback l
+              if ok then
+                loop (i+1)
+              else
+                return False
+            else do
+              return True
+      b <- loop =<< readIOURef (svTheoryChecked solver)
+      if not b then
+        return (Just h)
+      else do
+        b2 <- thCheck t callback
+        if b2 then do
+          writeIOURef (svTheoryChecked solver) n
+          return Nothing
+        else
+          return (Just h)
+
+data TheoryHandler = TheoryHandler deriving (Eq)
+
+instance Hashable TheoryHandler where
+  hash _ = hash ()
+  hashWithSalt = defaultHashWithSalt
+
+instance ConstraintHandler TheoryHandler where
+  toConstraintHandler = CHTheory
+
+  showConstraintHandler _this = return "TheoryHandler"
+
+  constrAttach _solver _this _this2 = error "TheoryHandler.constrAttach"
+
+  constrDetach _solver _this _this2 = return ()
+
+  constrIsLocked _solver _this _this2 = return True
+
+  constrPropagate _solver _this _this2 _falsifiedLit =  error "TheoryHandler.constrPropagate"
+
+  constrReasonOf solver _this l = do
+    Just t <- readIORef (svTheorySolver solver)
+    thExplain t l
+
+  constrOnUnassigned _solver _this _this2 _lit = return ()
+
+  isPBRepresentable _this = return False
+
+  toPBLinAtLeast _this = error "TheoryHandler.toPBLinAtLeast"
+
+  isSatisfied _solver _this = error "TheoryHandler.isSatisfied"
+
+  constrIsProtected _solver _this = error "TheoryHandler.constrIsProtected"
+
+  constrReadActivity _this = return 0
+
+  constrWriteActivity _this _aval = return ()
+
+{--------------------------------------------------------------------
+  Restart strategy
+--------------------------------------------------------------------}
+
+data RestartStrategy = MiniSATRestarts | ArminRestarts | LubyRestarts
+  deriving (Show, Eq, Ord, Enum, Bounded)
+
+mkRestartSeq :: RestartStrategy -> Int -> Double -> [Int]
+mkRestartSeq MiniSATRestarts = miniSatRestartSeq
+mkRestartSeq ArminRestarts   = arminRestartSeq
+mkRestartSeq LubyRestarts    = lubyRestartSeq
+
+miniSatRestartSeq :: Int -> Double -> [Int]
+miniSatRestartSeq start inc = iterate (ceiling . (inc *) . fromIntegral) start
+
+{-
+miniSatRestartSeq :: Int -> Double -> [Int]
+miniSatRestartSeq start inc = map round $ iterate (inc*) (fromIntegral start)
+-}
+
+arminRestartSeq :: Int -> Double -> [Int]
+arminRestartSeq start inc = go (fromIntegral start) (fromIntegral start)
+  where  
+    go !inner !outer = round inner : go inner' outer'
+      where
+        (inner',outer') = 
+          if inner >= outer
+          then (fromIntegral start, outer * inc)
+          else (inner * inc, outer)
+
+lubyRestartSeq :: Int -> Double -> [Int]
+lubyRestartSeq start inc = map (ceiling . (fromIntegral start *) . luby inc) [0..]
+
+{-
+  Finite subsequences of the Luby-sequence:
+
+  0: 1
+  1: 1 1 2
+  2: 1 1 2 1 1 2 4
+  3: 1 1 2 1 1 2 4 1 1 2 1 1 2 4 8
+  ...
+
+
+-}
+luby :: Double -> Integer -> Double
+luby y x = go2 size1 sequ1 x
+  where
+    -- Find the finite subsequence that contains index 'x', and the
+    -- size of that subsequence:
+    (size1, sequ1) = go 1 0
+
+    go :: Integer -> Integer -> (Integer, Integer)
+    go size sequ
+      | size < x+1 = go (2*size+1) (sequ+1)
+      | otherwise  = (size, sequ)
+
+    go2 :: Integer -> Integer -> Integer -> Double
+    go2 size sequ x2
+      | size-1 /= x2 = let size' = (size-1) `div` 2 in go2 size' (sequ - 1) (x2 `mod` size')
+      | otherwise = y ^ sequ
+
+
+{--------------------------------------------------------------------
+  utility
+--------------------------------------------------------------------}
+
+allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
+allM p = go
+  where
+    go [] = return True
+    go (x:xs) = do
+      b <- p x
+      if b
+        then go xs
+        else return False
+
+anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
+anyM p = go
+  where
+    go [] = return False
+    go (x:xs) = do
+      b <- p x
+      if b
+        then return True
+        else go xs
+
+#if !MIN_VERSION_base(4,6,0)
+
+modifyIORef' :: IORef a -> (a -> a) -> IO ()
+modifyIORef' ref f = do
+  x <- readIORef ref
+  writeIORef ref $! f x
+
+#endif
+
+shift :: IORef [a] -> IO a
+shift ref = do
+  (x:xs) <- readIORef ref
+  writeIORef ref xs
+  return x
+
+defaultHashWithSalt :: Hashable a => Int -> a -> Int
+defaultHashWithSalt salt x = salt `combine` hash x
+#if MIN_VERSION_hashable(1,2,0)
+  where
+    combine :: Int -> Int -> Int
+    combine h1 h2 = (h1 * 16777619) `xor` h2
+#endif
+
+{--------------------------------------------------------------------
+  debug
+--------------------------------------------------------------------}
+
+debugMode :: Bool
+debugMode = False
+
+checkSatisfied :: Solver -> IO ()
+checkSatisfied solver = do
+  cls <- readIORef (svConstrDB solver)
+  forM_ cls $ \c -> do
+    b <- isSatisfied solver c
+    unless b $ do
+      s <- showConstraintHandler c
+      log solver $ "BUG: " ++ s ++ " is violated"
 
 dumpVarActivity :: Solver -> IO ()
 dumpVarActivity solver = do
diff --git a/src/ToySolver/SAT/Integer.hs b/src/ToySolver/SAT/Integer.hs
--- a/src/ToySolver/SAT/Integer.hs
+++ b/src/ToySolver/SAT/Integer.hs
@@ -17,8 +17,9 @@
 import qualified ToySolver.SAT as SAT
 import qualified ToySolver.SAT.Types as SAT
 import qualified ToySolver.SAT.TseitinEncoder as TseitinEncoder
+import qualified ToySolver.SAT.PBNLC as PBNLC
 
-data Expr = Expr [(Integer, [SAT.Lit])]
+newtype Expr = Expr PBNLC.PBSum
 
 newVar :: SAT.Solver -> Integer -> Integer -> IO Expr
 newVar solver lo hi
@@ -55,44 +56,40 @@
 linearize enc (Expr xs) = do
   let ys = [(c,lits) | (c,lits@(_:_)) <- xs]
       c  = sum [c | (c,[]) <- xs]
-  zs <- forM ys $ \(c,lits) -> do
-    l <- TseitinEncoder.encodeConj enc lits
-    return (c,l)
+  zs <- PBNLC.linearizePBSum enc ys
   return (zs, c)
 
 addConstraint :: TseitinEncoder.Encoder -> ArithRel Expr -> IO ()
 addConstraint enc (ArithRel lhs op rhs) = do
   let solver = TseitinEncoder.encSolver enc
-  (lhs2,c) <- linearize enc (lhs - rhs)
-  let rhs2 = -c
+  let Expr e = lhs - rhs
   case op of
-    Le  -> SAT.addPBAtMost  solver lhs2 rhs2
-    Lt  -> SAT.addPBAtMost  solver lhs2 (rhs2-1)
-    Ge  -> SAT.addPBAtLeast solver lhs2 rhs2
-    Gt  -> SAT.addPBAtLeast solver lhs2 (rhs2+1)
-    Eql -> SAT.addPBExactly solver lhs2 rhs2
+    Le  -> PBNLC.addPBAtMost  enc e 0
+    Lt  -> PBNLC.addPBAtMost  enc e (-1)
+    Ge  -> PBNLC.addPBAtLeast enc e 0
+    Gt  -> PBNLC.addPBAtLeast enc e 1
+    Eql -> PBNLC.addPBExactly enc e 0
     NEq -> do
       sel <- SAT.newVar solver
-      SAT.addPBAtLeastSoft solver sel lhs2 (rhs2+1)
-      SAT.addPBAtMostSoft  solver (-sel) lhs2 (rhs2-1)
+      PBNLC.addPBAtLeastSoft enc sel e 1
+      PBNLC.addPBAtMostSoft  enc (-sel) e (-1)
 
 addConstraintSoft :: TseitinEncoder.Encoder -> SAT.Lit -> ArithRel Expr -> IO ()
 addConstraintSoft enc sel (ArithRel lhs op rhs) = do
   let solver = TseitinEncoder.encSolver enc
-  (lhs2,c) <- linearize enc (lhs - rhs)
-  let rhs2 = -c
+  let Expr e = lhs - rhs
   case op of
-    Le  -> SAT.addPBAtMostSoft  solver sel lhs2 rhs2
-    Lt  -> SAT.addPBAtMostSoft  solver sel lhs2 (rhs2-1)
-    Ge  -> SAT.addPBAtLeastSoft solver sel lhs2 rhs2
-    Gt  -> SAT.addPBAtLeastSoft solver sel lhs2 (rhs2+1)
-    Eql -> SAT.addPBExactlySoft solver sel lhs2 rhs2
+    Le  -> PBNLC.addPBAtMostSoft  enc sel e 0
+    Lt  -> PBNLC.addPBAtMostSoft  enc sel e (-1)
+    Ge  -> PBNLC.addPBAtLeastSoft enc sel e 0
+    Gt  -> PBNLC.addPBAtLeastSoft enc sel e 1
+    Eql -> PBNLC.addPBExactlySoft enc sel e 0
     NEq -> do
       sel2 <- SAT.newVar solver
-      sel3 <- TseitinEncoder.encodeConj enc [sel,sel2]
-      sel4 <- TseitinEncoder.encodeConj enc [sel,-sel2]
-      SAT.addPBAtLeastSoft solver sel3 lhs2 (rhs2+1)
-      SAT.addPBAtMostSoft  solver sel4 lhs2 (rhs2-1)
+      sel3 <- TseitinEncoder.encodeConjWithPolarity enc TseitinEncoder.polarityNeg [sel,sel2]
+      sel4 <- TseitinEncoder.encodeConjWithPolarity enc TseitinEncoder.polarityNeg [sel,-sel2]
+      PBNLC.addPBAtLeastSoft enc sel3 e 1
+      PBNLC.addPBAtMostSoft  enc sel4 e (-1)
 
 eval :: SAT.IModel m => m -> Expr -> Integer
 eval m (Expr ts) = sum [if and [SAT.evalLit m lit | lit <- lits] then n else 0 | (n,lits) <- ts]
diff --git a/src/ToySolver/SAT/MUS/CAMUS.hs b/src/ToySolver/SAT/MUS/CAMUS.hs
--- a/src/ToySolver/SAT/MUS/CAMUS.hs
+++ b/src/ToySolver/SAT/MUS/CAMUS.hs
@@ -43,6 +43,8 @@
 import qualified Data.IntSet as IS
 import Data.List
 import Data.IORef
+import Data.Set (Set)
+import qualified Data.Set as Set
 import qualified ToySolver.Combinatorial.HittingSet.Simple as HittingSet
 import qualified ToySolver.SAT as SAT
 import ToySolver.SAT.Types
@@ -140,7 +142,7 @@
   log "CAMUS: MCS enumeration begins"
   mcses <- allMCSAssumptions solver sels opt
   log "CAMUS: MCS enumeration done"
-  let muses = HittingSet.minimalHittingSets mcses
+  let muses = HittingSet.enumMinimalHittingSets $ Set.fromList mcses
   mapM_ (optOnMUSFound opt) muses
   return (muses, mcses)
   where
diff --git a/src/ToySolver/SAT/MUS/DAA.hs b/src/ToySolver/SAT/MUS/DAA.hs
--- a/src/ToySolver/SAT/MUS/DAA.hs
+++ b/src/ToySolver/SAT/MUS/DAA.hs
@@ -68,12 +68,8 @@
               Nothing -> do
                 let mus = xs
                 optOnMUSFound opt mus
-                SAT.addClause solver [-l | l <- IntSet.toList mus] -- lemma
                 f (Set.insert mus muses) xss
-      f muses (Set.toList (hst mcses `Set.difference` muses))
-
-    hst :: Set LitSet -> Set LitSet
-    hst = Set.fromList . HittingSet.minimalHittingSets . Set.toList
+      f muses (Set.toList (HittingSet.minimalHittingSets mcses `Set.difference` muses))
 
     findMSS :: LitSet -> IO (Maybe LitSet)
     findMSS xs = do
@@ -83,7 +79,8 @@
       if b then do
         m <- SAT.getModel solver
         liftM Just $ grow $ IntSet.fromList [l | l <- sels, evalLit m l]
-      else
+      else do
+        SAT.addClause solver [-l | l <- IntSet.toList xs] -- lemma
         return Nothing
 
     grow :: LitSet -> IO LitSet
diff --git a/src/ToySolver/SAT/MUS/QuickXplain.hs b/src/ToySolver/SAT/MUS/QuickXplain.hs
new file mode 100644
--- /dev/null
+++ b/src/ToySolver/SAT/MUS/QuickXplain.hs
@@ -0,0 +1,121 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  ToySolver.SAT.MUS.QuickXplain
+-- Copyright   :  (c) Masahiro Sakai 2015
+-- License     :  BSD-style
+-- 
+-- Maintainer  :  masahiro.sakai@gmail.com
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- Minimal Unsatifiable Subset (MUS) Finder based on QuickXplain algorithm.
+--
+-- References:
+--
+-- * Ulrich Junker. QuickXplain: Preferred explanations and relaxations for
+--   over-constrained problems. In Proc. of AAAI’04, pages 167-172, 2004.
+--   <http://www.aaai.org/Papers/AAAI/2004/AAAI04-027.pdf>
+--
+-----------------------------------------------------------------------------
+module ToySolver.SAT.MUS.QuickXplain
+  ( module ToySolver.SAT.MUS.Types
+  , Options (..)
+  , defaultOptions
+  , findMUSAssumptions
+  ) where
+
+import Control.Monad
+import Data.Default.Class
+import Data.List
+import qualified Data.IntSet as IS
+import qualified ToySolver.SAT as SAT
+import ToySolver.SAT.Types
+import ToySolver.SAT.MUS.Types
+import ToySolver.SAT.MUS hiding (findMUSAssumptions)
+
+-- | Find a minimal set of assumptions that causes a conflict.
+-- Initial set of assumptions is taken from 'SAT.getFailedAssumptions'.
+findMUSAssumptions
+  :: SAT.Solver
+  -> Options
+  -> IO MUS
+findMUSAssumptions solver opt = do
+  log "computing a minimal unsatisfiable core"
+  core <- liftM IS.fromList $ SAT.getFailedAssumptions solver
+  update $ IS.toList core
+  log $ "core = " ++ showLits core
+  if IS.null core then
+    return core
+  else
+    liftM fst $ f IS.empty False core
+
+  where
+    log :: String -> IO ()
+    log = optLogger opt
+
+    update :: [Lit] -> IO ()
+    update = optUpdateBest opt
+
+    showLit :: Lit -> String
+    showLit = optLitPrinter opt
+
+    showLits :: IS.IntSet -> String
+    showLits ls = "{" ++ intercalate ", " (map showLit (IS.toList ls)) ++ "}"
+
+    split :: IS.IntSet -> (IS.IntSet, IS.IntSet)
+    split cs = (cs1, cs2)
+      where
+        s = IS.size cs
+        cs' = IS.toAscList cs
+        cs1 = IS.fromAscList $ take (s `div` 2) cs'
+        cs2 = IS.fromAscList $ drop (s `div` 2) cs'
+
+    -- Precondition:
+    -- * bs∪cs is unsatisfiable
+    -- * ¬hasDelta ⇒ bs is satisfiable
+    --
+    -- Returns:
+    -- * minimal subset cs'⊆cs such that bs∪cs' is unsatisfiable
+    -- * (not necessarily minimal) subset bs'⊆bs such that bs'∪cs' is unsatisfiable.
+    f :: IS.IntSet -> Bool -> IS.IntSet -> IO (IS.IntSet, IS.IntSet)
+    f bs hasDelta cs = do
+      log $ "checking satisfiability of " ++ showLits bs
+      ret <- if not hasDelta then do
+               return True
+             else
+               SAT.solveWith solver (IS.toList bs)
+      if not ret then do
+        log $ showLits bs ++ " is unsatisfiable"
+        bs' <- liftM IS.fromList $ SAT.getFailedAssumptions solver
+        log $ "new core = " ++ showLits bs'
+        update $ IS.toList bs'
+        return (IS.empty, bs')
+      else do
+        log $ showLits bs ++ " is satisfiable"
+        if IS.size cs == 1 then do
+          return (cs, bs)
+        else do
+          let (cs1,cs2) = split cs
+          log $ "splitting " ++ showLits cs ++ " into " ++ showLits cs1 ++ " and " ++ showLits cs2
+          (ds2, es2) <- f (bs `IS.union` cs1) (not (IS.null cs1)) cs2
+          let bs'  = bs `IS.intersection` es2
+              cs1' = cs1 `IS.intersection` es2
+          (ds1, es1) <- f (bs' `IS.union` ds2) (not (IS.null ds2)) cs1'
+          return (ds1 `IS.union` ds2, bs `IS.intersection` (es1 `IS.union` es2))
+
+{-
+Algorithm QUICKXPLAIN(B, C, ≺)
+ 1. if isConsistent(B ∪ C) return 'no conflict';
+ 2. else if C = ∅ then return ∅;
+ 3. else return QUICKXPLAIN'(B, B, C, ≺);
+
+Algorithm QUICKXPLAIN'(B, ∆, C, ≺)
+ 4. if ∆ ≠ ∅ and not isConsistent(B) then return ∅;
+ 5. if C = {α} then return {α};
+ 6. let α_1, …, α_n be an enumeration of C that respects ≺;
+ 7. let k be split(n) where 1 ≤ k < n;
+ 8. C1 := {α_1, …, α_k} and C2 := {α_{k+1}, …, α_n};
+ 9. ∆2 := QUICKXPLAIN'(B ∪ C1, C1, C2, ≺);
+10. ∆1 := QUICKXPLAIN'(B ∪ ∆2, ∆2, C1, ≺);
+11. return ∆1 ∪ ∆2;
+-}
diff --git a/src/ToySolver/SAT/PBNLC.hs b/src/ToySolver/SAT/PBNLC.hs
new file mode 100644
--- /dev/null
+++ b/src/ToySolver/SAT/PBNLC.hs
@@ -0,0 +1,138 @@
+{-# OPTIONS_GHC -Wall #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  ToySolver.SAT.PBNLC
+-- Copyright   :  (c) Masahiro Sakai 2015
+-- License     :  BSD-style
+-- 
+-- Maintainer  :  masahiro.sakai@gmail.com
+-- Stability   :  provisional
+-- Portability :  portable
+-- 
+-----------------------------------------------------------------------------
+module ToySolver.SAT.PBNLC
+  (
+    PBTerm
+  , PBSum
+
+  -- * Adding constraints
+  , addPBAtLeast
+  , addPBAtMost  
+  , addPBExactly
+  , addPBAtLeastSoft
+  , addPBAtMostSoft
+  , addPBExactlySoft
+
+  -- * Linearlization
+  , linearizePBSum
+  , linearizePBSumWithPolarity
+
+  -- * Evaluation
+  , evalPBSum
+  ) where
+
+import qualified ToySolver.SAT as SAT
+import ToySolver.SAT.Types
+import ToySolver.SAT.TseitinEncoder
+import ToySolver.Internal.Util (revForM)
+
+type PBTerm = (Integer, [Lit])
+type PBSum = [PBTerm]
+
+-- | Add a non-linear pseudo boolean constraints /c1*ls1 + c2*ls2 + … ≥ n/.
+addPBAtLeast
+  :: Encoder
+  -> PBSum   -- ^ @[(c1,ls1),(c2,ls2),…]@
+  -> Integer -- ^ /n/
+  -> IO ()
+addPBAtLeast enc lhs rhs = do
+  let c = sum [c | (c,[]) <- lhs]
+  lhs' <- linearizePBSumWithPolarity enc polarityPos [(c,ls) | (c,ls) <- lhs, not (null ls)]
+  SAT.addPBAtLeast (encSolver enc) lhs' (rhs - c)
+
+-- | Add a non-linear pseudo boolean constraints /c1*ls1 + c2*ls2 + … ≥ n/.
+addPBAtMost
+  :: Encoder
+  -> PBSum   -- ^ @[(c1,ls1),(c2,ls2),…]@
+  -> Integer -- ^ /n/
+  -> IO ()
+addPBAtMost enc lhs rhs =
+  addPBAtLeast enc [(-c,ls) | (c,ls) <- lhs] (negate rhs)
+
+-- | Add a non-linear pseudo boolean constraints /c1*ls1 + c2*ls2 + … = n/.
+addPBExactly
+  :: Encoder
+  -> PBSum   -- ^ @[(c1,ls1),(c2,ls2),…]@
+  -> Integer -- ^ /n/
+  -> IO ()
+addPBExactly enc lhs rhs = do
+  let c = sum [c | (c,[]) <- lhs]
+  lhs' <- linearizePBSum enc [(c,ls) | (c,ls) <- lhs, not (null ls)]
+  SAT.addPBExactly (encSolver enc) lhs' (rhs - c)
+
+-- | Add a soft non-linear pseudo boolean constraints /sel ⇒ c1*ls1 + c2*ls2 + … ≥ n/.
+addPBAtLeastSoft
+  :: Encoder
+  -> Lit     -- ^ Selector literal @sel@
+  -> PBSum   -- ^ @[(c1,ls1),(c2,ls2),…]@
+  -> Integer -- ^ /n/
+  -> IO ()
+addPBAtLeastSoft enc sel lhs rhs = do
+  let c = sum [c | (c,[]) <- lhs]
+  lhs' <- linearizePBSumWithPolarity enc polarityPos [(c,ls) | (c,ls) <- lhs, not (null ls)]
+  SAT.addPBAtLeastSoft (encSolver enc) sel lhs' (rhs - c)
+
+-- | Add a soft non-linear pseudo boolean constraints /sel ⇒ c1*ls1 + c2*ls2 + … ≤ n/.
+addPBAtMostSoft
+  :: Encoder
+  -> Lit     -- ^ Selector literal @sel@
+  -> PBSum   -- ^ @[(c1,ls1),(c2,ls2),…]@
+  -> Integer -- ^ /n/
+  -> IO ()
+addPBAtMostSoft enc sel lhs rhs =
+  addPBAtLeastSoft enc sel [(negate c, lit) | (c,lit) <- lhs] (negate rhs)
+
+-- | Add a soft non-linear pseudo boolean constraints /lit ⇒ c1*ls1 + c2*ls2 + … = n/.
+addPBExactlySoft
+  :: Encoder
+  -> Lit     -- ^ indicator @lit@
+  -> PBSum   -- ^ @[(c1,ls1),(c2,ls2),…]@
+  -> Integer -- ^ /n/
+  -> IO ()
+addPBExactlySoft enc sel lhs rhs = do
+  let c = sum [c | (c,[]) <- lhs]
+  lhs' <- linearizePBSum enc [(c,ls) | (c,ls) <- lhs, not (null ls)]
+  SAT.addPBExactlySoft (encSolver enc) sel lhs' (rhs - c)
+
+-- | Encode a non-linear 'PBSum' into a lienar 'PBLinSum'.
+--
+-- @linearizePBSum enc s@ is equivalent to @linearizePBSumWithPolarity enc polarityBoth@.
+linearizePBSum
+  :: Encoder
+  -> PBSum
+  -> IO PBLinSum
+linearizePBSum enc = linearizePBSumWithPolarity enc polarityBoth
+
+-- | Linearize a non-linear 'PBSum' into a lienar 'PBLinSum'.
+--
+-- The input 'PBSum' is assumed to occur only in specified polarity.
+--
+-- * If @'polarityPosOccurs' p@, the value of resulting 'PBLinSum' is /greater than/ or /equal to/ the value of original 'PBSum'.
+--
+-- * If @'polarityNegOccurs' p@, the value of resulting 'PBLinSum' is /lesser than/ or /equal to/ the value of original 'PBSum'.
+-- 
+linearizePBSumWithPolarity
+  :: Encoder
+  -> Polarity -- polarity /p/
+  -> PBSum
+  -> IO PBLinSum
+linearizePBSumWithPolarity enc p xs =
+  revForM xs $ \(c,ls) -> do
+    l <- if c > 0 then
+           encodeConjWithPolarity enc p ls
+         else
+           encodeConjWithPolarity enc (negatePolarity p) ls
+    return (c,l)
+
+evalPBSum :: IModel m => m -> PBSum -> Integer
+evalPBSum m xs = sum [c | (c,lits) <- xs, all (evalLit m) lits]
diff --git a/src/ToySolver/SAT/TheorySolver.hs b/src/ToySolver/SAT/TheorySolver.hs
--- a/src/ToySolver/SAT/TheorySolver.hs
+++ b/src/ToySolver/SAT/TheorySolver.hs
@@ -9,7 +9,7 @@
   TheorySolver
   { thAssertLit :: (Lit -> IO Bool) -> Lit -> IO Bool
   , thCheck     :: (Lit -> IO Bool) -> IO Bool
-  , thExplain   :: IO [Lit]
+  , thExplain   :: Maybe Lit -> IO [Lit]
   , thPushBacktrackPoint :: IO ()
   , thPopBacktrackPoint  :: IO ()
   }
@@ -19,7 +19,7 @@
   TheorySolver
   { thAssertLit = \propagate lit -> return True
   , thCheck = \propagate -> return True
-  , thExplain = error "should not happen"
+  , thExplain = \_ -> error "should not happen"
   , thPushBacktrackPoint = return ()
   , thPopBacktrackPoint  = return ()
   }
diff --git a/src/ToySolver/SAT/TseitinEncoder.hs b/src/ToySolver/SAT/TseitinEncoder.hs
--- a/src/ToySolver/SAT/TseitinEncoder.hs
+++ b/src/ToySolver/SAT/TseitinEncoder.hs
@@ -32,6 +32,14 @@
 -- * [BM84b] E. Balas and J. B. Mazzola. Nonlinear 0-1 programming:
 --   II. Dominance relations and algorithms. Mathematical Programming,
 --   30(1):22-45, 1984.
+--
+-- * [PG86] D. Plaisted and S. Greenbaum. A Structure-preserving
+--    Clause Form Translation. In Journal on Symbolic Computation,
+--    volume 2, 1986.
+--
+-- * [ES06] N . Eéen and N. Sörensson. Translating Pseudo-Boolean
+--   Constraints into SAT. JSAT 2:1–26, 2006.
+--
 -----------------------------------------------------------------------------
 module ToySolver.SAT.TseitinEncoder
   (
@@ -41,12 +49,28 @@
   , setUsePB
   , encSolver
 
-  -- * Encoding of boolean formula
+  -- * Polarity
+  , Polarity (..)
+  , negatePolarity
+  , polarityPos
+  , polarityNeg
+  , polarityBoth
+  , polarityNone
+
+  -- * Boolean formula type
   , Formula
   , evalFormula
+
+  -- * Encoding of boolean formulas
   , addFormula
   , encodeConj
+  , encodeConjWithPolarity
   , encodeDisj
+  , encodeDisjWithPolarity
+  , encodeITE
+  , encodeITEWithPolarity
+
+  -- * Retrieving definitions
   , getDefinitions
   ) where
 
@@ -72,7 +96,8 @@
   Encoder
   { encSolver    :: SAT.Solver
   , encUsePB     :: IORef Bool
-  , encConjTable :: !(IORef (Map SAT.LitSet SAT.Lit))
+  , encConjTable :: !(IORef (Map SAT.LitSet (SAT.Lit, Bool, Bool)))
+  , encITETable  :: !(IORef (Map (SAT.Lit, SAT.Lit, SAT.Lit) (SAT.Lit, Bool, Bool)))
   }
 
 -- | Create a @Encoder@ instance.
@@ -80,11 +105,13 @@
 newEncoder solver = do
   usePBRef <- newIORef False
   table <- newIORef Map.empty
+  table2 <- newIORef Map.empty
   return $
     Encoder
     { encSolver = solver
     , encUsePB  = usePBRef
     , encConjTable = table
+    , encITETable = table2
     }
 
 -- | Use /pseudo boolean constraints/ or use only /clauses/.
@@ -128,64 +155,175 @@
     Imply a b -> do
       encodeToClause encoder (notB a .||. b)
     _ -> do
-      l <- encodeToLit encoder formula
+      l <- encodeToLitWithPolarity encoder polarityPos formula
       return [l]
 
 encodeToLit :: Encoder -> Formula -> IO SAT.Lit
-encodeToLit encoder formula = do
+encodeToLit encoder = encodeToLitWithPolarity encoder polarityBoth
+
+encodeToLitWithPolarity :: Encoder -> Polarity -> Formula -> IO SAT.Lit
+encodeToLitWithPolarity encoder p formula = do
   case formula of
     Atom l -> return l
-    And xs -> encodeConj encoder =<< mapM (encodeToLit encoder) xs
-    Or xs  -> encodeDisj encoder =<< mapM (encodeToLit encoder) xs
-    Not x -> liftM SAT.litNot $ encodeToLit encoder x
+    And xs -> encodeConjWithPolarity encoder p =<< mapM (encodeToLitWithPolarity encoder p) xs
+    Or xs  -> encodeDisjWithPolarity encoder p =<< mapM (encodeToLitWithPolarity encoder p) xs
+    Not x -> liftM SAT.litNot $ encodeToLitWithPolarity encoder (negatePolarity p) x
     Imply x y -> do
-      encodeToLit encoder (notB x .||. y)
+      encodeToLitWithPolarity encoder p (notB x .||. y)
     Equiv x y -> do
-      lit1 <- encodeToLit encoder x
-      lit2 <- encodeToLit encoder y
-      encodeToLit encoder $
+      lit1 <- encodeToLitWithPolarity encoder polarityBoth x
+      lit2 <- encodeToLitWithPolarity encoder polarityBoth y
+      encodeToLitWithPolarity encoder p $
         (Atom lit1 .=>. Atom lit2) .&&. (Atom lit2 .=>. Atom lit1)
+    ITE c t e -> do
+      c' <- encodeToLitWithPolarity encoder polarityBoth c
+      t' <- encodeToLitWithPolarity encoder p t
+      e' <- encodeToLitWithPolarity encoder p e
+      encodeITEWithPolarity encoder p c' t' e'
 
 -- | Return an literal which is equivalent to a given conjunction.
+--
+-- @
+--   encodeConj encoder = 'encodeConjWithPolarity' encoder 'polarityBoth'
+-- @
 encodeConj :: Encoder -> [SAT.Lit] -> IO SAT.Lit
-encodeConj _ [l] =  return l
-encodeConj encoder ls =  do
+encodeConj encoder = encodeConjWithPolarity encoder polarityBoth
+
+-- | Return an literal which is equivalent to a given conjunction which occurs only in specified polarity.
+encodeConjWithPolarity :: Encoder -> Polarity -> [SAT.Lit] -> IO SAT.Lit
+encodeConjWithPolarity _ _ [l] =  return l
+encodeConjWithPolarity encoder (Polarity pos neg) ls = do
   let ls2 = IntSet.fromList ls
+  let solver = encSolver encoder
+  usePB <- readIORef (encUsePB encoder)
   table <- readIORef (encConjTable encoder)
+
+  let -- If F is monotone, F(A ∧ B) ⇔ ∃x. F(x) ∧ (x → A∧B)
+      definePos :: SAT.Lit -> IO ()
+      definePos l = do
+        if usePB then do
+          -- ∀i.(l → li) ⇔ Σli >= n*l ⇔ Σli - n*l >= 0
+          let n = IntSet.size ls2
+          SAT.addPBAtLeast solver ((- fromIntegral n, l) : [(1,li) | li <- IntSet.toList ls2]) 0
+        else do
+          forM_ (IntSet.toList ls2) $ \li -> do
+            -- (l → li)  ⇔  (¬l ∨ li)
+            SAT.addClause solver [SAT.litNot l, li]
+
+      -- If F is anti-monotone, F(A ∧ B) ⇔ ∃x. F(x) ∧ (x ← A∧B) ⇔ ∃x. F(x) ∧ (x∨¬A∨¬B).
+      defineNeg :: SAT.Lit -> IO ()
+      defineNeg l = do
+        let solver = encSolver encoder
+        -- ((l1 ∧ l2 ∧ … ∧ ln) → l)  ⇔  (¬l1 ∨ ¬l2 ∨ … ∨ ¬ln ∨ l)
+        SAT.addClause solver (l : map SAT.litNot (IntSet.toList ls2))
+
   case Map.lookup ls2 table of
-    Just l -> return l
+    Just (l, posDefined, negDefined) -> do
+      when (pos && not posDefined) $ definePos l
+      when (neg && not negDefined) $ defineNeg l
+      when (posDefined < pos || negDefined < neg) $
+        modifyIORef (encConjTable encoder) (Map.insert ls2 (l, (max posDefined pos), (max negDefined neg)))
+      return l
     Nothing -> do
       let sat = encSolver encoder
-      v <- SAT.newVar sat
-      addIsConjOf encoder v ls
-      return v
+      l <- SAT.newVar sat
+      when pos $ definePos l
+      when neg $ defineNeg l
+      modifyIORef (encConjTable encoder) (Map.insert ls2 (l, pos, neg))
+      return l
 
 -- | Return an literal which is equivalent to a given disjunction.
+--
+-- @
+--   encodeDisj encoder = 'encodeDisjWithPolarity' encoder 'polarityBoth'
+-- @
 encodeDisj :: Encoder -> [SAT.Lit] -> IO SAT.Lit
-encodeDisj _ [l] =  return l
-encodeDisj encoder ls = do
+encodeDisj encoder = encodeDisjWithPolarity encoder polarityBoth
+
+-- | Return an literal which is equivalent to a given disjunction which occurs only in specified polarity.
+encodeDisjWithPolarity :: Encoder -> Polarity -> [SAT.Lit] -> IO SAT.Lit
+encodeDisjWithPolarity _ _ [l] =  return l
+encodeDisjWithPolarity encoder p ls = do
   -- ¬l ⇔ ¬(¬l1 ∧ … ∧ ¬ln) ⇔ (l1 ∨ … ∨ ln)
-  l <- encodeConj encoder [SAT.litNot li | li <- ls]
+  l <- encodeConjWithPolarity encoder (negatePolarity p) [SAT.litNot li | li <- ls]
   return $ SAT.litNot l
 
-addIsConjOf :: Encoder -> SAT.Lit -> [SAT.Lit] -> IO ()
-addIsConjOf encoder l ls = do
+-- | Return an literal which is equivalent to a given if-then-else.
+--
+-- @
+--   encodeITE encoder = 'encodeITEWithPolarity' encoder 'polarityBoth'
+-- @
+encodeITE :: Encoder -> SAT.Lit -> SAT.Lit -> SAT.Lit -> IO SAT.Lit
+encodeITE encoder = encodeITEWithPolarity encoder polarityBoth
+
+-- | Return an literal which is equivalent to a given if-then-else which occurs only in specified polarity.
+encodeITEWithPolarity :: Encoder -> Polarity -> SAT.Lit -> SAT.Lit -> SAT.Lit -> IO SAT.Lit
+encodeITEWithPolarity encoder p c t e | c < 0 =
+  encodeITEWithPolarity encoder p (- c) e t
+encodeITEWithPolarity encoder (Polarity pos neg) c t e = do
   let solver = encSolver encoder
-  usePB <- readIORef (encUsePB encoder)
-  if usePB
-   then do
-     -- ∀i.(l → li) ⇔ Σli >= n*l ⇔ Σli - n*l >= 0
-     let n = length ls
-     SAT.addPBAtLeast solver ((- fromIntegral n, l) : [(1,li) | li <- ls]) 0
-   else do
-     forM_ ls $ \li -> do
-       -- (l → li)  ⇔  (¬l ∨ li)
-       SAT.addClause solver [SAT.litNot l, li]
-  -- ((l1 ∧ l2 ∧ … ∧ ln) → l)  ⇔  (¬l1 ∨ ¬l2 ∨ … ∨ ¬ln ∨ l)
-  SAT.addClause solver (l : map SAT.litNot ls)
-  modifyIORef (encConjTable encoder) (Map.insert (IntSet.fromList ls) l)
+  table <- readIORef (encITETable encoder)
 
+  let definePos :: SAT.Lit -> IO ()
+      definePos x = do
+        -- x → ite(c,t,e)
+        -- ⇔ x → (c∧t ∨ ¬c∧e)
+        -- ⇔ (x∧c → t) ∧ (x∧¬c → e)
+        -- ⇔ (¬x∨¬c∨t) ∧ (¬x∨c∨e)
+        SAT.addClause solver [-x, -c, t]
+        SAT.addClause solver [-x, c, e]
+        SAT.addClause solver [t, e, -x] -- redundant, but will increase the strength of unit propagation.
+  
+      defineNeg :: SAT.Lit -> IO ()
+      defineNeg x = do
+        -- ite(c,t,e) → x
+        -- ⇔ (c∧t ∨ ¬c∧e) → x
+        -- ⇔ (c∧t → x) ∨ (¬c∧e →x)
+        -- ⇔ (¬c∨¬t∨x) ∨ (c∧¬e∨x)
+        SAT.addClause solver [-c, -t, x]
+        SAT.addClause solver [c, -e, x]
+        SAT.addClause solver [-t, -e, x] -- redundant, but will increase the strength of unit propagation.
+
+  case Map.lookup (c,t,e) table of
+    Just (l, posDefined, negDefined) -> do
+      when (pos && not posDefined) $ definePos l
+      when (neg && not negDefined) $ defineNeg l
+      when (posDefined < pos || negDefined < neg) $
+        modifyIORef (encITETable encoder) (Map.insert (c,t,e) (l, (max posDefined pos), (max negDefined neg)))
+      return l
+    Nothing -> do
+      l <- SAT.newVar solver
+      when pos $ definePos l
+      when neg $ defineNeg l
+      modifyIORef (encITETable encoder) (Map.insert (c,t,e) (l, pos, neg))
+      return l
+
+
 getDefinitions :: Encoder -> IO [(SAT.Lit, Formula)]
 getDefinitions encoder = do
   t <- readIORef (encConjTable encoder)
-  return $ [(l, andB [Atom l1 | l1 <- IntSet.toList ls]) | (ls, l) <- Map.toList t]
+  return $ [(l, andB [Atom l1 | l1 <- IntSet.toList ls]) | (ls, (l, _, _)) <- Map.toList t]
+
+
+data Polarity
+  = Polarity
+  { polarityPosOccurs :: Bool
+  , polarityNegOccurs :: Bool
+  }
+  deriving (Eq, Show)
+
+negatePolarity :: Polarity -> Polarity
+negatePolarity (Polarity pos neg) = (Polarity neg pos)
+
+polarityPos :: Polarity
+polarityPos = Polarity True False
+
+polarityNeg :: Polarity
+polarityNeg = Polarity False True
+
+polarityBoth :: Polarity
+polarityBoth = Polarity True True
+
+polarityNone :: Polarity
+polarityNone = Polarity False False
+
diff --git a/src/ToySolver/SAT/Types.hs b/src/ToySolver/SAT/Types.hs
--- a/src/ToySolver/SAT/Types.hs
+++ b/src/ToySolver/SAT/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables, BangPatterns, FlexibleInstances #-}
 module ToySolver.SAT.Types
   (
   -- * Variable
@@ -26,6 +26,7 @@
   -- * Clause
   , Clause
   , normalizeClause
+  , instantiateClause
   , clauseSubsume
   , evalClause
   , clauseToPBLinAtLeast
@@ -33,6 +34,7 @@
   -- * Cardinality Constraint
   , AtLeast
   , normalizeAtLeast
+  , instantiateAtLeast
   , evalAtLeast
 
   -- * Pseudo Boolean Constraint
@@ -43,6 +45,8 @@
   , normalizePBLinSum
   , normalizePBLinAtLeast
   , normalizePBLinExactly
+  , instantiatePBLinAtLeast
+  , instantiatePBLinExactly
   , cutResolve
   , cardinalityReduction
   , negatePBLinAtLeast
@@ -56,6 +60,7 @@
   -- * XOR Clause
   , XORClause
   , normalizeXORClause
+  , instantiateXORClause
   , evalXORClause
   ) where
 
@@ -68,6 +73,7 @@
 import qualified Data.IntMap as IntMap
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IntSet
+import ToySolver.Data.LBool
 
 -- | Variable is represented as positive integers (DIMACS format).
 type Var = Int
@@ -154,6 +160,21 @@
     xs = IntSet.fromList lits
     ys = xs `IntSet.intersection` (IntSet.map litNot xs)
 
+{-# SPECIALIZE instantiateClause :: (Lit -> IO LBool) -> Clause -> IO (Maybe Clause) #-}
+instantiateClause :: forall m. Monad m => (Lit -> m LBool) -> Clause -> m (Maybe Clause)
+instantiateClause evalLitM = loop []
+  where
+    loop :: [Lit] -> [Lit] -> m (Maybe Clause)
+    loop ret [] = return $ Just ret
+    loop ret (l:ls) = do
+      val <- evalLitM l
+      if val==lTrue then
+        return Nothing
+      else if val==lFalse then
+        loop ret ls
+      else
+        loop (l : ret) ls
+
 clauseSubsume :: Clause -> Clause -> Bool
 clauseSubsume cl1 cl2 = cl1' `IntSet.isSubsetOf` cl2'
   where
@@ -177,6 +198,21 @@
      lits' = xs `IntSet.difference` ys
      n' = n - (IntSet.size ys `div` 2)
 
+{-# SPECIALIZE instantiateAtLeast :: (Lit -> IO LBool) -> AtLeast -> IO AtLeast #-}
+instantiateAtLeast :: forall m. Monad m => (Lit -> m LBool) -> AtLeast -> m AtLeast
+instantiateAtLeast evalLitM (xs,n) = loop ([],n) xs
+  where
+    loop :: AtLeast -> [Lit] -> m AtLeast
+    loop ret [] = return ret
+    loop (ys,m) (l:ls) = do
+      val <- evalLitM l
+      if val == lTrue then
+        loop (ys, m-1) ls
+      else if val == lFalse then
+        loop (ys, m) ls
+      else
+        loop (l:ys, m) ls
+
 evalAtLeast :: IModel m => m -> AtLeast -> Bool
 evalAtLeast m (lits,n) = sum [1 | lit <- lits, evalLit m lit] >= n
 
@@ -260,6 +296,25 @@
       where
         d = foldl1' gcd [c | (c,_) <- xs]
 
+{-# SPECIALIZE instantiatePBLinAtLeast :: (Lit -> IO LBool) -> PBLinAtLeast -> IO PBLinAtLeast #-}
+instantiatePBLinAtLeast :: forall m. Monad m => (Lit -> m LBool) -> PBLinAtLeast -> m PBLinAtLeast
+instantiatePBLinAtLeast evalLitM (xs,n) = loop ([],n) xs
+  where
+    loop :: PBLinAtLeast -> PBLinSum -> m PBLinAtLeast
+    loop ret [] = return ret
+    loop (ys,m) ((c,l):ts) = do
+      val <- evalLitM l
+      if val == lTrue then
+        loop (ys, m-c) ts
+      else if val == lFalse then
+        loop (ys, m) ts
+      else
+        loop ((c,l):ys, m) ts
+
+{-# SPECIALIZE instantiatePBLinExactly :: (Lit -> IO LBool) -> PBLinExactly -> IO PBLinExactly #-}
+instantiatePBLinExactly :: Monad m => (Lit -> m LBool) -> PBLinExactly -> m PBLinExactly
+instantiatePBLinExactly = instantiatePBLinAtLeast
+
 cutResolve :: PBLinAtLeast -> PBLinAtLeast -> Var -> PBLinAtLeast
 cutResolve (lhs1,rhs1) (lhs2,rhs2) v = assert (l1 == litNot l2) $ normalizePBLinAtLeast pb
   where
@@ -340,6 +395,21 @@
       if litPolarity lit
       then IntMap.singleton lit True
       else IntMap.fromList [(litVar lit, True), (0, True)]  -- ¬x = x ⊕ 1
+
+{-# SPECIALIZE instantiateXORClause :: (Lit -> IO LBool) -> XORClause -> IO XORClause #-}
+instantiateXORClause :: forall m. Monad m => (Lit -> m LBool) -> XORClause -> m XORClause
+instantiateXORClause evalLitM (ls,b) = loop [] b ls
+  where
+    loop :: [Lit] -> Bool -> [Lit] -> m XORClause
+    loop lhs !rhs [] = return (lhs, rhs)
+    loop lhs !rhs (l:ls) = do
+      val <- evalLitM l
+      if val==lTrue then
+        loop lhs (not rhs) ls
+      else if val==lFalse then
+        loop lhs rhs ls
+      else
+        loop (l : lhs) rhs ls
 
 evalXORClause :: IModel m => m -> XORClause -> Bool
 evalXORClause m (lits, rhs) = foldl' xor False (map f lits) == rhs
diff --git a/src/ToySolver/Text/LPFile.hs b/src/ToySolver/Text/LPFile.hs
deleted file mode 100644
--- a/src/ToySolver/Text/LPFile.hs
+++ /dev/null
@@ -1,636 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
------------------------------------------------------------------------------
--- |
--- Module      :  ToySolver.Text.LPFile
--- Copyright   :  (c) Masahiro Sakai 2011-2014
--- License     :  BSD-style
--- 
--- Maintainer  :  masahiro.sakai@gmail.com
--- Stability   :  provisional
--- Portability :  portable
---
--- A CPLEX .lp format parser library.
--- 
--- References:
--- 
--- * <http://publib.boulder.ibm.com/infocenter/cosinfoc/v12r2/index.jsp?topic=/ilog.odms.cplex.help/Content/Optimization/Documentation/CPLEX/_pubskel/CPLEX880.html>
--- 
--- * <http://www.gurobi.com/doc/45/refman/node589.html>
--- 
--- * <http://lpsolve.sourceforge.net/5.5/CPLEX-format.htm>
---
------------------------------------------------------------------------------
-module ToySolver.Text.LPFile
-  ( parseString
-  , parseFile
-  , parser
-  , render
-  ) where
-
-import Control.Monad
-import Control.Monad.Writer
-import Data.Char
-import Data.List
-import Data.Maybe
-import Data.Ratio
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.OptDir
-import Text.Parsec hiding (label)
-import Text.Parsec.String
-
-import qualified ToySolver.Data.MIP.Base as MIP
-import ToySolver.Internal.Util (combineMaybe)
-import ToySolver.Internal.TextUtil (readUnsignedInteger)
-
--- ---------------------------------------------------------------------------
-
--- | Parse a string containing LP file data.
--- The source name is only | used in error messages and may be the empty string.
-parseString :: SourceName -> String -> Either ParseError MIP.Problem
-parseString = parse parser
-
--- | Parse a file containing LP file data.
-parseFile :: FilePath -> IO (Either ParseError MIP.Problem)
-parseFile = parseFromFile parser
-
--- ---------------------------------------------------------------------------
-
-char' :: Char -> Parser Char
-char' c = (char c <|> char (toUpper c)) <?> show c
-
-string' :: String -> Parser ()
-string' s = mapM_ char' s <?> show s
-
-sep :: Parser ()
-sep = skipMany ((comment >> return ()) <|> (space >> return ()))
-
-comment :: Parser String
-comment = do
-  char '\\'
-  manyTill anyChar (try newline)
-
-tok :: Parser a -> Parser a
-tok p = do
-  x <- p
-  sep
-  return x
-
-ident :: Parser String
-ident = tok $ do
-  x <- letter <|> oneOf syms1 
-  xs <- many (alphaNum <|> oneOf syms2)
-  let s = x:xs 
-  guard $ map toLower s `Set.notMember` reserved
-  return s
-  where
-    syms1 = "!\"#$%&()/,;?@_`'{}|~"
-    syms2 = '.' : syms1
-
-variable :: Parser MIP.Var
-variable = liftM MIP.toVar ident
-
-label :: Parser MIP.Label
-label = do
-  name <- ident
-  tok $ char ':'
-  return name
-
-reserved :: Set String
-reserved = Set.fromList
-  [ "bound", "bounds"
-  , "gen", "general", "generals"
-  , "bin", "binary", "binaries"
-  , "semi", "semi-continuous", "semis"
-  , "sos"
-  , "end"
-  , "subject"
-  ]
-
--- ---------------------------------------------------------------------------
-
--- | LP file parser
-parser :: Parser MIP.Problem
-parser = do
-  sep
-  (flag, obj) <- problem
-
-  cs <- liftM concat $ many $ msum $
-    [ liftM (map Left) constraintSection
-    , liftM (map Left) lazyConstraintsSection
-    , liftM (map Right) userCutsSection
-    ]
-
-  bnds <- option Map.empty (try boundsSection)
-  exvs <- many (liftM Left generalSection <|> liftM Right binarySection)
-  let ints = Set.fromList $ concat [x | Left  x <- exvs]
-      bins = Set.fromList $ concat [x | Right x <- exvs]
-  bnds2 <- return $ Map.unionWith MIP.intersectBounds
-            bnds (Map.fromAscList [(v, (MIP.Finite 0, MIP.Finite 1)) | v <- Set.toAscList bins])
-  scs <- liftM Set.fromList $ option [] (try semiSection)
-
-  ss <- option [] (try sosSection)
-  end
-  let vs = Set.unions $ map MIP.vars cs ++
-           [ Map.keysSet bnds2
-           , ints
-           , bins
-           , scs
-           , MIP.vars (snd obj)
-           , MIP.vars ss
-           ]
-      isInt v  = v `Set.member` ints || v `Set.member` bins
-      isSemi v = v `Set.member` scs
-  return $
-    MIP.Problem
-    { MIP.dir               = flag
-    , MIP.objectiveFunction = obj
-    , MIP.constraints       = [c | Left c <- cs]
-    , MIP.userCuts          = [c | Right c <- cs]
-    , MIP.sosConstraints    = ss
-    , MIP.varInfo           =
-        Map.fromAscList
-        [ ( v
-          , MIP.VarInfo
-            { MIP.varBounds = Map.findWithDefault MIP.defaultBounds v bnds2
-            , MIP.varType   =
-                if isInt v then
-                  if isSemi v then MIP.SemiIntegerVariable
-                  else MIP.IntegerVariable
-                else
-                  if isSemi v then MIP.SemiContinuousVariable
-                  else MIP.ContinuousVariable
-            }
-          )
-        | v <- Set.toAscList vs
-        ]
-    }
-
-problem :: Parser (OptDir, MIP.ObjectiveFunction)
-problem = do
-  flag <-  (try minimize >> return OptMin)
-       <|> (try maximize >> return OptMax)
-  name <- optionMaybe (try label)
-  obj <- expr
-  return (flag, (name, obj))
-
-minimize, maximize :: Parser ()
-minimize = tok $ string' "min" >> optional (string' "imize")
-maximize = tok $ string' "max" >> optional (string' "imize")
-
-end :: Parser ()
-end = tok $ string' "end"
-
--- ---------------------------------------------------------------------------
-
-constraintSection :: Parser [MIP.Constraint]
-constraintSection = subjectTo >> many (try (constraint False))
-
-subjectTo :: Parser ()
-subjectTo = msum
-  [ try $ tok (string' "subject") >> tok (string' "to")
-  , try $ tok (string' "such") >> tok (string' "that")
-  , try $ tok (string' "st")
-  , try $ tok (string' "s") >> optional (tok (char '.')) >> tok (string' "t")
-        >> tok (char '.') >> return ()
-  ]
-
-constraint :: Bool -> Parser MIP.Constraint
-constraint isLazy = do
-  name <- optionMaybe (try label)
-
-  g <- optionMaybe $ try $ do
-    var <- variable
-    tok (char '=')
-    val <- tok ((char '0' >> return 0) <|> (char '1' >> return 1))
-    tok $ string "->"
-    return (var, val)
-
-  -- It seems that CPLEX allows empty lhs, but GLPK rejects it.
-  e <- expr
-  op <- relOp
-  s <- option 1 sign
-  rhs <- number
-  return $ MIP.Constraint
-    { MIP.constrLabel     = name
-    , MIP.constrIndicator = g
-    , MIP.constrBody      = (e, op, s*rhs)
-    , MIP.constrIsLazy    = isLazy
-    }
-
-relOp :: Parser MIP.RelOp
-relOp = tok $ msum
-  [ char '<' >> optional (char '=') >> return MIP.Le
-  , char '>' >> optional (char '=') >> return MIP.Ge
-  , char '=' >> msum [ char '<' >> return MIP.Le
-                     , char '>' >> return MIP.Ge
-                     , return MIP.Eql
-                     ]
-  ]
-
-lazyConstraintsSection :: Parser [MIP.Constraint]
-lazyConstraintsSection = do
-  tok $ string' "lazy"
-  tok $ string' "constraints"
-  many $ try $ constraint True
-
-userCutsSection :: Parser [MIP.Constraint]
-userCutsSection = do
-  tok $ string' "user"
-  tok $ string' "cuts"
-  many $ try $ constraint False
-
-type Bounds2 = (Maybe MIP.BoundExpr, Maybe MIP.BoundExpr)
-
-boundsSection :: Parser (Map MIP.Var MIP.Bounds)
-boundsSection = do
-  tok $ string' "bound" >> optional (char' 's')
-  liftM (Map.map g . Map.fromListWith f) $ many (try bound)
-  where
-    f (lb1,ub1) (lb2,ub2) = (combineMaybe max lb1 lb2, combineMaybe min ub1 ub2)
-    g (lb, ub) = ( fromMaybe MIP.defaultLB lb
-                 , fromMaybe MIP.defaultUB ub
-                 )
-
-bound :: Parser (MIP.Var, Bounds2)
-bound = msum
-  [ try $ do
-      v <- try variable
-      msum
-        [ do
-            op <- relOp
-            b <- boundExpr
-            return
-              ( v
-              , case op of
-                  MIP.Le -> (Nothing, Just b)
-                  MIP.Ge -> (Just b, Nothing)
-                  MIP.Eql -> (Just b, Just b)
-              )
-        , do
-            tok $ string' "free"
-            return (v, (Just MIP.NegInf, Just MIP.PosInf))
-        ]
-  , do
-      b1 <- liftM Just boundExpr
-      op1 <- relOp
-      guard $ op1 == MIP.Le
-      v <- variable
-      b2 <- option Nothing $ do
-        op2 <- relOp
-        guard $ op2 == MIP.Le
-        liftM Just boundExpr
-      return (v, (b1, b2))
-  ]
-
-boundExpr :: Parser MIP.BoundExpr
-boundExpr = msum 
-  [ try (tok (char '+') >> inf >> return MIP.PosInf)
-  , try (tok (char '-') >> inf >> return MIP.NegInf)
-  , do
-      s <- option 1 sign
-      x <- number
-      return $ MIP.Finite (s*x)
-  ]
-
-inf :: Parser ()
-inf = tok (string "inf" >> optional (string "inity"))
-
--- ---------------------------------------------------------------------------
-
-generalSection :: Parser [MIP.Var]
-generalSection = do
-  tok $ string' "gen" >> optional (string' "eral" >> optional (string' "s"))
-  many (try variable)
-
-binarySection :: Parser [MIP.Var]
-binarySection = do
-  tok $ string' "bin" >> optional (string' "ar" >> (string' "y" <|> string' "ies"))
-  many (try variable)
-
-semiSection :: Parser [MIP.Var]
-semiSection = do
-  tok $ string' "semi" >> optional (string' "-continuous" <|> string' "s")
-  many (try variable)
-
-sosSection :: Parser [MIP.SOSConstraint]
-sosSection = do
-  tok $ string' "sos"
-  many $ try $ do
-    (l,t) <- try (do{ l <- label; t <- typ; return (Just l, t) })
-          <|> (do{ t <- typ; return (Nothing, t) })
-    xs <- many $ try $ do
-      v <- variable
-      tok $ char ':'
-      w <- number
-      return (v,w)
-    return $ MIP.SOSConstraint l t xs
-  where
-    typ = do
-      t <- tok $ (char' 's' >> ((char '1' >> return MIP.S1) <|> (char '2' >> return MIP.S2)))
-      tok (string "::")
-      return t
-
--- ---------------------------------------------------------------------------
-
-expr :: Parser MIP.Expr
-expr = try expr1 <|> return []
-  where
-    expr1 :: Parser MIP.Expr
-    expr1 = do
-      t <- term True
-      ts <- many (term False)
-      return $ concat (t : ts)
-
-sign :: Num a => Parser a
-sign = tok ((char '+' >> return 1) <|> (char '-' >> return (-1)))
-
-term :: Bool -> Parser MIP.Expr
-term flag = do
-  s <- if flag then optionMaybe sign else liftM Just sign
-  c <- optionMaybe number
-  e <- liftM (\s' -> [MIP.Term 1 [s']]) variable <|> qexpr
-  return $ case combineMaybe (*) s c of
-    Nothing -> e
-    Just d -> [MIP.Term (d*c') vs | MIP.Term c' vs <- e]
-
-qexpr :: Parser MIP.Expr
-qexpr = do
-  tok (char '[')
-  t <- qterm True
-  ts <- many (qterm False)
-  tok (char ']')
-  -- Gurobi allows ommiting "/2"
-  (do mapM_ (tok . char) "/2"
-      return [MIP.Term (r / 2) vs | MIP.Term r vs <- t:ts])
-   <|> return (t:ts)
-
-qterm :: Bool -> Parser MIP.Term
-qterm flag = do
-  s <- if flag then optionMaybe sign else liftM Just sign
-  c <- optionMaybe number
-  es <- qfactor `chainl1`  (tok (char '*') >> return (++))
-  return $ case combineMaybe (*) s c of
-    Nothing -> MIP.Term 1 es
-    Just d -> MIP.Term d es
-
-qfactor :: Parser [MIP.Var]
-qfactor = do
-  v <- variable
-  msum [ tok (char '^') >> tok (char '2') >> return [v,v]
-       , return [v]
-       ]
-
-number :: Parser Rational
-number = tok $ do
-  b <- (do{ x <- nat; y <- option 0 frac; return (fromInteger x + y) })
-    <|> frac
-  c <- option 0 e
-  return (b*10^^c)
-  where
-    digits = many1 digit
-
-    nat :: Parser Integer
-    nat = liftM readUnsignedInteger digits
-
-    frac :: Parser Rational
-    frac = do
-      char '.'
-      s <- digits
-      return (readUnsignedInteger s % 10^(length s))
-
-    e :: Parser Integer
-    e = do
-      oneOf "eE"
-      f <- msum [ char '+' >> return id
-                , char '-' >> return negate
-                , return id
-                ]
-      liftM f nat
-
--- ---------------------------------------------------------------------------
-
-type M a = Writer ShowS a
-
-execM :: M a -> String
-execM m = execWriter m ""
-
-writeString :: String -> M ()
-writeString s = tell $ showString s
-
-writeChar :: Char -> M ()
-writeChar c = tell $ showChar c
-
--- ---------------------------------------------------------------------------
-
--- | Render a problem into a string.
-render :: MIP.Problem -> Either String String
-render mip = Right $ execM $ render' $ removeEmptyExpr mip
-
-writeVar :: MIP.Var -> M ()
-writeVar v = writeString $ MIP.fromVar v
-
-render' :: MIP.Problem -> M ()
-render' mip = do
-  writeString $
-    case MIP.dir mip of
-      OptMin -> "MINIMIZE"
-      OptMax -> "MAXIMIZE"
-  writeChar '\n'
-
-  do
-    let (l, obj) = MIP.objectiveFunction mip
-    renderLabel l
-    renderExpr True obj
-    writeChar '\n'
-
-  writeString "SUBJECT TO\n"
-  forM_ (MIP.constraints mip) $ \c -> do
-    unless (MIP.constrIsLazy c) $ do
-      renderConstraint c
-      writeChar '\n'
-
-  let lcs = [c | c <- MIP.constraints mip, MIP.constrIsLazy c]
-  unless (null lcs) $ do
-    writeString "LAZY CONSTRAINTS\n"
-    forM_ lcs $ \c -> do
-      renderConstraint c
-      writeChar '\n'
-
-  let cuts = [c | c <- MIP.userCuts mip]
-  unless (null cuts) $ do
-    writeString "USER CUTS\n"
-    forM_ cuts $ \c -> do
-      renderConstraint c
-      writeChar '\n'
-
-  let ivs = MIP.integerVariables mip `Set.union` MIP.semiIntegerVariables mip
-      (bins,gens) = Set.partition (\v -> MIP.getBounds mip v == (MIP.Finite 0, MIP.Finite 1)) ivs
-      scs = MIP.semiContinuousVariables mip `Set.union` MIP.semiIntegerVariables mip
-
-  writeString "BOUNDS\n"
-  forM_ (Map.toAscList (MIP.varInfo mip)) $ \(v, MIP.VarInfo{ MIP.varBounds = (lb,ub) }) -> do
-    unless (v `Set.member` bins) $ do
-      renderBoundExpr lb
-      writeString " <= "
-      writeVar v
-      writeString " <= "
-      renderBoundExpr ub
-      writeChar '\n'
-
-  unless (Set.null gens) $ do
-    writeString "GENERALS\n"
-    renderVariableList $ Set.toList gens
-
-  unless (Set.null bins) $ do
-    writeString "BINARIES\n"
-    renderVariableList $ Set.toList bins
-
-  unless (Set.null scs) $ do
-    writeString "SEMI-CONTINUOUS\n"
-    renderVariableList $ Set.toList scs
-
-  unless (null (MIP.sosConstraints mip)) $ do
-    writeString "SOS\n"
-    forM_ (MIP.sosConstraints mip) $ \(MIP.SOSConstraint l typ xs) -> do
-      renderLabel l
-      writeString $ show typ
-      writeString " ::"
-      forM_ xs $ \(v, r) -> do
-        writeString "  "
-        writeVar v
-        writeString " : "
-        writeString $ showValue r
-      writeChar '\n'
-
-  writeString "END\n"
-
--- FIXME: Gurobi は quadratic term が最後に一つある形式でないとダメっぽい
-renderExpr :: Bool -> MIP.Expr -> M ()
-renderExpr isObj e = fill 80 (ts1 ++ ts2)
-  where
-    (ts,qts) = partition isLin e 
-    isLin (MIP.Term _ [])  = True
-    isLin (MIP.Term _ [_]) = True
-    isLin _ = False
-
-    ts1 = map f ts
-    ts2
-      | null qts  = []
-      | otherwise =
-        -- マイナスで始めるとSCIP 2.1.1 は「cannot have '-' in front of quadratic part ('[')」というエラーを出す
-        ["+ ["] ++ map g qts ++ [if isObj then "] / 2" else "]"]
-
-    f :: MIP.Term -> String
-    f (MIP.Term c [])  = showConstTerm c
-    f (MIP.Term c [v]) = showCoeff c ++ MIP.fromVar v
-    f _ = error "should not happen"
-
-    g :: MIP.Term -> String
-    g (MIP.Term c vs) = 
-      (if isObj then showCoeff (2*c) else showCoeff c) ++
-      intercalate " * " (map MIP.fromVar vs)
-
-showValue :: Rational -> String
-showValue c =
-  if denominator c == 1
-    then show (numerator c)
-    else show (fromRational c :: Double)
-
-showCoeff :: Rational -> String
-showCoeff c =
-  if c' == 1
-    then s
-    else s ++ showValue c' ++ " "
-  where
-    c' = abs c
-    s = if c >= 0 then "+ " else "- "
-
-showConstTerm :: Rational -> String
-showConstTerm c = s ++ v
-  where
-    s = if c >= 0 then "+ " else "- "
-    v = showValue (abs c)
-
-renderLabel :: Maybe MIP.Label -> M ()
-renderLabel l =
-  case l of
-    Nothing -> return ()
-    Just s -> writeString s >> writeString ": "
-
-renderOp :: MIP.RelOp -> M ()
-renderOp MIP.Le = writeString "<="
-renderOp MIP.Ge = writeString ">="
-renderOp MIP.Eql = writeString "="
-
-renderConstraint :: MIP.Constraint -> M ()
-renderConstraint c@MIP.Constraint{ MIP.constrBody = (e,op,val) }  = do
-  renderLabel (MIP.constrLabel c)
-  case MIP.constrIndicator c of
-    Nothing -> return ()
-    Just (v,vval) -> do
-      writeVar v
-      writeString " = "
-      writeString $ showValue vval
-      writeString " -> "
-
-  renderExpr False e
-  writeChar ' '
-  renderOp op
-  writeChar ' '
-  writeString $ showValue val
-
-renderBoundExpr :: MIP.BoundExpr -> M ()
-renderBoundExpr (MIP.Finite r) = writeString $ showValue r
-renderBoundExpr MIP.NegInf = writeString "-inf"
-renderBoundExpr MIP.PosInf = writeString "+inf"
-
-renderVariableList :: [MIP.Var] -> M ()
-renderVariableList vs = fill 80 (map MIP.fromVar vs) >> writeChar '\n'
-
-fill :: Int -> [String] -> M ()
-fill width str = go str 0
-  where
-    go [] _ = return ()
-    go (x:xs) 0 = writeString x >> go xs (length x)
-    go (x:xs) w =
-      if w + 1 + length x <= width
-        then writeChar ' ' >> writeString x >> go xs (w + 1 + length x)
-        else writeChar '\n' >> go (x:xs) 0
-
--- ---------------------------------------------------------------------------
-
-{-
-compileExpr :: Expr -> Maybe (Map Var Rational)
-compileExpr e = do
-  xs <- forM e $ \(Term c vs) ->
-    case vs of
-      [v] -> return (v, c)
-      _ -> mzero
-  return (Map.fromList xs)
--}
-
--- ---------------------------------------------------------------------------
-
-removeEmptyExpr :: MIP.Problem -> MIP.Problem
-removeEmptyExpr prob =
-  prob
-  { MIP.objectiveFunction =
-      case MIP.objectiveFunction prob of
-        (label, e) -> (label, convertExpr e)
-  , MIP.constraints = map convertConstr $ MIP.constraints prob
-  , MIP.userCuts    = map convertConstr $ MIP.userCuts prob
-  }
-  where
-    convertExpr [] = [MIP.Term 0 [MIP.toVar "x0"]]
-    convertExpr e = e
-
-    convertConstr constr =
-      constr
-      { MIP.constrBody =
-          case MIP.constrBody constr of
-            (lhs,op,rhs) -> (convertExpr lhs, op, rhs)
-      }
diff --git a/src/ToySolver/Text/MPSFile.hs b/src/ToySolver/Text/MPSFile.hs
deleted file mode 100644
--- a/src/ToySolver/Text/MPSFile.hs
+++ /dev/null
@@ -1,850 +0,0 @@
-{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
------------------------------------------------------------------------------
--- |
--- Module      :  ToySolver.Text.MPSFile
--- Copyright   :  (c) Masahiro Sakai 2012-2014
--- License     :  BSD-style
--- 
--- Maintainer  :  masahiro.sakai@gmail.com
--- Stability   :  provisional
--- Portability :  portable
---
--- A .mps format parser library.
--- 
--- References:
--- 
--- * <http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_synopsis.html>
--- 
--- * <http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_synopsis.html>
--- 
--- * <http://www.gurobi.com/documentation/5.0/reference-manual/node744>
---
--- * <http://en.wikipedia.org/wiki/MPS_(format)>
---
------------------------------------------------------------------------------
-module ToySolver.Text.MPSFile
-  ( parseString
-  , parseFile
-  , parser
-  , render
-  ) where
-
-import Control.Monad
-import Control.Monad.Writer
-import Data.Maybe
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Ratio
-import Data.Interned
-import Data.Interned.String
-
-import qualified Text.Parsec as P
-import Text.Parsec hiding (spaces, newline, Column)
-import Text.Parsec.String
-import Text.Printf
-
-import Data.OptDir
-import qualified ToySolver.Data.MIP.Base as MIP
-import ToySolver.Internal.TextUtil (readUnsignedInteger)
-
-type Column = MIP.Var
-type Row = InternedString
-
-data BoundType
-  = LO	-- lower bound
-  | UP	-- upper bound
-  | FX	-- variable is fixed at the specified value
-  | FR	-- free variable (no lower or upper bound)
-  | MI	-- infinite lower bound
-  | PL	-- infinite upper bound
-  | BV	-- variable is binary (equal 0 or 1)
-  | LI	-- lower bound for integer variable
-  | UI	-- upper bound for integer variable
-  | SC	-- upper bound for semi-continuous variable
-  | SI	-- upper bound for semi-integer variable
-  deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
--- ---------------------------------------------------------------------------
-
--- | Parse a string containing MPS file data.
--- The source name is only | used in error messages and may be the empty string.
-parseString :: SourceName -> String -> Either ParseError MIP.Problem
-parseString = parse parser
-
--- | Parse a file containing MPS file data.
-parseFile :: FilePath -> IO (Either ParseError MIP.Problem)
-parseFile = parseFromFile parser
-
--- ---------------------------------------------------------------------------
-
-space' :: Parser Char
-space' = oneOf [' ', '\t']
-
-spaces' :: Parser ()
-spaces' = skipMany space'
-
-spaces1' :: Parser ()
-spaces1' = skipMany1 space'
-
-commentline :: Parser ()
-commentline = do
-  _ <- char '*'
-  _ <- manyTill anyChar P.newline
-  return ()
-
-newline' :: Parser ()
-newline' = do
-  spaces'
-  _ <- P.newline
-  skipMany commentline
-  return ()
-
-tok :: Parser a -> Parser a
-tok p = do
-  x <- p
-  msum [spaces1', lookAhead (try (char '\n' >> return ())), eof]
-  return x
-
-row :: Parser Row
-row = liftM intern ident
-
-column :: Parser Column
-column = liftM MIP.toVar ident
-
-ident :: Parser String
-ident = tok $ many1 $ noneOf [' ', '\t', '\n']
-
-stringLn :: String -> Parser ()
-stringLn s = string s >> newline'
-
-sign :: Num a => Parser a
-sign = (char '+' >> return 1) <|> (char '-' >> return (-1))
-
-number :: Parser Rational
-number = tok $ do
-  b <- (do{ s <- option 1 sign; x <- nat; y <- option 0 frac; return (s * (fromInteger x + y)) })
-    <|> frac
-  c <- option 0 e
-  return (b*10^^c)
-  where
-    digits = many1 digit
-
-    nat :: Parser Integer
-    nat = liftM readUnsignedInteger digits
-
-    frac :: Parser Rational
-    frac = do
-      char '.'
-      s <- digits
-      return (readUnsignedInteger s % 10^(length s))
-
-    e :: Parser Integer
-    e = do
-      oneOf "eE"
-      f <- msum [ char '+' >> return id
-                , char '-' >> return negate
-                , return id
-                ]
-      liftM f nat
-
--- ---------------------------------------------------------------------------
-
--- | MPS file parser
-parser :: Parser MIP.Problem
-parser = do
-  many commentline
-
-  _name <- nameSection
-
-  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_objsen.html
-  -- CPLEX extends the MPS standard by allowing two additional sections: OBJSEN and OBJNAME.
-  -- If these options are used, they must appear in order and as the first and second sections after the NAME section. 
-  objsense <- optionMaybe $ objSenseSection
-  objname  <- optionMaybe $ objNameSection
-
-  rows <- rowsSection
-
-  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_usercuts.html
-  -- The order of sections must be ROWS USERCUTS.  
-  usercuts <- option [] userCutsSection
-
-  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_lazycons.html
-  -- The order of sections must be ROWS USERCUTS LAZYCONS.
-  lazycons <- option [] lazyConsSection
-
-  (cols, intvs1) <- colsSection
-  rhss <- rhsSection
-  rngs <- option Map.empty rangesSection
-  bnds <- option [] boundsSection
-
-  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_quadobj.html
-  -- Following the BOUNDS section, a QMATRIX section may be specified.
-  qobj <- msum [quadObjSection, qMatrixSection, return []]
-
-  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_sos.html
-  -- Note that in an MPS file, the SOS section must follow the BOUNDS section.
-  sos <- option [] sosSection
-
-  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_qcmatrix.html
-  -- QCMATRIX sections appear after the optional SOS section. 
-  qterms <- liftM Map.fromList $ many qcMatrixSection
-
-  -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_indicators.html
-  -- The INDICATORS section follows any quadratic constraint section and any quadratic objective section.
-  inds <- option Map.empty indicatorsSection
-
-  string "ENDATA"
-
-  let objrow =
-        case objname of
-          Nothing -> head [r | (Nothing, r) <- rows] -- XXX
-          Just r  -> intern r
-      objdir =
-        case objsense of
-          Nothing -> OptMin
-          Just d  -> d
-      vs     = Map.keysSet cols `Set.union` Set.fromList [col | (_,col,_) <- bnds]
-      intvs2 = Set.fromList [col | (t,col,_) <- bnds, t `elem` [BV,LI,UI]]
-      scvs   = Set.fromList [col | (SC,col,_) <- bnds]
-      sivs   = Set.fromList [col | (SI,col,_) <- bnds]
-
-  let explicitBounds = Map.fromListWith f
-        [ case typ of
-            LO -> (col, (Just (MIP.Finite val), Nothing))
-            UP -> (col, (Nothing, Just (MIP.Finite val)))
-            FX -> (col, (Just (MIP.Finite val), Just (MIP.Finite val)))
-            FR -> (col, (Just MIP.NegInf, Just MIP.PosInf))
-            MI -> (col, (Just MIP.NegInf, Nothing))
-            PL -> (col, (Nothing, Just MIP.PosInf))
-            BV -> (col, (Just (MIP.Finite 0), Just (MIP.Finite 1)))
-            LI -> (col, (Just (MIP.Finite val), Nothing))
-            UI -> (col, (Nothing, Just (MIP.Finite val)))
-            SC -> (col, (Nothing, Just (MIP.Finite val)))
-            SI -> (col, (Nothing, Just (MIP.Finite val)))
-        | (typ,col,val) <- bnds ]
-        where
-          f (a1,b1) (a2,b2) = (g a1 a2, g b1 b2)
-          g _ (Just x) = Just x
-          g x Nothing  = x
-
-  let bounds = Map.fromList
-        [ case Map.lookup v explicitBounds of
-            Nothing ->
-              if v `Set.member` intvs1
-              then
-                -- http://eaton.math.rpi.edu/cplex90html/reffileformatscplex/reffileformatscplex9.html
-                -- If no bounds are specified for the variables within markers, bounds of 0 (zero) and 1 (one) are assumed.
-                (v, (MIP.Finite 0, MIP.Finite 1))
-              else
-                (v, (MIP.Finite 0, MIP.PosInf))
-            Just (Nothing, Just (MIP.Finite ub)) | ub < 0 ->
-              {-
-                http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_records.html
-                If no bounds are specified, CPLEX assumes a lower
-                bound of 0 (zero) and an upper bound of +∞. If only a
-                single bound is specified, the unspecified bound
-                remains at 0 or +∞, whichever applies, with one
-                exception. If an upper bound of less than 0 is
-                specified and no other bound is specified, the lower
-                bound is automatically set to -∞. CPLEX deviates
-                slightly from a convention used by some MPS readers
-                when it encounters an upper bound of 0 (zero). Rather
-                than automatically set this variable’s lower bound to
-                -∞, CPLEX accepts both a lower and upper bound of 0,
-                effectively fixing that variable at 0. CPLEX resets
-                the lower bound to -∞ only if the upper bound is less
-                than 0. A warning message is issued when this
-                exception is encountered.
-              -}
-              (v, (MIP.NegInf, MIP.Finite ub))
-            {-
-              lp_solve uses 1 as default lower bound for semi-continuous variable.
-              <http://lpsolve.sourceforge.net/5.5/mps-format.htm>
-              But Gurobi Optimizer uses 0 as default lower bound for semi-continuous variable.
-              Here we adopt Gurobi's way.
-            -}
-{-
-            Just (Nothing, ub) | v `Set.member` scvs ->
-              (v, (MIP.Finite 1, fromMaybe MIP.PosInf ub))
--}
-            Just (lb,ub) ->
-              (v, (fromMaybe (MIP.Finite 0) lb, fromMaybe MIP.PosInf ub))
-        | v <- Set.toList vs ]
-
-  let rowCoeffs :: Map Row (Map Column Rational)
-      rowCoeffs = Map.fromListWith Map.union [(row, Map.singleton col coeff) | (col,m) <- Map.toList cols, (row,coeff) <- Map.toList m]
-
-  let f :: Bool -> (Maybe MIP.RelOp, Row) -> [MIP.Constraint]
-      f _isLazy (Nothing, _row) = []
-      f isLazy (Just op, row) = do
-        let lhs = [MIP.Term c [col] | (col,c) <- Map.toList (Map.findWithDefault Map.empty row rowCoeffs)]
-                  ++ Map.findWithDefault [] row qterms
-        let rhs = Map.findWithDefault 0 row rhss
-        (op2,rhs2) <-
-          case Map.lookup row rngs of
-            Nothing  -> return (op, rhs)
-            Just rng ->
-              case op of
-                MIP.Ge  -> [(MIP.Ge, rhs), (MIP.Le, rhs + abs rng)]
-                MIP.Le  -> [(MIP.Ge, rhs - abs rng), (MIP.Le, rhs)]
-                MIP.Eql ->
-                  if rng < 0
-                  then [(MIP.Ge, rhs + rng), (MIP.Le, rhs)]
-                  else [(MIP.Ge, rhs), (MIP.Le, rhs + rng)]
-        return $
-          MIP.Constraint
-          { MIP.constrLabel     = Just $ unintern row
-          , MIP.constrIndicator = Map.lookup row inds
-          , MIP.constrIsLazy    = isLazy
-          , MIP.constrBody      = (lhs, op2, rhs2)
-          }
-
-  let mip =
-        MIP.Problem
-        { MIP.dir                     = objdir
-        , MIP.objectiveFunction       =
-            ( Just (unintern objrow)
-            , [MIP.Term c [col] | (col,m) <- Map.toList cols, c <- maybeToList (Map.lookup objrow m)] ++ qobj
-            )
-        , MIP.constraints           = concatMap (f False) rows ++ concatMap (f True) lazycons
-        , MIP.sosConstraints        = sos
-        , MIP.userCuts              = concatMap (f False) usercuts
-        , MIP.varInfo               =
-            Map.fromAscList
-            [ ( v
-              , MIP.VarInfo
-                { MIP.varBounds = Map.findWithDefault MIP.defaultBounds v bounds
-                , MIP.varType   =
-                    if v `Set.member` sivs then
-                      MIP.SemiIntegerVariable
-                    else if v `Set.member` intvs1 && v `Set.member` scvs then
-                      MIP.SemiIntegerVariable
-                    else if v `Set.member` intvs1 || v `Set.member` intvs2 then
-                      MIP.IntegerVariable
-                    else if v `Set.member` scvs then
-                      MIP.SemiContinuousVariable
-                    else
-                      MIP.ContinuousVariable
-                }
-              )
-            | v <- Set.toAscList vs
-            ]
-        }
-
-  return mip
-
-nameSection :: Parser (Maybe String)
-nameSection = do
-  string "NAME"
-  n <- optionMaybe $ try $ do
-    spaces1'
-    ident
-  newline'
-  return n
-
-objSenseSection :: Parser OptDir
-objSenseSection = do
-  try $ stringLn "OBJSENSE"
-  spaces1'
-  d <-  (try (stringLn "MAX") >> return OptMax)
-    <|> (stringLn "MIN" >> return OptMin)
-  return d
-
-objNameSection :: Parser String
-objNameSection = do
-  try $ stringLn "OBJNAME"
-  spaces1'
-  name <- ident
-  newline'
-  return name
-
-rowsSection :: Parser [(Maybe MIP.RelOp, Row)]
-rowsSection = do
-  try $ stringLn "ROWS"
-  rowsBody
-
-userCutsSection :: Parser [(Maybe MIP.RelOp, Row)]
-userCutsSection = do
-  try $ stringLn "USERCUTS"
-  rowsBody
-
-lazyConsSection :: Parser [(Maybe MIP.RelOp, Row)]
-lazyConsSection = do
-  try $ stringLn "LAZYCONS"
-  rowsBody
-
-rowsBody :: Parser [(Maybe MIP.RelOp, Row)]
-rowsBody = many $ do
-  spaces1'
-  op <- msum
-        [ char 'N' >> return Nothing
-        , char 'G' >> return (Just MIP.Ge)
-        , char 'L' >> return (Just MIP.Le)
-        , char 'E' >> return (Just MIP.Eql)
-        ]
-  spaces1'
-  name <- row
-  newline'
-  return (op, name)
-
-colsSection :: Parser (Map Column (Map Row Rational), Set Column)
-colsSection = do
-  try $ stringLn "COLUMNS"
-  body False Map.empty Set.empty
-  where
-    body :: Bool -> Map Column (Map Row Rational) -> Set Column -> Parser (Map Column (Map Row Rational), Set Column)
-    body isInt rs ivs = msum
-      [ do isInt' <- try intMarker
-           body isInt' rs ivs
-      , do (k,v) <- entry
-           let rs'  = Map.insertWith Map.union k v rs
-               ivs' = if isInt then Set.insert k ivs else ivs
-           seq rs' $ seq ivs' $ body isInt rs' ivs'
-      , return (rs, ivs)
-      ]
-
-    intMarker :: Parser Bool
-    intMarker = do
-      spaces1'
-      _marker <- ident 
-      string "'MARKER'"
-      spaces1'
-      b <-  (try (string "'INTORG'") >> return True)
-        <|> (string "'INTEND'" >> return False)
-      newline'
-      return b
-
-    entry :: Parser (Column, Map Row Rational)
-    entry = do
-      spaces1'
-      col <- column
-      rv1 <- rowAndVal
-      opt <- optionMaybe rowAndVal
-      newline'
-      case opt of
-        Nothing -> return (col, rv1)
-        Just rv2 ->  return (col, Map.union rv1 rv2)
-
-rowAndVal :: Parser (Map Row Rational)
-rowAndVal = do
-  r <- row
-  val <- number
-  return $ Map.singleton r val
-
-rhsSection :: Parser (Map Row Rational)
-rhsSection = do
-  try $ stringLn "RHS"
-  liftM Map.unions $ many entry
-  where
-    entry = do
-      spaces1'
-      _name <- ident
-      rv1 <- rowAndVal
-      opt <- optionMaybe rowAndVal
-      newline'
-      case opt of
-        Nothing  -> return rv1
-        Just rv2 -> return $ Map.union rv1 rv2
-
-rangesSection :: Parser (Map Row Rational)
-rangesSection = do
-  try $ stringLn "RANGES"
-  liftM Map.unions $ many entry
-  where
-    entry = do
-      spaces1'
-      _name <- ident
-      rv1 <- rowAndVal
-      opt <- optionMaybe rowAndVal
-      newline'
-      case opt of
-        Nothing  -> return rv1
-        Just rv2 -> return $ Map.union rv1 rv2
-
-boundsSection :: Parser [(BoundType, Column, Rational)]
-boundsSection = do
-  try $ stringLn "BOUNDS"
-  many entry
-  where
-    entry = do
-      spaces1'
-      typ   <- boundType
-      _name <- ident
-      col   <- column
-      val   <- if typ `elem` [FR, BV, MI, PL]
-               then return 0
-               else number
-      newline'
-      return (typ, col, val)
-
-boundType :: Parser BoundType
-boundType = tok $ do
-  msum [try (string (show k)) >> return k | k <- [minBound..maxBound]]
-
-sosSection :: Parser [MIP.SOSConstraint]
-sosSection = do
-  try $ stringLn "SOS"
-  many entry
-  where
-    entry = do
-      spaces1'
-      typ <-  (try (string "S1") >> return MIP.S1)
-          <|> (string "S2" >> return MIP.S2)
-      spaces1'
-      name <- ident
-      newline'
-      xs <- many (try identAndVal)
-      return $ MIP.SOSConstraint{ MIP.sosLabel = Just name, MIP.sosType = typ, MIP.sosBody = xs }
-
-    identAndVal :: Parser (Column, Rational)
-    identAndVal = do
-      spaces1'
-      col <- column
-      val <- number
-      newline'
-      return (col, val)
-
-quadObjSection :: Parser [MIP.Term]
-quadObjSection = do
-  try $ stringLn "QUADOBJ"
-  many entry
-  where
-    entry = do
-      spaces1'
-      col1 <- column
-      col2 <- column
-      val  <- number
-      newline'
-      return $ MIP.Term (if col1 /= col2 then val else val / 2) [col1, col2]
-
-qMatrixSection :: Parser [MIP.Term]
-qMatrixSection = do
-  try $ stringLn "QMATRIX"
-  many entry
-  where
-    entry = do
-      spaces1'
-      col1 <- column
-      col2 <- column
-      val  <- number
-      newline'
-      return $ MIP.Term (val / 2) [col1, col2]
-
-qcMatrixSection :: Parser (Row, [MIP.Term])
-qcMatrixSection = do
-  try $ string "QCMATRIX"
-  spaces1'
-  r <- row
-  newline'
-  xs <- many entry
-  return (r, xs)
-  where
-    entry = do
-      spaces1'
-      col1 <- column
-      col2 <- column
-      val  <- number
-      newline'
-      return $ MIP.Term val [col1, col2]
-
-indicatorsSection :: Parser (Map Row (Column, Rational))
-indicatorsSection = do
-  try $ stringLn "INDICATORS"
-  liftM Map.fromList $ many entry
-  where
-    entry = do
-      spaces1'
-      string "IF"
-      spaces1'
-      r <- row
-      var <- column
-      val <- number
-      newline'
-      return (r, (var, val))
-
--- ---------------------------------------------------------------------------
-
-type M a = Writer ShowS a
-
-execM :: M a -> String
-execM m = execWriter m ""
-
-writeString :: String -> M ()
-writeString s = tell $ showString s
-
-writeChar :: Char -> M ()
-writeChar c = tell $ showChar c
-
--- ---------------------------------------------------------------------------
-
-render :: MIP.Problem -> Either String String
-render mip | not (checkAtMostQuadratic mip) = Left "Expression must be atmost quadratic"
-render mip = Right $ execM $ render' $ nameRows mip
-
-render' :: MIP.Problem -> M ()
-render' mip = do
-  let probName = ""
-
-  -- NAME section
-  -- The name starts in column 15 in fixed formats.
-  writeSectionHeader $ "NAME" ++ replicate 10 ' ' ++ probName
-
-  -- OBJSENSE section
-  -- Note: GLPK-4.48 does not support this section.
-  writeSectionHeader "OBJSENSE"
-  case MIP.dir mip of
-    OptMin -> writeFields ["MIN"]
-    OptMax -> writeFields ["MAX"]
-
-  let (Just objName, obj) = MIP.objectiveFunction mip
-
-{-
-  -- OBJNAME section
-  -- Note: GLPK-4.48 does not support this section.
-  writeSectionHeader "OBJNAME"
-  writeFields [objName]
--}
-
-  let renderRows cs = do
-        forM_ cs $ \c -> do
-          let (_,op,_) = MIP.constrBody c
-          let s = case op of
-                    MIP.Le  -> "L"
-                    MIP.Ge  -> "G"
-                    MIP.Eql -> "E"
-          writeFields [s, fromJust $ MIP.constrLabel c]
-
-  -- ROWS section
-  writeSectionHeader "ROWS"
-  writeFields ["N", objName]
-  renderRows [c | c <- MIP.constraints mip, not (MIP.constrIsLazy c)]
-
-  -- USERCUTS section
-  unless (null (MIP.userCuts mip)) $ do
-    writeSectionHeader "USERCUTS"
-    renderRows (MIP.userCuts mip)
-
-  -- LAZYCONS section
-  let lcs = [c | c <- MIP.constraints mip, MIP.constrIsLazy c]
-  unless (null lcs) $ do
-    writeSectionHeader "LAZYCONS"
-    renderRows lcs
-
-  -- COLUMNS section
-  writeSectionHeader "COLUMNS"
-  let cols :: Map Column (Map String Rational)
-      cols = Map.fromListWith Map.union
-             [ (v, Map.singleton l d)
-             | (Just l, xs) <-
-                 MIP.objectiveFunction mip :
-                 [(MIP.constrLabel c, lhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let (lhs,_,_) = MIP.constrBody c]
-             , MIP.Term d [v] <- xs
-             ]
-      f col xs =
-        forM_ (Map.toList xs) $ \(row, d) -> do
-          writeFields ["", unintern col, row, showValue d]
-      ivs = MIP.integerVariables mip `Set.union` MIP.semiIntegerVariables mip
-  forM_ (Map.toList (Map.filterWithKey (\col _ -> col `Set.notMember` ivs) cols)) $ \(col, xs) -> f col xs
-  unless (Set.null ivs) $ do
-    writeFields ["", "MARK0000", "'MARKER'", "", "'INTORG'"]
-    forM_ (Map.toList (Map.filterWithKey (\col _ -> col `Set.member` ivs) cols)) $ \(col, xs) -> f col xs
-    writeFields ["", "MARK0001", "'MARKER'", "", "'INTEND'"]
-
-  -- RHS section
-  let rs = [(fromJust $ MIP.constrLabel c, rhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let (_,_,rhs) = MIP.constrBody c, rhs /= 0]
-  writeSectionHeader "RHS"
-  forM_ rs $ \(name, val) -> do
-    writeFields ["", "rhs", name, showValue val]
-
-  -- BOUNDS section
-  writeSectionHeader "BOUNDS"
-  forM_ (Map.toList (MIP.varInfo mip)) $ \(col, vinfo) -> do
-    let (lb,ub) = MIP.varBounds vinfo
-        vt = MIP.varType vinfo
-    case (lb,ub) of
-      (MIP.NegInf, MIP.PosInf) -> do
-        -- free variable (no lower or upper bound)
-        writeFields ["FR", "bound", unintern col]
-                  
-      (MIP.Finite 0, MIP.Finite 1) | vt == MIP.IntegerVariable -> do
-        -- variable is binary (equal 0 or 1)
-        writeFields ["BV", "bound", unintern col] 
-
-      (MIP.Finite a, MIP.Finite b) | a == b -> do
-        -- variable is fixed at the specified value
-        writeFields ["FX", "bound", unintern col, showValue a]
-
-      _ -> do
-        case lb of
-          MIP.PosInf -> error "should not happen"
-          MIP.NegInf -> do
-            -- Minus infinity
-            writeFields ["MI", "bound", unintern col]
-          MIP.Finite 0 | vt == MIP.ContinuousVariable -> return ()
-          MIP.Finite a -> do
-            let t = case vt of
-                      MIP.IntegerVariable -> "LI" -- lower bound for integer variable
-                      _ -> "LO" -- Lower bound
-            writeFields [t, "bound", unintern col, showValue a]
-
-        case ub of
-          MIP.NegInf -> error "should not happen"
-          MIP.PosInf | vt == MIP.ContinuousVariable -> return ()
-          MIP.PosInf -> do
-            when (vt == MIP.SemiContinuousVariable || vt == MIP.SemiIntegerVariable) $
-              error "cannot express +inf upper bound of semi-continuous or semi-integer variable"
-            writeFields ["PL", "bound", unintern col] -- Plus infinity
-          MIP.Finite a -> do
-            let t = case vt of
-                      MIP.SemiContinuousVariable -> "SC" -- Upper bound for semi-continuous variable
-                      MIP.SemiIntegerVariable ->
-                        -- Gurobi uses "SC" while lpsolve uses "SI" for upper bound of semi-integer variable
-                        "SC"
-                      MIP.IntegerVariable -> "UI" -- Upper bound for integer variable
-                      _ -> "UP" -- Upper bound
-            writeFields [t, "bound", unintern col, showValue a]
-
-  -- QMATRIX section
-  -- Gurobiは対称行列になっていないと "qmatrix isn't symmetric" というエラーを発生させる
-  let qm = Map.map (2*) $ quadMatrix obj
-  unless (Map.null qm) $ do
-    writeSectionHeader "QMATRIX"
-    forM_ (Map.toList qm) $ \(((v1,v2), val)) -> do
-      writeFields ["", unintern v1, unintern v2, showValue val]
-
-  -- SOS section
-  unless (null (MIP.sosConstraints mip)) $ do
-    writeSectionHeader "SOS"
-    forM_ (MIP.sosConstraints mip) $ \sos -> do
-      let t = case MIP.sosType sos of
-                MIP.S1 -> "S1"
-                MIP.S2 -> "S2"
-      writeFields $ t : maybeToList (MIP.sosLabel sos)
-      forM_ (MIP.sosBody sos) $ \(var,val) -> do
-        writeFields ["", unintern var, showValue val]
-
-  -- QCMATRIX section
-  let xs = [ (fromJust $ MIP.constrLabel c, qm)
-           | c <- MIP.constraints mip ++ MIP.userCuts mip
-           , let (lhs,_,_) = MIP.constrBody c
-           , let qm = quadMatrix lhs
-           , not (Map.null qm) ]
-  unless (null xs) $ do
-    forM_ xs $ \(row, qm) -> do
-      -- The name starts in column 12 in fixed formats.
-      writeSectionHeader $ "QCMATRIX" ++ replicate 3 ' ' ++ row
-      forM_ (Map.toList qm) $ \((v1,v2), val) -> do
-        writeFields ["", unintern v1, unintern v2, showValue val]
-
-  -- INDICATORS section
-  -- Note: Gurobi-5.6.3 does not support this section.
-  let ics = [c | c <- MIP.constraints mip, isJust $ MIP.constrIndicator c]
-  unless (null ics) $ do
-    writeSectionHeader "INDICATORS"
-    forM_ ics $ \c -> do
-      let Just (var,val) = MIP.constrIndicator c
-      writeFields ["IF", fromJust (MIP.constrLabel c), unintern var, showValue val]
-
-  -- ENDATA section
-  writeSectionHeader "ENDATA"
-
-writeSectionHeader :: String -> M ()
-writeSectionHeader s = writeString s >> writeChar '\n'
-
--- Fields start in column 2, 5, 15, 25, 40 and 50
-writeFields :: [String] -> M ()
-writeFields xs = f1 xs >> writeChar '\n'
-  where
-    -- columns 1-4
-    f1 [] = return ()
-    f1 [x] = writeString (' ' : x)
-    f1 (x:xs) = do
-      writeString $ printf " %-2s " x
-      f2 xs
-
-    -- columns 5-14
-    f2 [] = return ()
-    f2 [x] = writeString x
-    f2 (x:xs) = do
-      writeString $ printf "%-9s " x
-      f3 xs
-
-    -- columns 15-24
-    f3 [] = return ()
-    f3 [x] = writeString x
-    f3 (x:xs) = do
-      writeString $ printf "%-9s " x
-      f4 xs
-
-    -- columns 25-39
-    f4 [] = return ()
-    f4 [x] = writeString x
-    f4 (x:xs) = do
-      writeString $ printf "%-14s " x
-      f5 xs
-
-    -- columns 40-49
-    f5 [] = return ()
-    f5 [x] = writeString x
-    f5 (x:xs) = do
-      writeString $ printf "%-19s " x
-      f6 xs
-
-    -- columns 50-
-    f6 [] = return ()
-    f6 [x] = writeString x
-    f6 _ = error "MPSFile: >6 fields (this should not happen)"
-
-showValue :: Rational -> String
-showValue c =
-  if denominator c == 1
-    then show (numerator c)
-    else show (fromRational c :: Double)
- 
-nameRows :: MIP.Problem -> MIP.Problem
-nameRows mip
-  = mip
-  { MIP.objectiveFunction = (Just objName', obj)
-  , MIP.constraints = f (MIP.constraints mip) ["row" ++ show n | n <- [(1::Int)..]]
-  , MIP.userCuts = f (MIP.userCuts mip) ["usercut" ++ show n | n <- [(1::Int)..]]
-  , MIP.sosConstraints = g (MIP.sosConstraints mip) ["sos" ++ show n | n <- [(1::Int)..]]
-  }
-  where
-    (objName, obj) = MIP.objectiveFunction mip
-    used = Set.fromList $ catMaybes $ objName : [MIP.constrLabel c | c <- MIP.constraints mip ++ MIP.userCuts mip] ++ [MIP.sosLabel c | c <- MIP.sosConstraints mip]
-    objName' = fromMaybe (head [name | n <- [(1::Int)..], let name = "obj" ++ show n, name `Set.notMember` used]) objName
-
-    f [] _ = []
-    f (c:cs) (name:names)
-      | isJust (MIP.constrLabel c) = c : f cs (name:names)
-      | name `Set.notMember` used = c{ MIP.constrLabel = Just name } : f cs names
-      | otherwise = f (c:cs) names
-
-    g [] _ = []
-    g (c:cs) (name:names)
-      | isJust (MIP.sosLabel c) = c : g cs (name:names)
-      | name `Set.notMember` used = c{ MIP.sosLabel = Just name } : g cs names
-      | otherwise = g (c:cs) names
-
-quadMatrix :: MIP.Expr -> Map (MIP.Var, MIP.Var) Rational
-quadMatrix e = Map.fromList $ do
-  let m = Map.fromListWith (+) [(if v1<=v2 then (v1,v2) else (v2,v1), c) | MIP.Term c [v1,v2] <- e]
-  ((v1,v2),c) <- Map.toList m
-  if v1==v2 then
-    [((v1,v2), c)]
-  else
-    [((v1,v2), c/2), ((v2,v1), c/2)]
-
-checkAtMostQuadratic :: MIP.Problem -> Bool
-checkAtMostQuadratic mip =  all (all f) es
-  where
-    es = snd (MIP.objectiveFunction mip) :
-         [lhs | c <- MIP.constraints mip ++ MIP.userCuts mip, let (lhs,_,_) = MIP.constrBody c]
-    f :: MIP.Term -> Bool
-    f (MIP.Term _ [_]) = True
-    f (MIP.Term _ [_,_]) = True
-    f _ = False
-
--- ---------------------------------------------------------------------------
diff --git a/src/ToySolver/Text/PBFile.hs b/src/ToySolver/Text/PBFile.hs
deleted file mode 100644
--- a/src/ToySolver/Text/PBFile.hs
+++ /dev/null
@@ -1,395 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
------------------------------------------------------------------------------
--- |
--- Module      :  ToySolver.Text.PBFile
--- Copyright   :  (c) Masahiro Sakai 2011
--- License     :  BSD-style
--- 
--- Maintainer  :  masahiro.sakai@gmail.com
--- Portability :  non-portable (BangPatterns)
---
--- A parser library for .opb file and .wbo files used by PB Competition.
--- 
--- References:
---
--- * Input/Output Format and Solver Requirements for the Competitions of
---   Pseudo-Boolean Solvers
---   <http://www.cril.univ-artois.fr/PB11/format.pdf>
---
------------------------------------------------------------------------------
-
-module ToySolver.Text.PBFile
-  (
-  -- * Abstract Syntax
-    Formula (..)
-  , Constraint
-  , Op (..)
-  , SoftFormula (..)
-  , SoftConstraint
-  , Sum
-  , WeightedTerm
-  , Term
-  , Lit (..)
-  , Var
-
-  -- * Parsing .opb files
-  , parseOPBString
-  , parseOPBFile
-
-  -- * Parsing .wbo files
-  , parseWBOString
-  , parseWBOFile
-
-  -- * Show .opb files
-  , renderOPB
-
-  -- * Show .wbo files
-  , renderWBO
-  ) where
-
-import Prelude hiding (sum)
-import Control.Exception (assert)
-import Control.Monad
-import Data.List hiding (sum)
-import Data.Maybe
-import Data.Word
-import Text.Parsec
-import Text.Parsec.String
-import Text.Printf
-import ToySolver.Internal.TextUtil
-
--- | Pair of /objective function/ and a list of constraints.
-data Formula
-  = Formula
-  { pbObjectiveFunction :: Maybe Sum
-  , pbConstraints :: [Constraint]
-  , pbNumVars :: !Int
-  , pbNumConstraints :: !Int
-  }
-  deriving (Eq, Ord, Show)
-
--- | Lhs, relational operator and rhs.
-type Constraint = (Sum, Op, Integer)
-
--- | Relational operators
-data Op
-  = Ge -- ^ /greater than or equal/
-  | Eq -- ^ /equal/
-  deriving (Eq, Ord, Show, Enum, Bounded)
-
--- | A pair of /top cost/ and a list of soft constraints.
-data SoftFormula
-  = SoftFormula
-  { wboTopCost :: Maybe Integer
-  , wboConstraints :: [SoftConstraint]
-  , wboNumVars :: !Int
-  , wboNumConstraints :: !Int
-  }
-  deriving (Eq, Ord, Show)
-
--- | A pair of weight and constraint.
-type SoftConstraint = (Maybe Integer, Constraint)
-
--- | Sum of 'WeightedTerm'
-type Sum = [WeightedTerm]
-
--- | Coefficient and 'Term'
-type WeightedTerm = (Integer, Term)
-
--- | List of variables interpreted as products
-type Term = [Lit]
-
--- | Positive (resp. negative) literal is represented as a positive (resp. negative) integer.
-type Lit = Int
-
--- | Variable are repserented positive integer.
-type Var = Int
-
--- <formula>::= <sequence_of_comments> [<objective>] <sequence_of_comments_or_constraints>
-formula :: Parser Formula
-formula = do
-  h <- optionMaybe hint
-  sequence_of_comments
-  obj <- optionMaybe objective
-  cs <- sequence_of_comments_or_constraints
-  return $
-    Formula
-    { pbObjectiveFunction = obj
-    , pbConstraints = cs
-    , pbNumVars = fromMaybe (pbComputeNumVars obj cs) (fmap fst h)
-    , pbNumConstraints = fromMaybe (length cs) (fmap snd h)
-    }
-
-hint :: Parser (Int,Int)
-hint = try $ do
-  _ <- char '*'
-  zeroOrMoreSpace
-  string "#variable="
-  zeroOrMoreSpace
-  nv <- unsigned_integer
-  oneOrMoreSpace  
-  string "#constraint="
-  zeroOrMoreSpace
-  nc <- unsigned_integer
-  _ <- manyTill anyChar eol
-  return (fromIntegral nv, fromIntegral nc)
-
--- <sequence_of_comments>::= <comment> [<sequence_of_comments>]
-sequence_of_comments :: Parser ()
-sequence_of_comments = skipMany comment -- XXX: we allow empty sequence
-
--- <comment>::= "*" <any_sequence_of_characters_other_than_EOL> <EOL>
-comment :: Parser ()
-comment = do
-  _ <- char '*' 
-  _ <- manyTill anyChar eol
-  return ()
-
--- <sequence_of_comments_or_constraints>::= <comment_or_constraint> [<sequence_of_comments_or_constraints>]
-sequence_of_comments_or_constraints :: Parser [Constraint]
-sequence_of_comments_or_constraints = do
-  xs <- many1 comment_or_constraint
-  return $ catMaybes xs
-
--- <comment_or_constraint>::= <comment>|<constraint>
-comment_or_constraint :: Parser (Maybe Constraint)
-comment_or_constraint =
-  (comment >> return Nothing) <|> (liftM Just constraint)
-
--- <objective>::= "min:" <zeroOrMoreSpace> <sum> ";"
-objective :: Parser Sum
-objective = do
-  _ <- string "min:"
-  zeroOrMoreSpace
-  obj <- sum
-  _ <- char ';'
-  eol
-  return obj
-
--- <constraint>::= <sum> <relational_operator> <zeroOrMoreSpace> <integer> <zeroOrMoreSpace> ";"
-constraint :: Parser Constraint
-constraint = do
-  lhs <- sum
-  op <- relational_operator
-  zeroOrMoreSpace
-  rhs <- integer
-  zeroOrMoreSpace
-  semi
-  return (lhs, op, rhs)
-
--- <sum>::= <weightedterm> | <weightedterm> <sum>
-sum :: Parser Sum
-sum = many1 weightedterm
-
--- <weightedterm>::= <integer> <oneOrMoreSpace> <term> <oneOrMoreSpace>
-weightedterm :: Parser WeightedTerm
-weightedterm = do
-  w <- integer
-  oneOrMoreSpace
-  t <- term
-  oneOrMoreSpace
-  return (w,t)
-
--- <integer>::= <unsigned_integer> | "+" <unsigned_integer> | "-" <unsigned_integer>
-integer :: Parser Integer
-integer = msum
-  [ unsigned_integer
-  , char '+' >> unsigned_integer
-  , char '-' >> liftM negate unsigned_integer
-  ]
-
--- <unsigned_integer>::= <digit> | <digit><unsigned_integer>
-unsigned_integer :: Parser Integer
-unsigned_integer = do
-  ds <- many1 digit
-  return $! readUnsignedInteger ds
-
--- <relational_operator>::= ">=" | "="
-relational_operator :: Parser Op
-relational_operator = (string ">=" >> return Ge) <|> (string "=" >> return Eq)
-
--- <variablename>::= "x" <unsigned_integer>
-variablename :: Parser Var
-variablename = do
-  _ <- char 'x'
-  i <- unsigned_integer
-  return $! fromIntegral i
-
--- <oneOrMoreSpace>::= " " [<oneOrMoreSpace>]
-oneOrMoreSpace :: Parser ()
-oneOrMoreSpace  = skipMany1 (char ' ')
-
--- <zeroOrMoreSpace>::= [" " <zeroOrMoreSpace>]
-zeroOrMoreSpace :: Parser ()
-zeroOrMoreSpace = skipMany (char ' ')
-
-eol :: Parser ()
-eol = char '\n' >> return ()
-
-semi :: Parser ()
-semi = char ';' >> eol
-
-{-
-For linear pseudo-Boolean instances, <term> is defined as
-<term>::=<variablename>
-
-For non-linear instances, <term> is defined as
-<term>::= <oneOrMoreLiterals>
--}
-term :: Parser Term
-term = oneOrMoreLiterals
-
--- <oneOrMoreLiterals>::= <literal> | <literal> <oneOrMoreSpace> <oneOrMoreLiterals>
-oneOrMoreLiterals :: Parser [Lit]
-oneOrMoreLiterals = do
-  l <- literal
-  mplus (try $ oneOrMoreSpace >> liftM (l:) (oneOrMoreLiterals)) (return [l])
--- Note that we cannot use sepBy1.
--- In "p `sepBy1` q", p should success whenever q success.
--- But it's not the case here.
-
--- <literal>::= <variablename> | "~"<variablename>
-literal :: Parser Lit
-literal = variablename <|> (char '~' >> liftM negate variablename)
-
--- | Parse a .opb file containing pseudo boolean problem.
-parseOPBString :: SourceName -> String -> Either ParseError Formula
-parseOPBString = parse formula
-
--- | Parse a .opb format string containing pseudo boolean problem.
-parseOPBFile :: FilePath -> IO (Either ParseError Formula)
-parseOPBFile = parseFromFile formula
-
-
--- <softformula>::= <sequence_of_comments> <softheader> <sequence_of_comments_or_constraints>
-softformula :: Parser SoftFormula
-softformula = do
-  h <- optionMaybe hint
-  sequence_of_comments
-  top <- softheader
-  cs <- wbo_sequence_of_comments_or_constraints
-  return $
-    SoftFormula
-    { wboTopCost = top
-    , wboConstraints = cs
-    , wboNumVars = fromMaybe (wboComputeNumVars cs) (fmap fst h)
-    , wboNumConstraints = fromMaybe (length cs) (fmap snd h)
-    }
-
--- <softheader>::= "soft:" [<unsigned_integer>] ";"
-softheader :: Parser (Maybe Integer)
-softheader = do
-  _ <- string "soft:"
-  zeroOrMoreSpace -- XXX
-  top <- optionMaybe unsigned_integer
-  zeroOrMoreSpace -- XXX
-  semi
-  return top
-
--- <sequence_of_comments_or_constraints>::= <comment_or_constraint> [<sequence_of_comments_or_constraints>]
-wbo_sequence_of_comments_or_constraints :: Parser [SoftConstraint]
-wbo_sequence_of_comments_or_constraints = do
-  xs <- many1 wbo_comment_or_constraint
-  return $ catMaybes xs
-
--- <comment_or_constraint>::= <comment>|<constraint>|<softconstraint>
-wbo_comment_or_constraint :: Parser (Maybe SoftConstraint)
-wbo_comment_or_constraint = (comment >> return Nothing) <|> m
-  where
-    m = liftM Just $ (constraint >>= \c -> return (Nothing, c)) <|> softconstraint
-
--- <softconstraint>::= "[" <zeroOrMoreSpace> <unsigned_integer> <zeroOrMoreSpace> "]" <constraint>
-softconstraint :: Parser SoftConstraint
-softconstraint = do
-  _ <- char '['
-  zeroOrMoreSpace
-  cost <- unsigned_integer
-  zeroOrMoreSpace
-  _ <- char ']'
-  zeroOrMoreSpace -- XXX
-  c <- constraint
-  return (Just cost, c)
-
--- | Parse a .wbo file containing weighted boolean optimization problem.
-parseWBOString :: SourceName -> String -> Either ParseError SoftFormula
-parseWBOString = parse softformula
-
--- | Parse a .wbo format string containing weighted boolean optimization problem.
-parseWBOFile :: FilePath -> IO (Either ParseError SoftFormula)
-parseWBOFile = parseFromFile softformula
-
-
-renderOPB :: Formula -> String
-renderOPB opb = showOPB opb ""
-
-renderWBO :: SoftFormula -> String
-renderWBO wbo = showWBO wbo ""
-
-showOPB :: Formula -> ShowS
-showOPB opb = (size . part1 . part2)
-  where
-    nv = pbNumVars opb
-    nc = pbNumConstraints opb
-    size = showString (printf "* #variable= %d #constraint= %d\n" nv nc)
-    part1 = 
-      case pbObjectiveFunction opb of
-        Nothing -> id
-        Just o -> showString "min: " . showSum o . showString ";\n"
-    part2 = foldr (.) id (map showConstraint (pbConstraints opb))
-
-showWBO :: SoftFormula -> ShowS
-showWBO wbo = size . part1 . part2
-  where
-    nv = wboNumVars wbo
-    nc = wboNumConstraints wbo
-    size = showString (printf "* #variable= %d #constraint= %d\n" nv nc)
-    part1 = 
-      case wboTopCost wbo of
-        Nothing -> showString "soft: ;\n"
-        Just t -> showString "soft: " . showsPrec 0 t . showString ";\n"
-    part2 = foldr (.) id (map showSoftConstraint (wboConstraints wbo))
-
-showSum :: Sum -> ShowS
-showSum = foldr (.) id . map showWeightedTerm
-
-showWeightedTerm :: WeightedTerm -> ShowS
-showWeightedTerm (c, lits) = foldr (\f g -> f . showChar ' ' . g) id (x:xs)
-  where
-    x = if c >= 0 then showChar '+' . showsPrec 0 c else showsPrec 0 c
-    xs = map showLit lits
-
-showLit :: Lit -> ShowS
-showLit lit =   if lit > 0 then v else showChar '~' . v
-  where
-    v = showChar 'x' . showsPrec 0 (abs lit)
-
-showConstraint :: Constraint -> ShowS
-showConstraint (lhs, op, rhs) =
-  showSum lhs . f op .  showChar ' ' . showsPrec 0 rhs . showString ";\n"
-  where
-    f Eq = showString "="
-    f Ge = showString ">="
-
-showSoftConstraint :: SoftConstraint -> ShowS
-showSoftConstraint (cost, constr) =
-  case cost of
-    Nothing -> showConstraint constr
-    Just c -> showChar '[' . showsPrec 0 c . showChar ']' . showChar ' ' . showConstraint constr
-
-pbComputeNumVars :: Maybe Sum -> [Constraint] -> Int
-pbComputeNumVars obj cs = maximum (0 : vs)
-  where
-    vs = do
-      s <- maybeToList obj ++ [s | (s,_,_) <- cs]
-      (_, tm) <- s
-      lit <- tm
-      return $ abs lit
-
-wboComputeNumVars :: [SoftConstraint] -> Int
-wboComputeNumVars cs = maximum (0 : vs)
-  where
-    vs = do
-      s <- [s | (_, (s,_,_)) <- cs]
-      (_, tm) <- s
-      lit <- tm
-      return $ abs lit
diff --git a/src/ToySolver/Version.hs b/src/ToySolver/Version.hs
--- a/src/ToySolver/Version.hs
+++ b/src/ToySolver/Version.hs
@@ -14,9 +14,6 @@
 #ifdef VERSION_OptDir
   , ("OptDir",       VERSION_OptDir       )
 #endif
-#ifdef VERSION_algebra
-  , ("algebra",      VERSION_algebra      )
-#endif
 #ifdef VERSION_array
   , ("array",        VERSION_array        )
 #endif
@@ -26,15 +23,27 @@
 #ifdef VERSION_bytestring
   , ("bytestring",   VERSION_bytestring   )
 #endif
+#ifdef VERSION_bytestring_builder
+  , ("bytestring-builder",   VERSION_bytestring_builder   )
+#endif
 #ifdef VERSION_containers
   , ("containers",   VERSION_containers   )
 #endif
 #ifdef VERSION_data_interval
-  , ("data-interval",VERSION_data_interval)
+  , ("data-interval", VERSION_data_interval)
 #endif
+#ifdef VERSION_data_default_class
+  , ("data-default-class", VERSION_data_default_class)
+#endif
 #ifdef VERSION_deepseq
   , ("deepseq",      VERSION_deepseq      )
 #endif
+#ifdef VERSION_exceptions
+  , ("exceptions",   VERSION_exceptions   )
+#endif
+#ifdef VERSION_extended_reals
+  , ("extended-reals", VERSION_extended_reals)
+#endif
 #ifdef VERSION_filepath
   , ("filepath",     VERSION_filepath     )
 #endif
@@ -50,8 +59,8 @@
 #ifdef VERSION_intern
   , ("intern",       VERSION_intern       )
 #endif
-#ifdef VERSION_lattices
-  , ("lattices",     VERSION_lattices     )
+#ifdef VERSION_loop
+  , ("loop",         VERSION_loop         )
 #endif
 #ifdef VERSION_mtl
   , ("mtl",          VERSION_mtl          )
@@ -74,6 +83,12 @@
 #ifdef VERSION_primes
   , ("primes",       VERSION_primes       )
 #endif
+#ifdef VERSION_process
+  , ("process",      VERSION_process      )
+#endif
+#ifdef VERSION_pseudo_boolean
+  , ("pseudo-boolean", VERSION_pseudo_boolean)
+#endif
 #ifdef VERSION_queue
   , ("queue",        VERSION_queue        )
 #endif
@@ -85,6 +100,9 @@
 #endif
 #ifdef VERSION_stm
   , ("stm",          VERSION_stm          )
+#endif
+#ifdef VERSION_temporary
+  , ("temporary",    VERSION_time         )
 #endif
 #ifdef VERSION_time
   , ("time",         VERSION_time         )
diff --git a/test/TestAReal.hs b/test/TestAReal.hs
--- a/test/TestAReal.hs
+++ b/test/TestAReal.hs
@@ -2,12 +2,10 @@
 
 import Data.Maybe
 import Data.Ratio
-import Test.HUnit hiding (Test)
-import Test.QuickCheck
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 
 import ToySolver.Data.Polynomial (UPolynomial, X (..))
 import qualified ToySolver.Data.Polynomial as P
diff --git a/test/TestAReal2.hs b/test/TestAReal2.hs
--- a/test/TestAReal2.hs
+++ b/test/TestAReal2.hs
@@ -2,12 +2,10 @@
 
 import Data.Maybe
 import Data.Ratio
-import Test.HUnit hiding (Test)
-import Test.QuickCheck
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 
 import Data.Polynomial (UPolynomial, X (..))
 import qualified Data.Polynomial as P
diff --git a/test/TestArith.hs b/test/TestArith.hs
--- a/test/TestArith.hs
+++ b/test/TestArith.hs
@@ -8,14 +8,13 @@
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Data.VectorSpace
-import Test.HUnit hiding (Test)
-import Test.QuickCheck hiding ((.&&.), (.||.))
+
+import Test.Tasty
+import Test.Tasty.QuickCheck hiding ((.&&.), (.||.))
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import qualified Test.QuickCheck as QC
 import qualified Test.QuickCheck.Monadic as QM
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
 
 import qualified Data.Interval as Interval
 import Data.OptDir
@@ -423,6 +422,30 @@
   mapM_ (Simplex2.assertAtomEx solver) (snd test2')
   ret <- Simplex2.check solver
   ret @?= True
+
+prop_Simplex2_backtrack :: Property
+prop_Simplex2_backtrack = QM.monadicIO $ do
+   (vs,cs) <- QM.pick genQFLAConj
+   (vs2,cs2) <- QM.pick genQFLAConj
+
+   join $ QM.run $ do
+     solver <- Simplex2.newSolver
+     m <- liftM IM.fromList $ forM (IS.toList (vs `IS.union` vs2)) $ \v -> do
+       v2 <- Simplex2.newVar solver
+       return (v, LA.var v2)
+     forM_ cs $ \c -> do
+       Simplex2.assertAtomEx solver (LA.applySubstAtom m c)
+     ret <- Simplex2.check solver
+     if ret then do
+       Simplex2.pushBacktrackPoint solver
+       forM_ cs2 $ \c -> do
+         Simplex2.assertAtomEx solver (LA.applySubstAtom m c)
+       _ <- Simplex2.check solver
+       Simplex2.popBacktrackPoint solver
+       ret2 <- Simplex2.check solver
+       return $ QM.assert ret2
+     else do
+       return $ return ()
 
 ------------------------------------------------------------------------
 
diff --git a/test/TestCongruenceClosure.hs b/test/TestCongruenceClosure.hs
--- a/test/TestCongruenceClosure.hs
+++ b/test/TestCongruenceClosure.hs
@@ -2,9 +2,9 @@
 {-# OPTIONS_GHC -Wall #-}
 module Main (main) where
 
-import Test.HUnit hiding (Test)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 
 import ToySolver.CongruenceClosure
 
diff --git a/test/TestContiTraverso.hs b/test/TestContiTraverso.hs
--- a/test/TestContiTraverso.hs
+++ b/test/TestContiTraverso.hs
@@ -7,10 +7,11 @@
 import qualified Data.IntSet as IS
 import qualified Data.Map as Map
 import Data.VectorSpace
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 
 import Data.OptDir
 
diff --git a/test/TestLPFile.hs b/test/TestLPFile.hs
--- a/test/TestLPFile.hs
+++ b/test/TestLPFile.hs
@@ -4,11 +4,11 @@
 import Control.Monad
 import Data.List
 import Data.Maybe
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import ToySolver.Text.LPFile
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.HUnit
+import Test.Tasty.TH
+import ToySolver.Data.MIP.LPFile
 
 case_testdata       = checkString "testdata" testdata
 case_test_indicator = checkFile "samples/lp/test-indicator.lp"
diff --git a/test/TestMIPSolver2.hs b/test/TestMIPSolver2.hs
--- a/test/TestMIPSolver2.hs
+++ b/test/TestMIPSolver2.hs
@@ -7,10 +7,9 @@
 import qualified Data.IntMap as IM
 import qualified Data.IntSet as IS
 import Data.VectorSpace
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import Text.Printf
 
 import qualified ToySolver.Data.LA as LA
diff --git a/test/TestMPSFile.hs b/test/TestMPSFile.hs
--- a/test/TestMPSFile.hs
+++ b/test/TestMPSFile.hs
@@ -4,11 +4,11 @@
 import Control.Monad
 import Data.List
 import Data.Maybe
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import ToySolver.Text.MPSFile
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.HUnit
+import Test.Tasty.TH
+import ToySolver.Data.MIP.MPSFile
 
 case_testdata = checkString "testdata" testdata
 case_example2 = checkFile "samples/mps/example2.mps"
diff --git a/test/TestPBFile.hs b/test/TestPBFile.hs
deleted file mode 100644
--- a/test/TestPBFile.hs
+++ /dev/null
@@ -1,144 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Main (main) where
-
-import Control.Monad
-import Data.List
-import Data.Maybe
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import ToySolver.Text.PBFile
-
-case_exampleLIN  = checkOPBString "exampleLIN"  exampleLIN
-case_exampleNLC1 = checkOPBString "exampleNLC1" exampleNLC1
-case_exampleNLC2 = checkOPBString "exampleNLC2" exampleNLC2
-case_exampleWBO1 = checkWBOString "exampleWBO1" exampleWBO1
-case_exampleWBO2 = checkWBOString "exampleWBO2" exampleWBO2
-case_exampleWBO3 = checkWBOString "exampleWBO3" exampleWBO3
-
-------------------------------------------------------------------------
--- Sample data
-
-exampleLIN :: String
-exampleLIN = unlines
-  [ "* #variable= 5 #constraint= 4"
-  , "*"
-  , "* this is a dummy instance"
-  , "*"
-  , "min: 1 x2 -1 x3 ;"
-  , "1 x1 +4 x2 -2 x5 >= 2;"
-  , "-1 x1 +4 x2 -2 x5 >= +3;"
-  , "12345678901234567890 x4 +4 x3 >= 10;"
-  , "* an equality constraint"
-  , "2 x2 +3 x4 +2 x1 +3 x5 = 5;"
-  ]
-
-exampleNLC1 :: String
-exampleNLC1 = unlines
-  [ "* #variable= 5 #constraint= 4 #product= 5 sizeproduct= 13"
-  , "*"
-  , "* this is a dummy instance"
-  , "*"
-  , "min: 1 x2 x3 -1 x3 ;"
-  , "1 x1 +4 x1 ~x2 -2 x5 >= 2;"
-  , "-1 x1 +4 x2 -2 x5 >= 3;"
-  , "12345678901234567890 x4 +4 x3 >= 10;"
-  , "2 x2 x3 +3 x4 ~x5 +2 ~x1 x2 +3 ~x1 x2 x3 ~x4 ~x5 = 5 ;"
-  ]
-
-exampleNLC2 :: String
-exampleNLC2 = unlines
-  [ "* #variable= 6 #constraint= 3 #product= 9 sizeproduct= 18"
-  , "*"
-  , "* Factorization problem: find the smallest P such that P*Q=N"
-  , "* P is a 3 bits number (x3 x2 x1)"
-  , "* Q is a 3 bits number (x6 x5 x4)"
-  , "* N=35"
-  , "* "
-  , "* minimize the value of P"
-  , "min: +1 x1 +2 x2 +4 x3 ;"
-  , "* P>=2 (to avoid trivial factorization)"
-  , "+1 x1 +2 x2 +4 x3 >=2;"
-  , "* Q>=2 (to avoid trivial factorization)"
-  , "+1 x4 +2 x5 +4 x6 >=2;"
-  , "*"
-  , "* P*Q=N"
-  , "+1 x1 x4 +2 x1 x5 +4 x1 x6 +2 x2 x4 +4 x2 x5 +8 x2 x6 +4 x3 x4 +8 x3 x5 +16 x3 x6 = 35;"
-  ]
-
-exampleWBO1 :: String
-exampleWBO1 = unlines $
-  [ "* #variable= 1 #constraint= 2 #soft= 2 mincost= 2 maxcost= 3 sumcost= 5"
-  , "soft: 6 ;"
-  , "[2] +1 x1 >= 1 ;"
-  , "[3] -1 x1 >= 0 ;"
-  ]
-
-exampleWBO2 :: String
-exampleWBO2 = unlines $
-  [ "* #variable= 2 #constraint= 3 #soft= 2 mincost= 2 maxcost= 3 sumcost= 5"
-  , "soft: 6 ;"
-  , "[2] +1 x1 >= 1 ;"
-  , "[3] +1 x2 >= 1 ;"
-  , "-1 x1 -1 x2 >= -1 ;"
-  ]
-
-exampleWBO3 :: String
-exampleWBO3 = unlines $
-  [ "* #variable= 4 #constraint= 6 #soft= 4 mincost= 2 maxcost= 5 sumcost= 14"
-  , "soft: 6 ;"
-  , "[2] +1 x1 >= 1;"
-  , "[3] +1 x2 >= 1;"
-  , "[4] +1 x3 >= 1;"
-  , "[5] +1 x4 >= 1;"
-  , "-1 x1 -1 x2 >= -1 ;"
-  , "-1 x3 -1 x4 >= -1 ;"
-  ]
-
-------------------------------------------------------------------------
--- Utilities
-
-checkOPBFile :: FilePath -> IO ()
-checkOPBFile fname = do
-  r <- parseOPBFile fname
-  case r of
-    Left err -> assertFailure $ show err
-    Right _  -> return ()
-
-checkOPBString :: String -> String -> IO ()
-checkOPBString name str = do
-  case parseOPBString name str of
-    Left err -> assertFailure $ show err
-    Right _  -> return ()
-
-checkWBOFile :: FilePath -> IO ()
-checkWBOFile fname = do
-  r <- parseWBOFile fname
-  case r of
-    Left err -> assertFailure $ show err
-    Right _  -> return ()
-
-checkWBOString :: String -> String -> IO ()
-checkWBOString name str = do
-  case parseWBOString name str of
-    Left err -> assertFailure $ show err
-    Right _  -> return ()
-
-testOPB :: String -> Bool
-testOPB s = sf == sf2
-  where
-    Right sf  = parseOPBString "-" s
-    Right sf2 = parseOPBString "-" (renderOPB sf)
-
-testWBO :: String -> Bool
-testWBO s = sf == sf2
-  where
-    Right sf  = parseWBOString "-" s
-    Right sf2 = parseWBOString "-" (renderWBO sf)
-
-------------------------------------------------------------------------
--- Test harness
-
-main :: IO ()
-main = $(defaultMainGenerator)
diff --git a/test/TestPolynomial.hs b/test/TestPolynomial.hs
--- a/test/TestPolynomial.hs
+++ b/test/TestPolynomial.hs
@@ -8,12 +8,10 @@
 import Data.Ratio
 import qualified Data.Set as Set
 import qualified Data.Map as Map
-import Test.HUnit hiding (Test)
-import Test.QuickCheck
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import Text.PrettyPrint.HughesPJClass
 
 import ToySolver.Data.Polynomial (Polynomial, Term, Monomial, UPolynomial, UTerm, UMonomial, X (..))
diff --git a/test/TestSAT.hs b/test/TestSAT.hs
--- a/test/TestSAT.hs
+++ b/test/TestSAT.hs
@@ -3,44 +3,47 @@
 
 import Control.Monad
 import Data.Array.IArray
+import Data.IORef
 import Data.List
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IntSet
-import Test.HUnit hiding (Test)
-import Test.QuickCheck hiding ((.&&.), (.||.))
+import qualified System.Random as Rand
+
+import Test.Tasty
+import Test.Tasty.QuickCheck hiding ((.&&.), (.||.))
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import qualified Test.QuickCheck.Monadic as QM
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
 
 import ToySolver.Data.LBool
 import ToySolver.Data.BoolExpr
 import ToySolver.Data.Boolean
 import ToySolver.SAT
 import ToySolver.SAT.Types
+import ToySolver.SAT.TheorySolver
 import qualified ToySolver.SAT.TseitinEncoder as Tseitin
 import qualified ToySolver.SAT.MUS as MUS
+import qualified ToySolver.SAT.MUS.QuickXplain as QuickXplain
 import qualified ToySolver.SAT.MUS.CAMUS as CAMUS
 import qualified ToySolver.SAT.MUS.DAA as DAA
 import qualified ToySolver.SAT.PBO as PBO
+import qualified ToySolver.SAT.PBNLC as PBNLC
 
 prop_solveCNF :: Property
 prop_solveCNF = QM.monadicIO $ do
   cnf@(nv,_) <- QM.pick arbitraryCNF
-  ret <- QM.run $ solveCNF cnf
+  solver <- arbitrarySolver
+  ret <- QM.run $ solveCNF solver cnf
   case ret of
     Just m -> QM.assert $ evalCNF m cnf == True
     Nothing -> do
       forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do
         QM.assert $ evalCNF m cnf == False
 
-solveCNF :: (Int,[Clause]) -> IO (Maybe Model)
-solveCNF (nv,cs) = do
-  solver <- newSolver
-  setCheckModel solver True
+solveCNF :: Solver -> (Int,[Clause]) -> IO (Maybe Model)
+solveCNF solver (nv,cs) = do
   newVars_ solver nv
   forM_ cs $ \c -> addClause solver c
   ret <- solve solver
@@ -69,19 +72,32 @@
 prop_solvePB :: Property
 prop_solvePB = QM.monadicIO $ do
   prob@(nv,_) <- QM.pick arbitraryPB
-  ret <- QM.run $ solvePB prob
+  solver <- arbitrarySolver
+  ret <- QM.run $ solvePB solver prob
   case ret of
     Just m -> QM.assert $ evalPB m prob == True
     Nothing -> do
       forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do
         QM.assert $ evalPB m prob == False
 
-solvePB :: (Int,[PBLinAtLeast]) -> IO (Maybe Model)
-solvePB (nv,cs) = do
-  solver <- newSolver
-  setCheckModel solver True
+data PBRel = PBRelGE | PBRelEQ | PBRelLE deriving (Eq, Ord, Enum, Bounded, Show)
+
+instance Arbitrary PBRel where
+  arbitrary = arbitraryBoundedEnum  
+
+evalPBRel :: Ord a => PBRel -> a -> a -> Bool
+evalPBRel PBRelGE = (>=)
+evalPBRel PBRelLE = (<=)
+evalPBRel PBRelEQ = (==)
+
+solvePB :: Solver -> (Int,[(PBRel,PBLinSum,Integer)]) -> IO (Maybe Model)
+solvePB solver (nv,cs) = do
   newVars_ solver nv
-  forM_ cs $ \c -> addPBAtLeast solver (fst c) (snd c)
+  forM_ cs $ \(o,lhs,rhs) -> do
+    case o of
+      PBRelGE -> addPBAtLeast solver lhs rhs
+      PBRelLE -> addPBAtMost solver lhs rhs
+      PBRelEQ -> addPBExactly solver lhs rhs
   ret <- solve solver
   if ret then do
     m <- getModel solver
@@ -89,12 +105,13 @@
   else do
     return Nothing
 
-arbitraryPB :: Gen (Int,[PBLinAtLeast])
+arbitraryPB :: Gen (Int,[(PBRel,PBLinSum,Integer)])
 arbitraryPB = do
   nv <- choose (0,10)
   nc <- choose (0,50)
   cs <- replicateM nc $ do
-    len <- choose (0,10)    
+    rel <- arbitrary
+    len <- choose (0,10)
     lhs <-
       if nv == 0 then
         return []
@@ -104,26 +121,76 @@
           c <- arbitrary
           return (c,l)
     rhs <- arbitrary
-    return (lhs,rhs)
+    return $ (rel,lhs,rhs)
   return (nv, cs)
 
-evalPB :: Model -> (Int,[PBLinAtLeast]) -> Bool
-evalPB m (_,cs) = all (evalPBLinAtLeast m) cs
+evalPB :: Model -> (Int,[(PBRel,PBLinSum,Integer)]) -> Bool
+evalPB m (_,cs) = all (\(o,lhs,rhs) -> evalPBRel o (evalPBLinSum m lhs) rhs) cs
 
 
+prop_solvePBNLC :: Property
+prop_solvePBNLC = QM.monadicIO $ do
+  prob@(nv,_) <- QM.pick arbitraryPBNLC
+  solver <- arbitrarySolver
+  ret <- QM.run $ solvePBNLC solver prob
+  case ret of
+    Just m -> QM.assert $ evalPBNLC m prob == True
+    Nothing -> do
+      forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do
+        QM.assert $ evalPBNLC m prob == False
+
+solvePBNLC :: Solver -> (Int,[(PBRel,PBNLC.PBSum,Integer)]) -> IO (Maybe Model)
+solvePBNLC solver (nv,cs) = do
+  newVars_ solver nv
+  enc <- Tseitin.newEncoder solver
+  forM_ cs $ \(o,lhs,rhs) -> do
+    case o of
+      PBRelGE -> PBNLC.addPBAtLeast enc lhs rhs
+      PBRelLE -> PBNLC.addPBAtMost enc lhs rhs
+      PBRelEQ -> PBNLC.addPBExactly enc lhs rhs
+  ret <- solve solver
+  if ret then do
+    m <- getModel solver
+    return (Just m)
+  else do
+    return Nothing
+
+arbitraryPBNLC :: Gen (Int,[(PBRel,PBNLC.PBSum,Integer)])
+arbitraryPBNLC = do
+  nv <- choose (0,10)
+  nc <- choose (0,50)
+  cs <- replicateM nc $ do
+    rel <- arbitrary
+    len <- choose (0,10)
+    lhs <-
+      if nv == 0 then
+        return []
+      else
+        replicateM len $ do
+          ls <- listOf $ choose (-nv, nv) `suchThat` (/= 0)
+          c <- arbitrary
+          return (c,ls)
+    rhs <- arbitrary
+    return $ (rel,lhs,rhs)
+  return (nv, cs)
+
+evalPBNLC :: Model -> (Int,[(PBRel,PBNLC.PBSum,Integer)]) -> Bool
+evalPBNLC m (_,cs) = all (\(o,lhs,rhs) -> evalPBRel o (PBNLC.evalPBSum m lhs) rhs) cs
+
+
 prop_solveXOR :: Property
 prop_solveXOR = QM.monadicIO $ do
   prob@(nv,_) <- QM.pick arbitraryXOR
-  ret <- QM.run $ solveXOR prob
+  solver <- arbitrarySolver
+  ret <- QM.run $ solveXOR solver prob
   case ret of
     Just m -> QM.assert $ evalXOR m prob == True
     Nothing -> do
       forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do
         QM.assert $ evalXOR m prob == False
 
-solveXOR :: (Int,[XORClause]) -> IO (Maybe Model)
-solveXOR (nv,cs) = do
-  solver <- newSolver
+solveXOR :: Solver -> (Int,[XORClause]) -> IO (Maybe Model)
+solveXOR solver (nv,cs) = do
   setCheckModel solver True
   newVars_ solver nv
   forM_ cs $ \c -> addXORClause solver (fst c) (snd c)
@@ -153,6 +220,66 @@
 evalXOR m (_,cs) = all (evalXORClause m) cs
 
 
+newTheorySolver :: (Int, [Clause]) -> IO TheorySolver
+newTheorySolver cnf@(nv,cs) = do
+  solver <- newSolver
+  newVars_ solver nv
+  forM_ cs $ \c -> addClause solver c
+  
+  ref <- newIORef []
+  let tsolver =
+        TheorySolver
+        { thAssertLit = \_ l -> do
+            if abs l > nv then
+              return True
+            else do
+              m <- readIORef ref
+              case m of
+                [] -> addClause solver [l]
+                xs : xss -> writeIORef ref ((l : xs) : xss)
+              return True
+        , thCheck = \_ -> do
+            xs <- liftM concat $ readIORef ref
+            solveWith solver xs
+        , thExplain = \m -> do
+            case m of
+              Nothing -> do
+                ls <- getFailedAssumptions solver
+                return [-l | l <- ls]
+              Just _ -> return []
+        , thPushBacktrackPoint = modifyIORef ref ([] :)
+        , thPopBacktrackPoint = modifyIORef ref tail
+        }
+  return tsolver
+
+prop_solveCNF_using_BooleanTheory :: Property
+prop_solveCNF_using_BooleanTheory = QM.monadicIO $ do
+  cnf@(nv,cs) <- QM.pick arbitraryCNF
+  let cnf1 = (nv, [c | (i,c) <- zip [0..] cs, i `mod` 2 == 0])
+      cnf2 = (nv, [c | (i,c) <- zip [0..] cs, i `mod` 2 /= 0])
+
+  solver <- arbitrarySolver
+
+  ret <- QM.run $ do
+    newVars_ solver nv
+
+    tsolver <- newTheorySolver cnf1
+    setTheory solver tsolver
+
+    forM_ (snd cnf2) $ \c -> addClause solver c
+    ret <- solve solver
+    if ret then do
+      m <- getModel solver
+      return (Just m)
+    else do
+      return Nothing
+
+  case ret of
+    Just m -> QM.assert $ evalCNF m cnf == True
+    Nothing -> do
+      forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do
+        QM.assert $ evalCNF m cnf == False
+
 -- should be SAT
 case_solve_SAT :: IO ()
 case_solve_SAT = do
@@ -731,6 +858,7 @@
   let f = (x1 .=>. x3 .&&. x4) .||. (x2 .=>. x3 .&&. x5)
         where
           [x1,x2,x3,x4,x5] = map Atom xs
+      g :: Model -> Bool
       g m = (not x1 || (x3 && x4)) || (not x2 || (x3 && x5))
         where
           [x1,x2,x3,x4,x5] = elems m
@@ -760,6 +888,25 @@
       expected = map IntSet.fromList [[1, 2], [1, 3, 4], [1, 5, 6]]
   actual' `elem` expected @?= True
 
+case_MUS_QuickXplain = do
+  solver <- newSolver
+  [x1,x2,x3] <- newVars solver 3
+  sels@[y1,y2,y3,y4,y5,y6] <- newVars solver 6
+  addClause solver [-y1, x1]
+  addClause solver [-y2, -x1]
+  addClause solver [-y3, -x1, x2]
+  addClause solver [-y4, -x2]
+  addClause solver [-y5, -x1, x3]
+  addClause solver [-y6, -x3]
+
+  ret <- solveWith solver sels
+  ret @?= False
+
+  actual <- QuickXplain.findMUSAssumptions solver QuickXplain.defaultOptions
+  let actual'  = IntSet.map (\x -> x-3) actual
+      expected = map IntSet.fromList [[1, 2], [1, 3, 4], [1, 5, 6]]
+  actual' `elem` expected @?= True
+
 ------------------------------------------------------------------------
 
 {-
@@ -1037,6 +1184,52 @@
   let actual'   = Set.fromList actual
       expected' = Set.fromList $ map IntSet.fromList cores
   actual' @?= expected'
+
+------------------------------------------------------------------------
+
+instance Arbitrary LearningStrategy where
+  arbitrary = arbitraryBoundedEnum
+
+instance Arbitrary RestartStrategy where
+  arbitrary = arbitraryBoundedEnum
+
+instance Arbitrary PBHandlerType where
+  arbitrary = arbitraryBoundedEnum
+
+arbitrarySolver :: QM.PropertyM IO Solver
+arbitrarySolver = do
+  seed <- QM.pick arbitrary
+  learningStrategy <- QM.pick arbitrary
+  restartStrategy <- QM.pick arbitrary
+  restartFirst <- QM.pick arbitrary
+  restartInc <- QM.pick $ liftM ((1.01 +) . abs) arbitrary
+  learntSizeFirst <- QM.pick arbitrary
+  learntSizeInc <- QM.pick $ liftM ((1.01 +) . abs) arbitrary
+  pbhandler <- QM.pick arbitrary
+  ccmin <- QM.pick $ choose (0,2)
+  phaseSaving <- QM.pick arbitrary
+  forwardSubsumptionRemoval <- QM.pick arbitrary
+  backwardSubsumptionRemoval <- QM.pick arbitrary
+  randomFreq <- QM.pick $ choose (0,1)
+  splitClausePart <- QM.pick arbitrary
+  QM.run $ do
+    solver <- newSolver
+    setRandomGen solver (Rand.mkStdGen seed)
+    setCheckModel solver True
+    setLearningStrategy solver learningStrategy
+    setRestartStrategy solver restartStrategy
+    setRestartFirst solver restartFirst
+    setRestartInc solver restartInc
+    setLearntSizeFirst solver learntSizeFirst
+    setLearntSizeInc solver learntSizeInc
+    setPBHandlerType solver pbhandler
+    setCCMin solver ccmin
+    setEnablePhaseSaving solver phaseSaving
+    setEnableForwardSubsumptionRemoval solver forwardSubsumptionRemoval
+    setEnableBackwardSubsumptionRemoval solver backwardSubsumptionRemoval
+    setRandomFreq solver randomFreq
+    setPBSplitClausePart solver splitClausePart
+    return solver
 
 ------------------------------------------------------------------------
 -- Test harness
diff --git a/test/TestSDPFile.hs b/test/TestSDPFile.hs
--- a/test/TestSDPFile.hs
+++ b/test/TestSDPFile.hs
@@ -4,10 +4,10 @@
 import Control.Monad
 import Data.List
 import Data.Maybe
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import ToySolver.Text.SDPFile
 
 ------------------------------------------------------------------------
diff --git a/test/TestSimplex.hs b/test/TestSimplex.hs
--- a/test/TestSimplex.hs
+++ b/test/TestSimplex.hs
@@ -9,10 +9,9 @@
 import qualified Data.IntSet as IntSet
 import Data.List
 import Data.Ratio
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import Text.Printf
 
 import qualified ToySolver.Data.LA as LA
diff --git a/test/TestSimplex2.hs b/test/TestSimplex2.hs
--- a/test/TestSimplex2.hs
+++ b/test/TestSimplex2.hs
@@ -5,12 +5,10 @@
 import Data.List
 import Data.Ratio
 import Data.VectorSpace
-import Test.HUnit hiding (Test)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.HUnit
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import Text.Printf
-
 import qualified ToySolver.Data.LA as LA
 import ToySolver.Arith.Simplex2
 
diff --git a/test/TestUtil.hs b/test/TestUtil.hs
--- a/test/TestUtil.hs
+++ b/test/TestUtil.hs
@@ -1,19 +1,22 @@
 {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
 module Main (main) where
 
+import Prelude hiding (all)
+
 import Control.Applicative
+import Control.Arrow
 import Control.Monad
+import Data.Foldable (all)
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IntSet
+import Data.Ratio
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Test.HUnit hiding (Test)
-import Test.QuickCheck hiding ((.&&.), (.||.))
 import Test.QuickCheck.Function
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.TH
-import Test.Framework.Providers.QuickCheck2
-import Test.Framework.Providers.HUnit
+import Test.Tasty
+import Test.Tasty.QuickCheck hiding ((.&&.), (.||.))
+import Test.Tasty.HUnit
+import Test.Tasty.TH
 import ToySolver.Data.Boolean
 import ToySolver.Data.BoolExpr
 import qualified ToySolver.Internal.Data.Vec as Vec
@@ -22,6 +25,8 @@
 import qualified ToySolver.Combinatorial.Knapsack.BB as KnapsackBB
 import qualified ToySolver.Combinatorial.Knapsack.DP as KnapsackDP
 import qualified ToySolver.Combinatorial.HittingSet.Simple as HittingSet
+import qualified ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996 as FredmanKhachiyan1996
+import qualified ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999 as GurvichKhachiyan1999
 import qualified ToySolver.Wang as Wang
 
 case_showRationalAsDecimal :: IO ()
@@ -43,7 +48,7 @@
   readUnsignedInteger "006666666666666667" @?= 6666666666666667
 
 prop_readUnsignedInteger = 
-  forAll (choose (0, 2^128)) $ \i -> 
+  forAll (choose (0, 2^(128::Int))) $ \i -> 
     readUnsignedInteger (show i) == i
 
 -- ---------------------------------------------------------------------
@@ -81,53 +86,181 @@
 -- ---------------------------------------------------------------------
 -- Hitting sets
 
-case_minimalHittingSets_1 = actual' @?= expected'
+case_minimalHittingSets_1 = actual @?= expected
   where
-    actual    = HittingSet.minimalHittingSets $ map IntSet.fromList [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]]
-    actual'   = Set.fromList actual
-    expected  = map IntSet.fromList [[1,2], [1,3,4], [1,5,6]]
-    expected' = Set.fromList expected
+    actual    = HittingSet.minimalHittingSets $ Set.fromList $ map IntSet.fromList [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]]
+    expected  = Set.fromList $ map IntSet.fromList [[1,2], [1,3,4], [1,5,6]]
 
 -- an example from http://kuma-san.net/htcbdd.html
-case_minimalHittingSets_2 = actual' @?= expected'
+case_minimalHittingSets_2 = actual @?= expected
   where
-    actual    = HittingSet.minimalHittingSets $ map IntSet.fromList [[2,4,7], [7,8], [9], [9,10]]
-    actual'   = Set.fromList actual
-    expected  = map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
-    expected' = Set.fromList expected
+    actual    = HittingSet.minimalHittingSets $ Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9], [9,10]]
+    expected  = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
 
-hyperGraph :: Gen [IntSet]
+hyperGraph :: Gen (Set IntSet)
 hyperGraph = do
   nv <- choose (0, 10)
   ne <- if nv==0 then return 0 else choose (0, 20)
-  replicateM ne $ do
+  liftM Set.fromList $ replicateM ne $ do
     n <- choose (1,nv)
     liftM IntSet.fromList $ replicateM n $ choose (1, nv)
 
-isHittingSetOf :: IntSet -> [IntSet] -> Bool
+isHittingSetOf :: IntSet -> Set IntSet -> Bool
 isHittingSetOf s g = all (\e -> not (IntSet.null (s `IntSet.intersection` e))) g
 
 prop_minimalHittingSets_duality =
   forAll hyperGraph $ \g ->
     let h = HittingSet.minimalHittingSets g
-    in normalize h == normalize (HittingSet.minimalHittingSets (HittingSet.minimalHittingSets h))
-  where
-    normalize :: [IntSet] -> Set IntSet
-    normalize = Set.fromList
+    in h == HittingSet.minimalHittingSets (HittingSet.minimalHittingSets h)
 
 prop_minimalHittingSets_isHittingSet =
   forAll hyperGraph $ \g ->
-    and [s `isHittingSetOf` g | s <- HittingSet.minimalHittingSets g]
+    all (`isHittingSetOf` g) (HittingSet.minimalHittingSets g)
 
 prop_minimalHittingSets_minimality =
   forAll hyperGraph $ \g ->
-    forAll (elements (HittingSet.minimalHittingSets g)) $ \s ->
+    forAll (elements (Set.toList (HittingSet.minimalHittingSets g))) $ \s ->
       if IntSet.null s then
         property True
       else
         forAll (elements (IntSet.toList s)) $ \v ->
           not $ IntSet.delete v s `isHittingSetOf` g
 
+mutuallyDualHypergraphs :: Gen (Set IntSet, Set IntSet)
+mutuallyDualHypergraphs = do
+  g <- liftM HittingSet.minimalHittingSets hyperGraph
+  let f = HittingSet.minimalHittingSets g
+  return (f,g)
+
+mutuallyDualDNFs :: Gen (Set IntSet, Set IntSet)
+mutuallyDualDNFs = do
+  (f,g) <- mutuallyDualHypergraphs
+  let xs = IntSet.unions $ Set.toList $ f `Set.union` g
+  if IntSet.null xs then
+    return (f,g)
+  else do
+    let xs' = IntSet.toList xs
+    let mutate h = liftM Set.unions $ do
+          forM (Set.toList h) $ \is -> oneof $
+            [ return $ Set.singleton is
+            , do i <- elements xs'
+                 return $ Set.fromList [is, IntSet.insert i is]
+            ]
+    f' <- mutate f
+    g' <- mutate g
+    return (f',g')
+
+-- Pair of DNFs that are nearly dual.
+pairOfDNFs :: Gen (Set IntSet, Set IntSet)
+pairOfDNFs = do
+  (f,g) <- mutuallyDualDNFs
+  let mutate h = liftM Set.unions $ do
+        forM (Set.toList h) $ \is -> oneof $
+          [return Set.empty, return (Set.singleton is)] ++
+          [ do x <- elements (IntSet.toList is)
+               return $ Set.singleton $ IntSet.delete x is
+          | not (IntSet.null is)
+          ]
+  return (f,g)
+
+prop_FredmanKhachiyan1996_checkDualityA_prop1 =
+  forAll mutuallyDualDNFs $ \(f,g) ->
+    FredmanKhachiyan1996.checkDualityA f g == Nothing
+
+prop_FredmanKhachiyan1996_checkDualityA_prop2 =
+  forAll pairOfDNFs $ \(f,g) ->
+    case FredmanKhachiyan1996.checkDualityA f g of
+      Nothing -> True
+      Just xs -> xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)
+
+prop_FredmanKhachiyan1996_checkDualityB_prop1 =
+  forAll mutuallyDualDNFs $ \(f,g) ->
+    FredmanKhachiyan1996.checkDualityA f g == Nothing
+
+prop_FredmanKhachiyan1996_checkDualityB_prop2 =
+  forAll pairOfDNFs $ \(f,g) ->
+    case FredmanKhachiyan1996.checkDualityB f g of
+      Nothing -> True
+      Just xs -> xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)
+
+prop_FredmanKhachiyan1996_lemma_1 =
+  forAll mutuallyDualHypergraphs $ \(f,g) ->
+    let e :: Rational
+        e = sum [1 % (2 ^ IntSet.size i) | i <- Set.toList f] +
+            sum [1 % (2 ^ IntSet.size j) | j <- Set.toList g]
+    in e >= 1
+
+prop_FredmanKhachiyan1996_corollary_1 =
+  forAll mutuallyDualHypergraphs $ \(f,g) ->
+    let n = Set.size f + Set.size g
+        m = minimum [IntSet.size is | is <- Set.toList (f `Set.union` g)]
+    in fromIntegral m <= logBase 2 (fromIntegral n)
+
+prop_FredmanKhachiyan1996_lemma_2 =
+  forAll mutuallyDualHypergraphs $ \(f,g) ->
+    let n = Set.size f + Set.size g
+        epsilon :: Double
+        epsilon = 1 / logBase 2 (fromIntegral n)
+        vs = IntSet.unions $ Set.toList $ f `Set.union` g
+    in (Set.size f * Set.size g >= 1)
+       ==> any (\v -> FredmanKhachiyan1996.occurFreq v f >= epsilon || FredmanKhachiyan1996.occurFreq v g >= epsilon) (IntSet.toList vs)
+
+prop_FredmanKhachiyan1996_lemma_3_a =
+  forAll mutuallyDualHypergraphs $ \(f,g) ->
+    let vs = IntSet.unions $ Set.toList $ f `Set.union` g
+        x = IntSet.findMin vs
+        -- f = x f0 ∨ f1
+        (f0, f1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) f
+        -- g = x g0 ∨ g1
+        (g0, g1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) g
+    in not (IntSet.null vs)
+       ==>
+         HittingSet.minimalHittingSets f1 == FredmanKhachiyan1996.deleteRedundancy (g0 `Set.union` g1) &&
+         HittingSet.minimalHittingSets g1 == FredmanKhachiyan1996.deleteRedundancy (f0 `Set.union` f1)
+
+prop_FredmanKhachiyan1996_to_selfDuality =
+  forAll mutuallyDualHypergraphs $ \(f,g) ->
+    let vs = IntSet.unions $ Set.toList $ f `Set.union` g
+        y = if IntSet.null vs then 0 else IntSet.findMax vs + 1
+        z = y + 1
+        h = FredmanKhachiyan1996.deleteRedundancy $ Set.unions
+              [ Set.map (IntSet.insert y) f
+              , Set.map (IntSet.insert z) g
+              , Set.singleton (IntSet.fromList [y,z])
+              ] 
+    in HittingSet.minimalHittingSets h == h
+
+prop_GurvichKhachiyan1999_generateCNFAndDNF =
+  forAll hyperGraph $ \g ->
+    let vs = IntSet.unions $ Set.toList g
+        f xs = any (\is -> not $ IntSet.null $ xs `IntSet.intersection` is) (Set.toList g)
+        dual f is = not $ f (vs `IntSet.difference` is)
+        is `isImplicantOf` f = f is
+        is `isImplicateOf` f = is `isImplicantOf` dual f
+        is `isPrimeImplicantOf` f = is `isImplicantOf` f && all (\i -> not (IntSet.delete i is `isImplicantOf` f)) (IntSet.toList is)
+        is `isPrimeImplicateOf` f = is `isImplicateOf` f && all (\i -> not (IntSet.delete i is `isImplicateOf` f)) (IntSet.toList is)
+        (cnf,dnf) = GurvichKhachiyan1999.generateCNFAndDNF vs f Set.empty Set.empty
+    in all (`isPrimeImplicantOf` f) (Set.toList dnf) &&
+       all (`isPrimeImplicateOf` f) (Set.toList cnf)
+
+prop_GurvichKhachiyan1999_minimalHittingSets_duality =
+  forAll hyperGraph $ \g ->
+    let h = GurvichKhachiyan1999.minimalHittingSets g
+    in h == GurvichKhachiyan1999.minimalHittingSets (GurvichKhachiyan1999.minimalHittingSets h)
+
+prop_GurvichKhachiyan1999_minimalHittingSets_isHittingSet =
+  forAll hyperGraph $ \g ->
+    all (`isHittingSetOf` g) (GurvichKhachiyan1999.minimalHittingSets g)
+
+prop_GurvichKhachiyan1999_minimalHittingSets_minimality =
+  forAll hyperGraph $ \g ->
+    forAll (elements (Set.toList (GurvichKhachiyan1999.minimalHittingSets g))) $ \s ->
+      if IntSet.null s then
+        property True
+      else
+        forAll (elements (IntSet.toList s)) $ \v ->
+          not $ IntSet.delete v s `isHittingSetOf` g
+
 -- ---------------------------------------------------------------------
 -- Vec
 
@@ -176,7 +309,8 @@
 instance Arbitrary a => Arbitrary (BoolExpr a) where
   arbitrary = sized f
     where
-      f n =        
+      f n | n <= 0 = Atom <$> arbitrary
+      f n =
         oneof
         [ Atom <$> arbitrary
         , And <$> list (n-1)
@@ -184,7 +318,9 @@
         , Not <$> (f (n-1))
         , uncurry Imply <$> pair (n-1)
         , uncurry Equiv <$> pair (n-1)
+        , triple (n-1) >>= \(c,t,e) -> return (ITE c t e)
         ]
+
       pair n | n <= 0 = do
         a <- f 0
         b <- f 0
@@ -194,6 +330,20 @@
         a <- f m
         b <- f (n-m)
         return (a,b)
+
+      triple n | n <= 0 = do
+        a <- f 0
+        b <- f 0
+        c <- f 0
+        return (a,b,c)
+      triple n = do
+        m <- choose (0, n)
+        o <- choose (0, n-m)
+        a <- f m
+        b <- f o
+        c <- f (n - m - o)
+        return (a,b,c)
+
       list n | n <= 0 = return []
       list n = oneof $
         [ return []
diff --git a/toysat/toysat.hs b/toysat/toysat.hs
--- a/toysat/toysat.hs
+++ b/toysat/toysat.hs
@@ -58,6 +58,8 @@
 import qualified GHC.Stats as Stats
 #endif
 
+import qualified Data.PseudoBoolean as PBFile
+import qualified Data.PseudoBoolean.Attoparsec as PBFileAttoparsec
 import ToySolver.Data.ArithRel
 import qualified ToySolver.Data.MIP as MIP
 import qualified ToySolver.Converter.MaxSAT2WBO as MaxSAT2WBO
@@ -66,18 +68,17 @@
 import qualified ToySolver.SAT.PBO as PBO
 import qualified ToySolver.SAT.Integer as Integer
 import qualified ToySolver.SAT.TseitinEncoder as Tseitin
+import qualified ToySolver.SAT.PBNLC as PBNLC
 import qualified ToySolver.SAT.MUS as MUS
+import qualified ToySolver.SAT.MUS.QuickXplain as QuickXplain
 import qualified ToySolver.SAT.MUS.CAMUS as CAMUS
 import qualified ToySolver.SAT.MUS.DAA as DAA
 import ToySolver.SAT.Printer
-import qualified ToySolver.Text.PBFile as PBFile
-import qualified ToySolver.Text.LPFile as LPFile
-import qualified ToySolver.Text.MPSFile as MPSFile
 import qualified ToySolver.Text.MaxSAT as MaxSAT
 import qualified ToySolver.Text.GCNF as GCNF
 import qualified ToySolver.Text.GurobiSol as GurobiSol
 import ToySolver.Version
-import ToySolver.Internal.Util (showRational, revMapM, revForM)
+import ToySolver.Internal.Util (showRational, revForM)
 
 import UBCSAT
 
@@ -85,6 +86,8 @@
 
 data Mode = ModeHelp | ModeVersion | ModeSAT | ModeMUS | ModePB | ModeWBO | ModeMaxSAT | ModeMIP
 
+data MUSMethod = MUSLinear | MUSQuickXplain
+
 data AllMUSMethod = AllMUSCAMUS | AllMUSDAA
 
 data Options
@@ -104,9 +107,11 @@
   , optRandomGen     :: Maybe Rand.StdGen
   , optLinearizerPB  :: Bool
   , optPBHandlerType :: SAT.PBHandlerType
+  , optPBSplitClausePart :: Bool
   , optSearchStrategy       :: PBO.SearchStrategy
   , optObjFunVarsHeuristics :: Bool
   , optLocalSearchInitial   :: Bool
+  , optMUSMethod :: MUSMethod
   , optAllMUSes :: Bool
   , optAllMUSMethod :: AllMUSMethod
   , optPrintRational :: Bool
@@ -136,10 +141,12 @@
   , optRandomGen     = Nothing
   , optLinearizerPB  = False
   , optPBHandlerType = SAT.defaultPBHandlerType
+  , optPBSplitClausePart = SAT.defaultPBSplitClausePart
   , optEnableBackwardSubsumptionRemoval = SAT.defaultEnableBackwardSubsumptionRemoval
   , optSearchStrategy       = PBO.defaultSearchStrategy
   , optObjFunVarsHeuristics = PBO.defaultEnableObjFunVarsHeuristics
   , optLocalSearchInitial   = False
+  , optMUSMethod = MUSLinear
   , optAllMUSes = False
   , optAllMUSMethod = AllMUSCAMUS
   , optPrintRational = False  
@@ -218,6 +225,12 @@
     , Option [] ["pb-handler"]
         (ReqArg (\val opt -> opt{ optPBHandlerType = parsePBHandler val }) "<name>")
         "PB constraint handler: counter (default), pueblo"
+    , Option [] ["pb-split-clause-part"]
+        (NoArg (\opt -> opt{ optPBSplitClausePart = True }))
+        ("Split clause part of PB constraints." ++ (if SAT.defaultPBSplitClausePart then " (default)" else ""))
+    , Option [] ["no-pb-split-clause-part"]
+        (NoArg (\opt -> opt{ optPBSplitClausePart = False }))
+        ("Do not split clause part of PB constraints." ++ (if SAT.defaultPBSplitClausePart then "" else " (default)"))
 
     , Option [] ["search"]
         (ReqArg (\val opt -> opt{ optSearchStrategy = parseSearch val }) "<str>")
@@ -233,11 +246,14 @@
         "Use local search (currently UBCSAT) for finding initial solution"
 
     , Option [] ["all-mus"]
-        (NoArg (\opt -> opt{ optAllMUSes = True }))
+        (NoArg (\opt -> opt{ optMode = Just ModeMUS, optAllMUSes = True }))
         "enumerate all MUSes"
-    , Option [] ["all-mus-daa"]
-        (NoArg (\opt -> opt{ optAllMUSes = True, optAllMUSMethod = AllMUSDAA }))
-        "enumerate all MUSes using DAA instead of CAMUS (experimental option)"
+    , Option [] ["mus-method"]
+        (ReqArg (\val opt -> opt{ optMUSMethod = parseMUSMethod val }) "<str>")
+        "MUS computation method: linear (default), QuickXplain"
+    , Option [] ["all-mus-method"]
+        (ReqArg (\val opt -> opt{ optAllMUSMethod = parseAllMUSMethod val }) "<str>")
+        "MUS enumeration method: camus (default), daa"
 
     , Option [] ["print-rational"]
         (NoArg (\opt -> opt{ optPrintRational = True }))
@@ -278,6 +294,18 @@
         "bcd2"     -> PBO.BCD2
         _ -> error (printf "unknown search strategy \"%s\"" s)
 
+    parseMUSMethod s =
+      case map toLower s of
+        "linear"      -> MUSLinear
+        "quickxplain" -> MUSQuickXplain
+        _ -> error (printf "unknown MUS finding method \"%s\"" s)
+
+    parseAllMUSMethod s =
+      case map toLower s of
+        "camus"    -> AllMUSCAMUS
+        "daa"      -> AllMUSDAA
+        _ -> error (printf "unknown MUS enumeration method \"%s\"" s)
+
     parseLS s =
       case map toLower s of
         "clause" -> SAT.LearningClause
@@ -461,6 +489,7 @@
   SAT.setEnableForwardSubsumptionRemoval solver (optEnableForwardSubsumptionRemoval opts)
   SAT.setEnableBackwardSubsumptionRemoval solver (optEnableBackwardSubsumptionRemoval opts)
   SAT.setPBHandlerType solver (optPBHandlerType opts)
+  SAT.setPBSplitClausePart solver (optPBSplitClausePart opts)
   SAT.setLogger solver putCommentLine
   SAT.setCheckModel solver (optCheckModel opts)
   return solver
@@ -470,7 +499,7 @@
 mainSAT :: Options -> SAT.Solver -> [String] -> IO ()
 mainSAT opt solver args = do
   ret <- case args of
-           ["-"]   -> fmap (DIMACS.parseByteString "-") $ BS.hGetContents stdin
+           ["-"]   -> liftM (DIMACS.parseByteString "-") $ BS.hGetContents stdin
            [fname] -> DIMACS.parseFile fname
            _ -> showHelp stderr >> exitFailure
   case ret of
@@ -541,16 +570,19 @@
       writeSOLFile opt m Nothing (GCNF.numVars gcnf)
     else do
       if not (optAllMUSes opt)
-        then do
+      then do
           let opt2 = def
                      { MUS.optLogger = putCommentLine
                      , MUS.optLitPrinter = \lit ->
                          show (sel2idx ! lit)
                      }
-          mus <- MUS.findMUSAssumptions solver opt2
+          mus <-
+            case optMUSMethod opt of
+              MUSLinear -> MUS.findMUSAssumptions solver opt2
+              MUSQuickXplain -> QuickXplain.findMUSAssumptions solver opt2
           let mus2 = sort $ map (sel2idx !) $ IntSet.toList mus
           musPrintSol stdout mus2
-        else do
+      else do
           counter <- newIORef 1
           let opt2 = def
                      { CAMUS.optLogger = putCommentLine
@@ -574,11 +606,11 @@
 mainPB :: Options -> SAT.Solver -> [String] -> IO ()
 mainPB opt solver args = do
   ret <- case args of
-           ["-"]   -> fmap (PBFile.parseOPBString "-") $ hGetContents stdin
-           [fname] -> PBFile.parseOPBFile fname
+           ["-"]   -> liftM PBFileAttoparsec.parseOPBByteString $ BS.hGetContents stdin
+           [fname] -> PBFileAttoparsec.parseOPBFile fname
            _ -> showHelp stderr >> exitFailure
   case ret of
-    Left err -> hPrint stderr err >> exitFailure
+    Left err -> hPutStrLn stderr err >> exitFailure
     Right formula -> solvePB opt solver formula Nothing
 
 solvePB :: Options -> SAT.Solver -> PBFile.Formula -> Maybe SAT.Model -> IO ()
@@ -593,10 +625,9 @@
   Tseitin.setUsePB enc (optLinearizerPB opt)
 
   forM_ (PBFile.pbConstraints formula) $ \(lhs, op, rhs) -> do
-    lhs' <- pbConvSum enc lhs
     case op of
-      PBFile.Ge -> SAT.addPBAtLeast solver lhs' rhs
-      PBFile.Eq -> SAT.addPBExactly solver lhs' rhs
+      PBFile.Ge -> PBNLC.addPBAtLeast enc lhs rhs
+      PBFile.Eq -> PBNLC.addPBExactly enc lhs rhs
 
   case PBFile.pbObjectiveFunction formula of
     Nothing -> do
@@ -608,9 +639,10 @@
         writeSOLFile opt m Nothing nv
 
     Just obj' -> do
-      obj'' <- pbConvSum enc obj'
+      -- TODO: consider polarity
+      obj'' <- PBNLC.linearizePBSum enc obj'
 
-      nv' <- SAT.nVars solver
+      nv' <- SAT.getNVars solver
       defs <- Tseitin.getDefinitions enc
       let extendModel :: SAT.Model -> SAT.Model
           extendModel m = array (1,nv') (assocs a)
@@ -645,13 +677,6 @@
             pbPrintModel stdout m nv
             writeSOLFile opt m (Just val) nv
 
-pbConvSum :: Tseitin.Encoder -> PBFile.Sum -> IO SAT.PBLinSum
-pbConvSum enc = revMapM f
-  where
-    f (w,ls) = do
-      l <- Tseitin.encodeConj enc ls
-      return (w,l)
-
 evalPBConstraint :: SAT.IModel m => m -> PBFile.Constraint -> Bool
 evalPBConstraint m (lhs,op,rhs) = op' lhs' rhs
   where
@@ -671,11 +696,11 @@
 mainWBO :: Options -> SAT.Solver -> [String] -> IO ()
 mainWBO opt solver args = do
   ret <- case args of
-           ["-"]   -> fmap (PBFile.parseWBOString "-") $ hGetContents stdin
-           [fname] -> PBFile.parseWBOFile fname
+           ["-"]   -> liftM PBFileAttoparsec.parseWBOByteString $ BS.hGetContents stdin
+           [fname] -> PBFileAttoparsec.parseWBOFile fname
            _ -> showHelp stderr >> exitFailure
   case ret of
-    Left err -> hPrint stderr err >> exitFailure
+    Left err -> hPutStrLn stderr err >> exitFailure
     Right formula -> solveWBO opt solver False formula Nothing
 
 solveWBO :: Options -> SAT.Solver -> Bool -> PBFile.SoftFormula -> Maybe SAT.Model -> IO ()
@@ -690,39 +715,42 @@
   enc <- Tseitin.newEncoder solver
   Tseitin.setUsePB enc (optLinearizerPB opt)
 
+  objRef <- newIORef []
   defsRef <- newIORef []
 
-  obj <- liftM concat $ revForM (PBFile.wboConstraints formula) $ \(cost, constr@(lhs, op, rhs)) -> do
-    lhs' <- pbConvSum enc lhs
+  forM_ (PBFile.wboConstraints formula) $ \(cost, constr@(lhs, op, rhs)) -> do
     case cost of
       Nothing -> do
         case op of
-          PBFile.Ge -> SAT.addPBAtLeast solver lhs' rhs
-          PBFile.Eq -> SAT.addPBExactly solver lhs' rhs
-        return []
+          PBFile.Ge -> PBNLC.addPBAtLeast enc lhs rhs
+          PBFile.Eq -> PBNLC.addPBExactly enc lhs rhs
       Just cval -> do
         sel <-
           case op of
             PBFile.Ge -> do
-              case lhs' of
-                [(1,l)] | rhs == 1 -> return l
+              case lhs of
+                [(1,ls)] | rhs == 1 ->
+                  -- TODO: consider polarity
+                  Tseitin.encodeConj enc ls
                 _ -> do
                   sel <- SAT.newVar solver
-                  SAT.addPBAtLeastSoft solver sel lhs' rhs
+                  PBNLC.addPBAtLeastSoft enc sel lhs rhs
                   modifyIORef defsRef ((sel, constr) : )
                   return sel
             PBFile.Eq -> do
               sel <- SAT.newVar solver
-              SAT.addPBExactlySoft solver sel lhs' rhs
+              PBNLC.addPBExactlySoft enc sel lhs rhs
               modifyIORef defsRef ((sel, constr) : )
               return sel
-        return [(cval, SAT.litNot sel)]
+        modifyIORef objRef ((cval, SAT.litNot sel) : )
 
+  obj <- readIORef objRef
+
   case PBFile.wboTopCost formula of
     Nothing -> return ()
     Just c -> SAT.addPBAtMost solver obj (c-1)
 
-  nv' <- SAT.nVars solver
+  nv' <- SAT.getNVars solver
   defs1 <- Tseitin.getDefinitions enc
   defs2 <- readIORef defsRef
   let extendModel :: SAT.Model -> SAT.Model
@@ -796,10 +824,10 @@
     case args of
       [fname@"-"]   -> do
         s <- hGetContents stdin
-        case LPFile.parseString fname s of
+        case MIP.parseLPString fname s of
           Right mip -> return mip
           Left err ->
-            case MPSFile.parseString fname s of
+            case MIP.parseMPSString fname s of
               Right mip -> return mip
               Left err2 -> do
                 hPrint stderr err
@@ -815,109 +843,107 @@
 
 solveMIP :: Options -> SAT.Solver -> MIP.Problem -> IO ()
 solveMIP opt solver mip = do
-  if not (Set.null nivs)
-    then do
-      putCommentLine $ "cannot handle non-integer variables: " ++ intercalate ", " (map MIP.fromVar (Set.toList nivs))
-      putSLine "UNKNOWN"
-      exitFailure
-    else do
-      enc <- Tseitin.newEncoder solver
-      Tseitin.setUsePB enc (optLinearizerPB opt)
+  if not (Set.null nivs) then do
+    putCommentLine $ "cannot handle non-integer variables: " ++ intercalate ", " (map MIP.fromVar (Set.toList nivs))
+    putSLine "UNKNOWN"
+    exitFailure
+  else do
+    enc <- Tseitin.newEncoder solver
+    Tseitin.setUsePB enc (optLinearizerPB opt)
 
-      putCommentLine $ "Loading variables and bounds"
-      vmap <- liftM Map.fromList $ revForM (Set.toList ivs) $ \v -> do
-        let (lb,ub) = MIP.getBounds mip v
-        case (lb,ub) of
-          (MIP.Finite lb', MIP.Finite ub') -> do
-            v2 <- Integer.newVar solver (ceiling lb') (floor ub')
-            return (v,v2)
-          _ -> do
-            putCommentLine $ "cannot handle unbounded variable: " ++ MIP.fromVar v
-            putSLine "UNKNOWN"
-            exitFailure
+    putCommentLine $ "Loading variables and bounds"
+    vmap <- liftM Map.fromList $ revForM (Set.toList ivs) $ \v -> do
+      case MIP.getBounds mip v of
+        (MIP.Finite lb, MIP.Finite ub) -> do
+          v2 <- Integer.newVar solver (ceiling lb) (floor ub)
+          return (v,v2)
+        _ -> do
+          putCommentLine $ "cannot handle unbounded variable: " ++ MIP.fromVar v
+          putSLine "UNKNOWN"
+          exitFailure
 
-      putCommentLine "Loading constraints"
-      forM_ (MIP.constraints mip) $ \c -> do
-        let indicator      = MIP.constrIndicator c
-            (lhs, op, rhs) = MIP.constrBody c
-        let d = foldl' lcm 1 (map denominator  (rhs:[r | MIP.Term r _ <- lhs]))
-            lhs' = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- lhs]
-            rhs' = asInteger (rhs * fromIntegral d)
-        case indicator of
-          Nothing ->
-            case op of
-              MIP.Le  -> Integer.addConstraint enc $ lhs' .<=. fromInteger rhs'
-              MIP.Ge  -> Integer.addConstraint enc $ lhs' .>=. fromInteger rhs'
-              MIP.Eql -> Integer.addConstraint enc $ lhs' .==. fromInteger rhs'
-          Just (var, val) -> do
-            let var' = asBin (vmap Map.! var)
-                f sel = do
-                  case op of
-                    MIP.Le  -> Integer.addConstraintSoft enc sel $ lhs' .<=. fromInteger rhs'
-                    MIP.Ge  -> Integer.addConstraintSoft enc sel $ lhs' .>=. fromInteger rhs'
-                    MIP.Eql -> Integer.addConstraintSoft enc sel $ lhs' .==. fromInteger rhs'
-            case val of
-              1 -> f var'
-              0 -> f (SAT.litNot var')
-              _ -> return ()
+    putCommentLine "Loading constraints"
+    forM_ (MIP.constraints mip) $ \c -> do
+      let indicator      = MIP.constrIndicator c
+          (lhs, op, rhs) = MIP.constrBody c
+      let d = foldl' lcm 1 (map denominator  (rhs:[r | MIP.Term r _ <- lhs]))
+          lhs' = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- lhs]
+          rhs' = asInteger (rhs * fromIntegral d)
+      case indicator of
+        Nothing ->
+          case op of
+            MIP.Le  -> Integer.addConstraint enc $ lhs' .<=. fromInteger rhs'
+            MIP.Ge  -> Integer.addConstraint enc $ lhs' .>=. fromInteger rhs'
+            MIP.Eql -> Integer.addConstraint enc $ lhs' .==. fromInteger rhs'
+        Just (var, val) -> do
+          let var' = asBin (vmap Map.! var)
+              f sel = do
+                case op of
+                  MIP.Le  -> Integer.addConstraintSoft enc sel $ lhs' .<=. fromInteger rhs'
+                  MIP.Ge  -> Integer.addConstraintSoft enc sel $ lhs' .>=. fromInteger rhs'
+                  MIP.Eql -> Integer.addConstraintSoft enc sel $ lhs' .==. fromInteger rhs'
+          case val of
+            1 -> f var'
+            0 -> f (SAT.litNot var')
+            _ -> return ()
 
-      putCommentLine "Loading SOS constraints"
-      forM_ (MIP.sosConstraints mip) $ \MIP.SOSConstraint{ MIP.sosType = typ, MIP.sosBody = xs } -> do
-        case typ of
-          MIP.S1 -> SAT.addAtMost solver (map (asBin . (vmap Map.!) . fst) xs) 1
-          MIP.S2 -> do
-            let ps = nonAdjacentPairs $ map fst $ sortBy (comparing snd) $ xs
-            forM_ ps $ \(x1,x2) -> do
-              SAT.addClause solver [SAT.litNot $ asBin $ vmap Map.! v | v <- [x1,x2]]
+    putCommentLine "Loading SOS constraints"
+    forM_ (MIP.sosConstraints mip) $ \MIP.SOSConstraint{ MIP.sosType = typ, MIP.sosBody = xs } -> do
+      case typ of
+        MIP.S1 -> SAT.addAtMost solver (map (asBin . (vmap Map.!) . fst) xs) 1
+        MIP.S2 -> do
+          let ps = nonAdjacentPairs $ map fst $ sortBy (comparing snd) $ xs
+          forM_ ps $ \(x1,x2) -> do
+            SAT.addClause solver [SAT.litNot $ asBin $ vmap Map.! v | v <- [x1,x2]]
 
-      let (_label,obj) = MIP.objectiveFunction mip      
-          d = foldl' lcm 1 [denominator r | MIP.Term r _ <- obj] *
-              (if MIP.dir mip == MIP.OptMin then 1 else -1)
-          obj2 = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- obj]
-      (obj3,obj3_c) <- Integer.linearize enc obj2
+    let (_label,obj) = MIP.objectiveFunction mip      
+        d = foldl' lcm 1 [denominator r | MIP.Term r _ <- obj] *
+            (if MIP.dir mip == MIP.OptMin then 1 else -1)
+        obj2 = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- obj]
+    (obj3,obj3_c) <- Integer.linearize enc obj2
 
-      let transformObjVal :: Integer -> Rational
-          transformObjVal val = fromIntegral (val + obj3_c) / fromIntegral d
+    let transformObjVal :: Integer -> Rational
+        transformObjVal val = fromIntegral (val + obj3_c) / fromIntegral d
 
-          transformModel :: SAT.Model -> Map String Integer
-          transformModel m = Map.fromList
-            [ (MIP.fromVar v, Integer.eval m (vmap Map.! v)) | v <- Set.toList ivs ]
+        transformModel :: SAT.Model -> Map String Integer
+        transformModel m = Map.fromList
+          [ (MIP.fromVar v, Integer.eval m (vmap Map.! v)) | v <- Set.toList ivs ]
 
-          printModel :: Map String Integer -> IO ()
-          printModel m = do
-            forM_ (Map.toList m) $ \(v, val) -> do
-              printf "v %s = %d\n" v val
-            hFlush stdout
+        printModel :: Map String Integer -> IO ()
+        printModel m = do
+          forM_ (Map.toList m) $ \(v, val) -> do
+            printf "v %s = %d\n" v val
+          hFlush stdout
 
-          writeSol :: Map String Integer -> Rational -> IO ()
-          writeSol m val = do
-            case optWriteFile opt of
-              Nothing -> return ()
-              Just fname -> do
-                writeFile fname (GurobiSol.render (fmap fromInteger m) (Just (fromRational val)))
+        writeSol :: Map String Integer -> Rational -> IO ()
+        writeSol m val = do
+          case optWriteFile opt of
+            Nothing -> return ()
+            Just fname -> do
+              writeFile fname (GurobiSol.render (fmap fromInteger m) (Just (fromRational val)))
 
-      pbo <- PBO.newOptimizer solver obj3
-      setupOptimizer pbo opt
-      PBO.setOnUpdateBestSolution pbo $ \_ val -> do
-        putOLine $ showRational (optPrintRational opt) (transformObjVal val)
+    pbo <- PBO.newOptimizer solver obj3
+    setupOptimizer pbo opt
+    PBO.setOnUpdateBestSolution pbo $ \_ val -> do
+      putOLine $ showRational (optPrintRational opt) (transformObjVal val)
 
-      finally (PBO.optimize pbo) $ do
-        ret <- PBO.getBestSolution pbo
-        case ret of
-          Nothing -> do
-            b <- PBO.isUnsat pbo
-            if b
-              then putSLine "UNSATISFIABLE"
-              else putSLine "UNKNOWN"
-          Just (m,val) -> do
-            b <- PBO.isOptimum pbo
-            if b
-              then putSLine "OPTIMUM FOUND"
-              else putSLine "SATISFIABLE"
-            let m2   = transformModel m
-                val2 = transformObjVal val
-            printModel m2
-            writeSol m2 val2
+    finally (PBO.optimize pbo) $ do
+      ret <- PBO.getBestSolution pbo
+      case ret of
+        Nothing -> do
+          b <- PBO.isUnsat pbo
+          if b
+            then putSLine "UNSATISFIABLE"
+            else putSLine "UNKNOWN"
+        Just (m,val) -> do
+          b <- PBO.isOptimum pbo
+          if b
+            then putSLine "OPTIMUM FOUND"
+            else putSLine "SATISFIABLE"
+          let m2   = transformModel m
+              val2 = transformObjVal val
+          printModel m2
+          writeSol m2 val2
 
   where
     ivs = MIP.integerVariables mip
diff --git a/toysolver.cabal b/toysolver.cabal
--- a/toysolver.cabal
+++ b/toysolver.cabal
@@ -1,34 +1,43 @@
 Name:		toysolver
-Version:	0.2.0
+Version:	0.3.0
 License:	BSD3
 License-File:	COPYING
 Author:		Masahiro Sakai (masahiro.sakai@gmail.com)
 Maintainer:	masahiro.sakai@gmail.com
-Category:	Algorithms, Optimisation, Optimization, Theorem Provers, Constraints
+Category:	Algorithms, Optimisation, Optimization, Theorem Provers, Constraints, Logic
 Cabal-Version:	>= 1.10
 Synopsis:	Assorted decision procedures for SAT, Max-SAT, PB, MIP, etc
 Description:	Toy-level implementation of some decision procedures
 Bug-Reports:	https://github.com/msakai/toysolver/issues
 Tested-With:
-   GHC ==7.4.2
    GHC ==7.6.3
-   GHC ==7.8.2
+   GHC ==7.8.3
+   GHC ==7.10.1
 Extra-Source-Files:
    README.md
    COPYING
    .ghci
    .travis.yml
+   build_bdist_linux-i386.sh
+   build_bdist_linux-x86_64.sh
+   build_bdist_macos.sh
+   build_bdist_win32.sh
+   build_bdist_win64.sh
    src/TseitinEncode.hs
    src/ToySolver/Data/Polyhedron.hs
    samples/gcnf/*.cnf
    samples/gcnf/*.gcnf
+   samples/gcnf/edn_20403_8.cnf_0.03000000.unsat.gcnf
    samples/lp/*.lp
    samples/lp/error/*.lp
    samples/maxsat/*.cnf
+   samples/maxsat/t3pm3-5555.spn.cnf
    samples/maxsat/*.wcnf
+   samples/maxsat/ram_k3_n10.ra1.wcnf
    samples/mps/*.mps
    samples/pbo/*.opb
    samples/pbs/*.opb
+   samples/pbs/normalized-1096.cudf.paranoid.opb
    samples/sat/*.cnf
    samples/wbo/*.wbo
    samples/sdp/*.dat
@@ -87,11 +96,38 @@
   Hs-source-dirs: src
   Build-Depends:
      base >=4 && <5,
-     containers >= 0.4.2, unordered-containers >=0.2.3 && <0.3.0, mtl >=2.1.2, array >=0.4.0.0, stm >=2.3, parsec >=3.1.2 && <4, bytestring, filepath, deepseq, time, primes, process >=1.1.0.2,
-     parse-dimacs, queue, heaps, unbounded-delays, vector-space >=0.8.6, multiset,
-     prettyclass >=1.0.0, type-level-numbers >=0.1.1.0 && <0.2.0.0, hashable >=1.1.2.5 && <1.3.0.0, intern >=0.9.1.2 && <1.0.0.0,
-     loop >=0.2.0 && < 1.0.0, data-default-class,
-     OptDir, extended-reals >=0.1 && <1.0, data-interval >=1.0.1 && <1.3.0, finite-field >=0.7.0 && <1.0.0, sign >=0.2.0 && <1.0.0
+     -- mergeWithKey requires containers >=0.5.0
+     containers >=0.5.0,
+     unordered-containers >=0.2.3 && <0.3.0,
+     mtl >=2.1.2,
+     array >=0.4.0.0,
+     stm >=2.3,
+     parsec >=3.1.2 && <4,
+     bytestring >=0.9.2.1 && <0.11,
+     bytestring-builder,
+     filepath,
+     deepseq,
+     time,
+     primes,
+     process >=1.1.0.2,
+     parse-dimacs,
+     queue,
+     heaps,
+     unbounded-delays,
+     vector-space >=0.8.6,
+     multiset,
+     prettyclass >=1.0.0,
+     type-level-numbers >=0.1.1.0 && <0.2.0.0,
+     hashable >=1.1.2.5 && <1.3.0.0,
+     intern >=0.9.1.2 && <1.0.0.0,
+     loop >=0.2.0 && < 1.0.0,
+     data-default-class,
+     OptDir,
+     extended-reals >=0.1 && <1.0,
+     data-interval >=1.0.1 && <1.3.0,
+     finite-field >=0.7.0 && <1.0.0,
+     sign >=0.2.0 && <1.0.0,
+     pseudo-boolean >=0.1.0.0 && <0.1.1.0
   -- NOTE: temporary-1.2.0.2 does not work with exceptions-0.6
   if flag(Exceptions06)
      Build-Depends: temporary >1.2.0.2, exceptions >=0.6
@@ -109,7 +145,9 @@
      BangPatterns
      CPP
      DeriveDataTypeable
+     DeriveGeneric
      DoRec
+     FlexibleContexts
      FlexibleInstances
      FunctionalDependencies
      GeneralizedNewtypeDeriving
@@ -145,6 +183,8 @@
      ToySolver.Combinatorial.HittingSet.Simple
      ToySolver.Combinatorial.HittingSet.HTCBDD
      ToySolver.Combinatorial.HittingSet.SHD
+     ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996
+     ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999
      ToySolver.Combinatorial.Knapsack.BB
      ToySolver.Combinatorial.Knapsack.DP
      ToySolver.Converter.ObjType
@@ -176,6 +216,8 @@
      ToySolver.Data.LBool
      ToySolver.Data.MIP
      ToySolver.Data.MIP.Base
+     ToySolver.Data.MIP.LPFile
+     ToySolver.Data.MIP.MPSFile
      ToySolver.Data.Polynomial
      ToySolver.Data.Polynomial.Factorization.FiniteField
      ToySolver.Data.Polynomial.Factorization.Hensel
@@ -194,6 +236,8 @@
      ToySolver.SAT.MUS.CAMUS
      ToySolver.SAT.MUS.DAA
      ToySolver.SAT.MUS.Types
+     ToySolver.SAT.MUS.QuickXplain
+     ToySolver.SAT.PBNLC
      ToySolver.SAT.PBO
      ToySolver.SAT.PBO.Context
      ToySolver.SAT.PBO.BC
@@ -207,10 +251,7 @@
      ToySolver.SAT.Printer
      ToySolver.Text.GCNF
      ToySolver.Text.GurobiSol
-     ToySolver.Text.LPFile
-     ToySolver.Text.MPSFile
      ToySolver.Text.MaxSAT
-     ToySolver.Text.PBFile
      ToySolver.Text.SDPFile
      ToySolver.Internal.Data.IndexedPriorityQueue
      ToySolver.Internal.Data.IOURef
@@ -226,24 +267,48 @@
      ToySolver.Data.AlgebraicNumber.Graeffe
      ToySolver.Data.Polynomial.Base
      Paths_toysolver
-  GHC-Prof-Options: -auto-all
+  -- GHC-Prof-Options: -auto-all
 
 Executable toysolver
   Main-is: toysolver.hs
   HS-Source-Dirs: toysolver
-  Build-Depends: base >=4.4 && <5, containers, array, data-default-class, filepath, parsec, OptDir, parse-dimacs, toysolver
+  Build-Depends:
+    base >=4.4 && <5,
+    containers,
+    array,
+    data-default-class,
+    filepath,
+    parsec,
+    OptDir,
+    parse-dimacs,
+    pseudo-boolean,
+    toysolver
   Default-Language: Haskell2010
   if impl(ghc)
     GHC-Options: -threaded
   if impl(ghc >= 7)
     GHC-Options: -rtsopts
-  GHC-Prof-Options: -auto-all
+  -- GHC-Prof-Options: -auto-all
 
 Executable toysat
   Main-is: toysat.hs
   Other-Modules: UBCSAT
   HS-Source-Dirs: toysat
-  Build-Depends: base >=4 && <5, data-default-class, random, containers >= 0.4.2, array, process >=1.1.0.2, parsec, bytestring, filepath, parse-dimacs, unbounded-delays, vector-space >=0.8.6, toysolver
+  Build-Depends:
+    base >=4 && <5,
+    data-default-class,
+    random,
+    containers >= 0.4.2,
+    array,
+    process >=1.1.0.2,
+    parsec,
+    bytestring,
+    filepath,
+    parse-dimacs,
+    unbounded-delays,
+    vector-space >=0.8.6,
+    pseudo-boolean,
+    toysolver
   if flag(Time15)
     Build-Depends: time >=1.5.0
   else
@@ -252,7 +317,7 @@
   Other-Extensions: ScopedTypeVariables, CPP
   if impl(ghc >= 7)
     GHC-Options: -rtsopts
-  GHC-Prof-Options: -auto-all
+  -- GHC-Prof-Options: -auto-all
   if flag(ForceChar8) && impl(ghc)
     Build-Depends: base >=4.5
     CPP-OPtions: "-DFORCE_CHAR8"
@@ -263,24 +328,40 @@
   Main-is: toyfmf.hs
   HS-Source-Dirs: toyfmf
   If flag(BuildToyFMF)
-    Build-Depends: base >=4 && <5, containers >= 0.4.2, toysolver, logic-TPTP >=0.4.1
+    Build-Depends:
+      base >=4 && <5,
+      containers >= 0.4.2,
+      toysolver,
+      logic-TPTP >=0.4.1
   Default-Language: Haskell2010
   if impl(ghc >= 7)
     GHC-Options: -rtsopts
-  GHC-Prof-Options: -auto-all
+  -- GHC-Prof-Options: -auto-all
 
 -- Converters
 
 Executable lpconvert
   Main-is: lpconvert.hs
   HS-Source-Dirs: lpconvert
-  Build-Depends: base >=4 && <5, containers, filepath, parse-dimacs, toysolver
+  Build-Depends:
+    base >=4 && <5,
+    containers,
+    filepath,
+    parse-dimacs,
+    pseudo-boolean,
+    toysolver
   Default-Language: Haskell2010
 
 Executable pbconvert
   Main-is: pbconvert.hs
   HS-Source-Dirs: pbconvert
-  Build-Depends: base >=4 && <5, containers, filepath, parse-dimacs, toysolver
+  Build-Depends:
+    base >=4 && <5,
+    containers,
+    filepath,
+    parse-dimacs,
+    pseudo-boolean,
+    toysolver
   Default-Language: Haskell2010
 
 -- Sample Programs
@@ -290,7 +371,10 @@
     Buildable: False
   Main-is: sudoku.hs
   HS-Source-Dirs: samples/programs/sudoku
-  Build-Depends: base, array, toysolver
+  Build-Depends:
+    base,
+    array,
+    toysolver
   Default-Language: Haskell2010
 
 Executable nqueens
@@ -298,7 +382,10 @@
     Buildable: False
   Main-is: nqueens.hs
   HS-Source-Dirs: samples/programs/nqueens
-  Build-Depends: base, array, toysolver
+  Build-Depends:
+    base,
+    array,
+    toysolver
   Default-Language: Haskell2010
 
 Executable knapsack
@@ -306,7 +393,10 @@
     Buildable: False
   Main-is: knapsack.hs
   HS-Source-Dirs: samples/programs/knapsack
-  Build-Depends: base, array, toysolver
+  Build-Depends:
+    base,
+    array,
+    toysolver
   Default-Language: Haskell2010
 
 Executable htc
@@ -314,7 +404,10 @@
     Buildable: False
   Main-is: htc.hs
   HS-Source-Dirs: samples/programs/htc
-  Build-Depends: base, containers, toysolver
+  Build-Depends:
+    base,
+    containers,
+    toysolver
   Default-Language: Haskell2010
 
 -- Misc Programs
@@ -324,7 +417,12 @@
     Buildable: False
   Main-is: pigeonhole.hs
   HS-Source-Dirs: pigeonhole
-  Build-Depends: base >=4 && <5, containers, filepath, toysolver
+  Build-Depends:
+    base >=4 && <5,
+    containers,
+    filepath,
+    pseudo-boolean,
+    toysolver
   Default-Language: Haskell2010
 
 Executable maxsatverify
@@ -332,13 +430,26 @@
     Buildable: False
   Main-is: maxsatverify.hs
   HS-Source-Dirs: maxsatverify
-  Build-Depends: base >=4 && <5, array, containers, filepath, toysolver
+  Build-Depends:
+    base >=4 && <5,
+    array,
+    containers,
+    filepath,
+    toysolver
   Default-Language: Haskell2010
 
 Executable pbverify
   Main-is: pbverify.hs
+  If !flag(BuildMiscPrograms)
+    Buildable: False
   HS-Source-Dirs: pbverify
-  Build-Depends: base >=4 && <5, array, containers, filepath, toysolver
+  Build-Depends:
+    base >=4 && <5,
+    array,
+    containers,
+    filepath,
+    pseudo-boolean,
+    toysolver
   Default-Language: Haskell2010
 
 -- Test suites and benchmarks
@@ -347,7 +458,18 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestSAT.hs
-  Build-depends:     base >=4 && <5, array, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    array,
+    containers,
+    random,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -355,7 +477,15 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestSimplex.hs
-  Build-depends:     base >=4 && <5, containers, mtl, toysolver, test-framework,test-framework-th,test-framework-hunit,HUnit
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    mtl,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-th,
+    HUnit
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -363,7 +493,15 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestSimplex2.hs
-  Build-depends:     base >=4 && <5, containers, vector-space >=0.8.6, toysolver, test-framework,test-framework-th,test-framework-hunit,HUnit
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    vector-space >=0.8.6,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-th,
+    HUnit
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -371,7 +509,17 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestMIPSolver2.hs
-  Build-depends:     base >=4 && <5, containers, vector-space >=0.8.6, toysolver, test-framework, test-framework-th, test-framework-hunit, HUnit, OptDir, stm
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    vector-space >=0.8.6,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-th,
+    HUnit,
+    OptDir,
+    stm
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -379,7 +527,19 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestPolynomial.hs
-  Build-depends:     base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3, data-interval, finite-field >=0.7.0 && <1.0.0, prettyclass >=1.0.0
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3,
+    data-interval,
+    finite-field >=0.7.0 && <1.0.0,
+    prettyclass >=1.0.0
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -387,7 +547,17 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestAReal.hs
-  Build-depends:     base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3, data-interval
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3,
+    data-interval
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell, ScopedTypeVariables
 
@@ -395,7 +565,19 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestArith.hs
-  Build-depends:     base >=4 && <5, containers, vector-space >=0.8.6, toysolver, data-interval, OptDir, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    vector-space >=0.8.6,
+    toysolver,
+    data-interval,
+    OptDir,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -403,7 +585,18 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestContiTraverso.hs
-  Build-depends:     base >=4 && <5, containers, vector-space >=0.8.6, toysolver, OptDir, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    vector-space >=0.8.6,
+    toysolver,
+    OptDir,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -411,7 +604,16 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestCongruenceClosure.hs
-  Build-depends:     base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -419,7 +621,16 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestLPFile.hs
-  Build-depends:     base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -427,15 +638,16 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestMPSFile.hs
-  Build-depends:     base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
-  Default-Language: Haskell2010
-  Other-Extensions: TemplateHaskell
-
-Test-suite TestPBFile
-  Type:              exitcode-stdio-1.0
-  HS-Source-Dirs:    test
-  Main-is:           TestPBFile.hs
-  Build-depends:     base >=4 && <5, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -443,7 +655,15 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestSDPFile.hs
-  Build-depends:     base >=4 && <5, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell
 
@@ -451,7 +671,16 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestUtil.hs
-  Build-depends:     base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2 >=0.2.12.3 && <0.4.0,HUnit,QuickCheck >=2.5 && <3
+  Build-depends:
+    base >=4 && <5,
+    containers,
+    toysolver,
+    tasty >=0.10.1,
+    tasty-hunit ==0.9.*,
+    tasty-quickcheck ==0.8.*,
+    tasty-th,
+    HUnit,
+    QuickCheck >=2.5 && <3
   Default-Language: Haskell2010
   Other-Extensions: TemplateHaskell, ScopedTypeVariables
 
@@ -459,5 +688,12 @@
   type:             exitcode-stdio-1.0
   hs-source-dirs:   benchmarks
   main-is:          BenchmarkSATLIB.hs
-  build-depends:    base >=4 && <5, array, containers, random, parse-dimacs, toysolver, criterion >=1.0 && <1.1
+  build-depends:
+    base >=4 && <5,
+    array,
+    containers,
+    random,
+    parse-dimacs,
+    toysolver,
+    criterion >=1.0 && <1.1
   Default-Language: Haskell2010
diff --git a/toysolver/toysolver.hs b/toysolver/toysolver.hs
--- a/toysolver/toysolver.hs
+++ b/toysolver/toysolver.hs
@@ -37,6 +37,8 @@
 import GHC.Conc (getNumProcessors, setNumCapabilities)
 
 import Data.OptDir
+import qualified Data.PseudoBoolean as PBFile
+import qualified Data.PseudoBoolean.Attoparsec as PBFileAttoparsec
 
 import ToySolver.Data.ArithRel
 import ToySolver.Data.FOL.Arith as FOL
@@ -52,7 +54,6 @@
 import qualified ToySolver.Arith.MIPSolver2 as MIPSolver2
 import qualified ToySolver.Arith.CAD as CAD
 import qualified ToySolver.Arith.ContiTraverso as ContiTraverso
-import qualified ToySolver.Text.PBFile as PBFile
 import qualified ToySolver.Text.MaxSAT as MaxSAT
 import qualified ToySolver.Text.GurobiSol as GurobiSol
 import qualified ToySolver.Converter.SAT2IP as SAT2IP
@@ -404,9 +405,9 @@
                 satPrintModel stdout m2 0
                 writeSOLFileSAT o m2
         ModePB -> do
-          ret <- PBFile.parseOPBFile fname
+          ret <- PBFileAttoparsec.parseOPBFile fname
           case ret of
-            Left err -> hPrint stderr err >> exitFailure
+            Left err -> hPutStrLn stderr err >> exitFailure
             Right pb -> do
               let (mip,mtrans) = PB2IP.convert pb
               run (getSolver o) o mip $ \m -> do
@@ -414,9 +415,9 @@
                 pbPrintModel stdout m2 0
                 writeSOLFileSAT o m2
         ModeWBO -> do
-          ret <- PBFile.parseWBOFile fname
+          ret <- PBFileAttoparsec.parseWBOFile fname
           case ret of
-            Left err -> hPrint stderr err >> exitFailure
+            Left err -> hPutStrLn stderr err >> exitFailure
             Right wbo -> do
               let (mip,mtrans) = PB2IP.convertWBO False wbo
               run (getSolver o) o mip $ \m -> do