| Copyright | (c) Joel Burget Levent Erkok |
|---|---|
| License | BSD3 |
| Maintainer | erkokl@gmail.com |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Data.SBV.Maybe
Description
Symbolic option type, symbolic version of Haskell's Maybe type.
Synopsis
- sJust :: SymVal a => SBV a -> SBV (Maybe a)
- sNothing :: SymVal a => SBV (Maybe a)
- liftMaybe :: SymVal a => Maybe (SBV a) -> SMaybe a
- type SMaybe a = SBV (Maybe a)
- sMaybe :: SymVal a => String -> Symbolic (SMaybe a)
- sMaybe_ :: SymVal a => Symbolic (SMaybe a)
- sMaybes :: SymVal a => [String] -> Symbolic [SMaybe a]
- maybe :: (SymVal a, SymVal b) => SBV b -> (SBV a -> SBV b) -> SMaybe a -> SBV b
- map :: (SymVal a, SymVal b) => (SBV a -> SBV b) -> SMaybe a -> SMaybe b
- map2 :: (SymVal a, SymVal b, SymVal c) => (SBV a -> SBV b -> SBV c) -> SMaybe a -> SMaybe b -> SMaybe c
- isNothing :: SymVal a => SBV (Maybe a) -> SBool
- isJust :: SymVal a => SBV (Maybe a) -> SBool
- fromMaybe :: SymVal a => SBV a -> SMaybe a -> SBV a
- fromJust :: SymVal a => SMaybe a -> SBV a
Constructing optional values
liftMaybe :: SymVal a => Maybe (SBV a) -> SMaybe a Source #
Construct an SMaybe a from a Maybe (SBV a).
>>>liftMaybe (Just (3 :: SInteger))Just 3 :: Maybe Integer>>>liftMaybe (Nothing :: Maybe SInteger)Nothing :: Maybe Integer
Destructing optionals
maybe :: (SymVal a, SymVal b) => SBV b -> (SBV a -> SBV b) -> SMaybe a -> SBV b Source #
Case analysis for symbolic Maybes. If the value isNothing, return the
default value; if it isJust, apply the function.
>>>sat $ \x -> x .== maybe 0 (`sMod` 2) (sJust (3 :: SInteger))Satisfiable. Model: s0 = 1 :: Integer>>>sat $ \x -> x .== maybe 0 (`sMod` 2) (sNothing :: SMaybe Integer)Satisfiable. Model: s0 = 0 :: Integer>>>let f = uninterpret "f" :: SInteger -> SBool>>>prove $ \x d -> maybe d f (sJust x) .== f xQ.E.D.>>>prove $ \d -> maybe d f sNothing .== dQ.E.D.
Mapping functions
map2 :: (SymVal a, SymVal b, SymVal c) => (SBV a -> SBV b -> SBV c) -> SMaybe a -> SMaybe b -> SMaybe c Source #
Map over two maybe values.
Scrutinizing the branches of an option
fromMaybe :: SymVal a => SBV a -> SMaybe a -> SBV a Source #
Return the value of an optional value. The default is returned if Nothing. Compare to fromJust.
>>>fromMaybe 2 (sNothing :: SMaybe Integer)2 :: SInteger>>>sat $ \x -> fromMaybe 2 (sJust 5 :: SMaybe Integer) .== xSatisfiable. Model: s0 = 5 :: Integer>>>prove $ \x -> fromMaybe x (sNothing :: SMaybe Integer) .== xQ.E.D.>>>prove $ \x -> fromMaybe (x+1) (sJust x :: SMaybe Integer) .== xQ.E.D.
fromJust :: SymVal a => SMaybe a -> SBV a Source #
Return the value of an optional value. The behavior is undefined if
passed Nothing, i.e., it can return any value. Compare to fromMaybe.
>>>sat $ \x -> fromJust (sJust (literal 'a')) .== xSatisfiable. Model: s0 = 'a' :: Char>>>prove $ \x -> fromJust (sJust x) .== (x :: SChar)Q.E.D.>>>sat $ \x -> x .== (fromJust sNothing :: SChar)Satisfiable. Model: s0 = 'A' :: Char
Note how we get a satisfying assignment in the last case: The behavior is unspecified, thus the SMT solver picks whatever satisfies the constraints, if there is one.