-----------------------------------------------------------------------------
-- |
-- Module    : Documentation.SBV.Examples.Queries.UnsatCore
-- Copyright : (c) Levent Erkok
-- License   : BSD3
-- Maintainer: erkokl@gmail.com
-- Stability : experimental
--
-- Demonstrates extraction of unsat-cores via queries.
-----------------------------------------------------------------------------

{-# OPTIONS_GHC -Wall -Werror #-}

module Documentation.SBV.Examples.Queries.UnsatCore where

import Data.SBV
import Data.SBV.Control

-- | A simple goal with three constraints, two of which are
-- conflicting with each other. The third is irrelevant, in the sense
-- that it does not contribute to the fact that the goal is unsatisfiable.
p :: Symbolic (Maybe [String])
p :: Symbolic (Maybe [String])
p = do SInteger
a <- String -> Symbolic SInteger
sInteger String
"a"
       SInteger
b <- String -> Symbolic SInteger
sInteger String
"b"

       -- tell the solver we want unsat-cores
       forall (m :: * -> *). SolverContext m => SMTOption -> m ()
setOption forall a b. (a -> b) -> a -> b
$ Bool -> SMTOption
ProduceUnsatCores Bool
True

       -- create named constraints, which will allow
       -- unsat-core extraction with the given names
       forall (m :: * -> *). SolverContext m => String -> SBool -> m ()
namedConstraint String
"less than 5"  forall a b. (a -> b) -> a -> b
$ SInteger
a forall a. OrdSymbolic a => a -> a -> SBool
.< SInteger
5
       forall (m :: * -> *). SolverContext m => String -> SBool -> m ()
namedConstraint String
"more than 10" forall a b. (a -> b) -> a -> b
$ SInteger
a forall a. OrdSymbolic a => a -> a -> SBool
.> SInteger
10
       forall (m :: * -> *). SolverContext m => String -> SBool -> m ()
namedConstraint String
"irrelevant"   forall a b. (a -> b) -> a -> b
$ SInteger
a forall a. OrdSymbolic a => a -> a -> SBool
.> SInteger
b

       -- To obtain the unsat-core, we run a query
       forall a. Query a -> Symbolic a
query forall a b. (a -> b) -> a -> b
$ do CheckSatResult
cs <- Query CheckSatResult
checkSat
                  case CheckSatResult
cs of
                    CheckSatResult
Unsat -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query [String]
getUnsatCore
                    CheckSatResult
_     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


-- | Extract the unsat-core of 'p'. We have:
--
-- >>> ucCore
-- Unsat core is: ["less than 5","more than 10"]
--
-- Demonstrating that the constraint @a .> b@ is /not/ needed for unsatisfiablity in this case.
ucCore :: IO ()
ucCore :: IO ()
ucCore = do Maybe [String]
mbCore <- forall a. Symbolic a -> IO a
runSMT Symbolic (Maybe [String])
p
            case Maybe [String]
mbCore of
              Maybe [String]
Nothing   -> String -> IO ()
putStrLn String
"Problem is satisfiable."
              Just [String]
core -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unsat core is: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
core