{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall -Werror #-}
module Data.SBV.Set (
empty, full, universal, singleton, fromList, complement
, insert, delete
, member, notMember, null, isEmpty, isFull, isUniversal, hasSize, isSubsetOf, isProperSubsetOf, disjoint
, union, unions, intersection, intersections, difference, (\\)
) where
import Prelude hiding (null)
import Data.Proxy (Proxy(Proxy))
import qualified Data.Set as Set
import Data.SBV.Core.Data
import Data.SBV.Core.Model ((.==), (./=))
import Data.SBV.Core.Symbolic (SetOp(..))
import qualified Data.Generics.Uniplate.Data as G
empty :: forall a. HasKind a => SSet a
empty :: SSet a
empty = SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> CVal -> CV
forall a b. (a -> b) -> a -> b
$ RCSet CVal -> CVal
CSet (RCSet CVal -> CVal) -> RCSet CVal -> CVal
forall a b. (a -> b) -> a -> b
$ Set CVal -> RCSet CVal
forall a. Set a -> RCSet a
RegularSet Set CVal
forall a. Set a
Set.empty
where k :: Kind
k = Kind -> Kind
KSet (Kind -> Kind) -> Kind -> Kind
forall a b. (a -> b) -> a -> b
$ Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
full :: forall a. HasKind a => SSet a
full :: SSet a
full = SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> CVal -> CV
forall a b. (a -> b) -> a -> b
$ RCSet CVal -> CVal
CSet (RCSet CVal -> CVal) -> RCSet CVal -> CVal
forall a b. (a -> b) -> a -> b
$ Set CVal -> RCSet CVal
forall a. Set a -> RCSet a
ComplementSet Set CVal
forall a. Set a
Set.empty
where k :: Kind
k = Kind -> Kind
KSet (Kind -> Kind) -> Kind -> Kind
forall a b. (a -> b) -> a -> b
$ Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
universal :: forall a. HasKind a => SSet a
universal :: SSet a
universal = SSet a
forall a. HasKind a => SSet a
full
singleton :: forall a. (Ord a, SymVal a) => SBV a -> SSet a
singleton :: SBV a -> SSet a
singleton = (SBV a -> SSet a -> SSet a
forall a. (Ord a, SymVal a) => SBV a -> SSet a -> SSet a
`insert` (SSet a
forall a. HasKind a => SSet a
empty :: SSet a))
fromList :: forall a. (Ord a, SymVal a) => [a] -> SSet a
fromList :: [a] -> SSet a
fromList = RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> ([a] -> RCSet a) -> [a] -> SSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet (Set a -> RCSet a) -> ([a] -> Set a) -> [a] -> RCSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList
complement :: forall a. (Ord a, SymVal a) => SSet a -> SSet a
complement :: SSet a -> SSet a
complement SSet a
ss
| Kind
KChar Kind -> [Kind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Kind -> [Kind]
forall on. Uniplate on => on -> [on]
G.universe Kind
k
= [Char] -> SSet a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SSet a) -> [Char] -> SSet a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
"*** Data.SBV: Set.complement is not available for the type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
, [Char]
"***"
, [Char]
"*** See: https://github.com/LeventErkok/sbv/issues/601 for a discussion"
, [Char]
"*** on why SBV does not support this operation at this type."
, [Char]
"***"
, [Char]
"*** Alternative: Use sets of strings instead, though the match isn't perfect."
, [Char]
"*** If you run into this issue, please comment on the above ticket for"
, [Char]
"*** possible improvements."
]
| Just (RegularSet Set a
rs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
ComplementSet Set a
rs
| Just (ComplementSet Set a
cs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet Set a
cs
| Bool
True
= SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = Kind -> Kind
KSet (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (Proxy a
forall k (t :: k). Proxy t
Proxy @a))
r :: State -> IO SV
r State
st = do SV
svs <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
ss
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetComplement) [SV
svs]
insert :: forall a. (Ord a, SymVal a) => SBV a -> SSet a -> SSet a
insert :: SBV a -> SSet a -> SSet a
insert SBV a
se SSet a
ss
| Just a
e <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
se, Just (RegularSet Set a
rs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ a
e a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set a
rs
| Just a
e <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
se, Just (ComplementSet Set a
cs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss, a
e a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
cs
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
ComplementSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ a
e a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
`Set.delete` Set a
cs
| Bool
True
= SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
k :: Kind
k = Kind -> Kind
KSet Kind
ka
r :: State -> IO SV
r State
st = do SV
svs <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
ss
SV
sve <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
se
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetInsert) [SV
sve, SV
svs]
delete :: forall a. (Ord a, SymVal a) => SBV a -> SSet a -> SSet a
delete :: SBV a -> SSet a -> SSet a
delete SBV a
se SSet a
ss
| Just a
e <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
se, Just (RegularSet Set a
rs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ a
e a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
`Set.delete` Set a
rs
| Just a
e <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
se, Just (ComplementSet Set a
cs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss, a
e a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set a
cs
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
ComplementSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ a
e a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set a
cs
| Bool
True
= SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
k :: Kind
k = Kind -> Kind
KSet Kind
ka
r :: State -> IO SV
r State
st = do SV
svs <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
ss
SV
sve <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
se
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetDelete) [SV
sve, SV
svs]
member :: (Ord a, SymVal a) => SBV a -> SSet a -> SBool
member :: SBV a -> SSet a -> SBool
member SBV a
se SSet a
ss
| Just a
e <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
se, Just (RegularSet Set a
rs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss
= Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ a
e a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
rs
| Just a
e <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
se, Just (ComplementSet Set a
cs) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
ss
= Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ a
e a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set a
cs
| Bool
True
= SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where r :: State -> IO SV
r State
st = do SV
svs <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
ss
SV
sve <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
se
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetMember) [SV
sve, SV
svs]
notMember :: (Ord a, SymVal a) => SBV a -> SSet a -> SBool
notMember :: SBV a -> SSet a -> SBool
notMember SBV a
se SSet a
ss = SBool -> SBool
sNot (SBool -> SBool) -> SBool -> SBool
forall a b. (a -> b) -> a -> b
$ SBV a -> SSet a -> SBool
forall a. (Ord a, SymVal a) => SBV a -> SSet a -> SBool
member SBV a
se SSet a
ss
null :: HasKind a => SSet a -> SBool
null :: SSet a -> SBool
null = (SSet a -> SSet a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SSet a
forall a. HasKind a => SSet a
empty)
isEmpty :: HasKind a => SSet a -> SBool
isEmpty :: SSet a -> SBool
isEmpty = SSet a -> SBool
forall a. HasKind a => SSet a -> SBool
null
isFull :: HasKind a => SSet a -> SBool
isFull :: SSet a -> SBool
isFull = (SSet a -> SSet a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SSet a
forall a. HasKind a => SSet a
full)
isUniversal :: HasKind a => SSet a -> SBool
isUniversal :: SSet a -> SBool
isUniversal = SSet a -> SBool
forall a. HasKind a => SSet a -> SBool
isFull
hasSize :: (Ord a, SymVal a) => SSet a -> SInteger -> SBool
hasSize :: SSet a -> SInteger -> SBool
hasSize SSet a
sa SInteger
si
| Just (RegularSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa
= Integer -> SInteger
forall a. SymVal a => a -> SBV a
literal (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Set a -> Int
forall a. Set a -> Int
Set.size Set a
a)) SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
si
| Just (ComplementSet Set a
_) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa
= SBool
sFalse
| Just Integer
i <- SInteger -> Maybe Integer
forall a. SymVal a => SBV a -> Maybe a
unliteral SInteger
si, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
= SBool
sFalse
| Bool
True
= SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where r :: State -> IO SV
r State
st = do SV
sva <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sa
SV
svi <- State -> SInteger -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SInteger
si
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetHasSize) [SV
sva, SV
svi]
isSubsetOf :: (Ord a, SymVal a) => SSet a -> SSet a -> SBool
isSubsetOf :: SSet a -> SSet a -> SBool
isSubsetOf SSet a
sa SSet a
sb
| Just (RegularSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa, Just (RegularSet Set a
b) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sb
= Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ Set a
a Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
b
| Just (ComplementSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa, Just (ComplementSet Set a
b) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sb
= Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ Set a
b Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
a
| Bool
True
= SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where r :: State -> IO SV
r State
st = do SV
sva <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sa
SV
svb <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sb
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetSubset) [SV
sva, SV
svb]
isProperSubsetOf :: (Ord a, SymVal a) => SSet a -> SSet a -> SBool
isProperSubsetOf :: SSet a -> SSet a -> SBool
isProperSubsetOf SSet a
a SSet a
b = SSet a
a SSet a -> SSet a -> SBool
forall a. (Ord a, SymVal a) => SSet a -> SSet a -> SBool
`isSubsetOf` SSet a
b SBool -> SBool -> SBool
.&& SSet a
a SSet a -> SSet a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./= SSet a
b
disjoint :: (Ord a, SymVal a) => SSet a -> SSet a -> SBool
disjoint :: SSet a -> SSet a -> SBool
disjoint SSet a
a SSet a
b = SSet a
a SSet a -> SSet a -> SSet a
forall a. (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
`intersection` SSet a
b SSet a -> SSet a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SSet a
forall a. HasKind a => SSet a
empty
union :: (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
union :: SSet a -> SSet a -> SSet a
union SSet a
sa SSet a
sb
| Just (RegularSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa, Just (RegularSet Set a
b) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sb
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ Set a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set a
b
| Just (ComplementSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa, Just (ComplementSet Set a
b) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sb
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
ComplementSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ Set a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set a
b
| Bool
True
= SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SSet a -> Kind
forall a. HasKind a => a -> Kind
kindOf SSet a
sa
r :: State -> IO SV
r State
st = do SV
sva <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sa
SV
svb <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sb
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetUnion) [SV
sva, SV
svb]
unions :: (Ord a, SymVal a) => [SSet a] -> SSet a
unions :: [SSet a] -> SSet a
unions = (SSet a -> SSet a -> SSet a) -> SSet a -> [SSet a] -> SSet a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SSet a -> SSet a -> SSet a
forall a. (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
union SSet a
forall a. HasKind a => SSet a
empty
intersection :: (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
intersection :: SSet a -> SSet a -> SSet a
intersection SSet a
sa SSet a
sb
| Just (RegularSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa, Just (RegularSet Set a
b) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sb
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ Set a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set a
b
| Just (ComplementSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa, Just (ComplementSet Set a
b) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sb
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
ComplementSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ Set a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set a
b
| Bool
True
= SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SSet a -> Kind
forall a. HasKind a => a -> Kind
kindOf SSet a
sa
r :: State -> IO SV
r State
st = do SV
sva <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sa
SV
svb <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sb
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetIntersect) [SV
sva, SV
svb]
intersections :: (Ord a, SymVal a) => [SSet a] -> SSet a
intersections :: [SSet a] -> SSet a
intersections = (SSet a -> SSet a -> SSet a) -> SSet a -> [SSet a] -> SSet a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SSet a -> SSet a -> SSet a
forall a. (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
intersection SSet a
forall a. HasKind a => SSet a
full
difference :: (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
difference :: SSet a -> SSet a -> SSet a
difference SSet a
sa SSet a
sb
| Just (RegularSet Set a
a) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sa, Just (RegularSet Set a
b) <- SSet a -> Maybe (RCSet a)
forall a. SymVal a => SBV a -> Maybe a
unliteral SSet a
sb
= RCSet a -> SSet a
forall a. SymVal a => a -> SBV a
literal (RCSet a -> SSet a) -> RCSet a -> SSet a
forall a b. (a -> b) -> a -> b
$ Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ Set a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set a
b
| Bool
True
= SVal -> SSet a
forall a. SVal -> SBV a
SBV (SVal -> SSet a) -> SVal -> SSet a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SSet a -> Kind
forall a. HasKind a => a -> Kind
kindOf SSet a
sa
r :: State -> IO SV
r State
st = do SV
sva <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sa
SV
svb <- State -> SSet a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SSet a
sb
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (SetOp -> Op
SetOp SetOp
SetDifference) [SV
sva, SV
svb]
infixl 9 \\
(\\) :: (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
\\ :: SSet a -> SSet a -> SSet a
(\\) = SSet a -> SSet a -> SSet a
forall a. (Ord a, SymVal a) => SSet a -> SSet a -> SSet a
difference