Quantor.hs

module Satchmo.Solver.Quantor

( solve
)

where

import Satchmo.Data
import qualified Satchmo.Solve
import Satchmo.Solver.Internal
import Satchmo.SAT

import Data.Monoid
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as BS
import System.IO  (stderr, hFlush, hPutStrLn)
import System.Process
import Control.Monad ( when )

import qualified Data.Map as M

solve = Satchmo.Solve.solve quantor

quantor :: Satchmo.Solve.Implementation
quantor cs Header{numVars=numVars, numClauses=numClauses} = do
    let header = mkDimacsHeader numVars numClauses
        cs'    = BS.pack header `mappend` cs
    let debug = True
    if debug 
       then BS.hPut stderr cs'
       else hPutStrLn stderr header >> hFlush stderr
    ( code, stdout, stderr ) <- 
        readProcessWithExitCodeBS "quantor" [ "-v", "--resolve-exported=0" ] cs'
    when debug $ hPutStrLn System.IO.stderr stdout
    let 
    case filter ( \ ws -> take 1 ws /= [ "c" ] ) $ map words $ lines stdout of
        [ "s", ok ] : rest | ok `elem` [ "TRUE", "SATISFIABLE" ] -> 
            return $ Just $ M.fromList $ do
                "v" : vars <- rest
                l <- map read $ takeWhile ( /= "0" ) vars
                return ( variable l, positive l  )
        _ -> return $ Nothing