SAT solving with haskell SBV library: how to generate a predicate from a parsed string?

Question

I want to parse a String that depicts a propositional formula and then find all models of the propositional formula with a SAT solver.

Now I can parse a

Answer 1

forSome_ is a member of the Provable class, so it seems it would suffice to define the instance Provable Expr. Almost all functions in SVB use Provable so this would allow you to use all of those natively Expr. First, we convert an Expr to a function which looks up variable values in a Vector. You could also use Data.Map.Map or something like that, but the environment is not changed once created and Vector gives constant time lookup:

import Data.Logic.Propositional
import Data.SBV.Bridge.CVC4
import qualified Data.Vector as V
import Control.Monad

toFunc :: Boolean a => Expr -> V.Vector a -> a
toFunc (Variable (Var x)) = \env -> env V.! (fromEnum x)
toFunc (Negation x) = \env -> bnot (toFunc x env)
toFunc (Conjunction a b) = \env -> toFunc a env &&& toFunc b env
toFunc (Disjunction a b) = \env -> toFunc a env ||| toFunc b env
toFunc (Conditional a b) = \env -> toFunc a env ==> toFunc b env
toFunc (Biconditional a b) = \env -> toFunc a env <=> toFunc b env

Provable essentially defines two functions: forAll_, forAll, forSome_, forSome. We have to generate all possible maps of variables to values and apply the function to the maps. Choosing how exactly to handle the results will be done by the Symbolic monad:

forAllExp_ :: Expr -> Symbolic SBool
forAllExp_ e = (m0 >>= f . V.accum (const id) (V.replicate (fromEnum maxV + 1) false)
  where f = return . toFunc e 
        maxV = maximum $ map (\(Var x) -> x) (variables e)
        m0 = mapM fresh (variables e)

Where fresh is a function which "quantifies" the given variable by associating it with all possible values.

fresh :: Var -> Symbolic (Int, SBool)
fresh (Var var) = forall >>= \a -> return (fromEnum var, a)

If you define one of these functions for each of the four functions you will have quite a lot of very repetitive code. So you can generalize the above as follows:

quantExp :: (String -> Symbolic SBool) -> Symbolic SBool -> [String] -> Expr -> Symbolic SBool
quantExp q q_ s e = m0 >>= f . V.accum (const id) (V.replicate (fromEnum maxV + 1) false)
  where f = return . toFunc e 
        maxV = maximum $ map (\(Var x) -> x) (variables e)
        (v0, v1) = splitAt (length s) (variables e)
        m0 = zipWithM fresh (map q s) v0 >>= \r0 -> mapM (fresh q_) v1 >>= \r1 -> return (r0++r1)

fresh :: Symbolic SBool -> Var -> Symbolic (Int, SBool)
fresh q (Var var) = q >>= \a -> return (fromEnum var, a)

If it is confusing exactly what is happening, the Provable instance may suffice to explain:

instance Provable Expr where 
  forAll_  = quantExp forall forall_ [] 
  forAll   = quantExp forall forall_ 
  forSome_ = quantExp exists exists_ []
  forSome  = quantExp exists exists_ 

Then your test case:

myPredicate :: Predicate
myPredicate = forSome_ $ \x y z -> ((x :: SBool) ||| (bnot z)) &&& (y ||| (bnot z))

myPredicate' :: Predicate
myPredicate' = forSome_ $ let Right a = parseExpr "test source" "((X | ~Z) & (Y | ~Z))" in a

testSat = allSat myPredicate >>= print
testSat' = allSat myPredicate >>= print