Skip to content

Commit

Permalink
⚡ Remove Show and pformatSym in SupportedPrim
Browse files Browse the repository at this point in the history
  • Loading branch information
lsrcz committed Sep 7, 2024
1 parent 8b46f5d commit b21bf2d
Show file tree
Hide file tree
Showing 13 changed files with 48 additions and 41 deletions.
2 changes: 1 addition & 1 deletion src/Grisette/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1047,7 +1047,7 @@ module Grisette.Core
-- >>> res
-- ExceptT {If (|| a (! b)) (If a (Left Error1) (Left Error2)) (Right c)}
-- >>> solveExcept z3 (\case Left _ -> con False; Right x -> x) res
-- Right (Model {a -> False :: Bool, b -> True :: Bool, c -> True :: Bool})
-- Right (Model {a -> false :: Bool, b -> true :: Bool, c -> true :: Bool})
--
-- The solver call in the above example means that we want the solver to
-- find the conditions under which no error is thrown, and the result is
Expand Down
12 changes: 6 additions & 6 deletions src/Grisette/Internal/Core/Data/Class/ModelOps.hs
Original file line number Diff line number Diff line change
Expand Up @@ -106,17 +106,17 @@ class
-- >>> valueOf bBool (buildModel (aBool ::= True) :: Model)
-- Nothing
-- >>> insertValue bBool False (buildModel (aBool ::= True) :: Model)
-- Model {a -> True :: Bool, b -> False :: Bool}
-- Model {a -> true :: Bool, b -> false :: Bool}
-- >>> let abModel = buildModel (aBool ::= True, bBool ::= False) :: Model
-- >>> let acSet = buildSymbolSet (aBool, cBool) :: AnySymbolSet
-- >>> exceptFor acSet abModel
-- Model {b -> False :: Bool}
-- Model {b -> false :: Bool}
-- >>> restrictTo acSet abModel
-- Model {a -> True :: Bool}
-- Model {a -> true :: Bool}
-- >>> extendTo acSet abModel
-- Model {a -> True :: Bool, b -> False :: Bool, c -> False :: Bool}
-- Model {a -> true :: Bool, b -> false :: Bool, c -> false :: Bool}
-- >>> exact acSet abModel
-- Model {a -> True :: Bool, c -> False :: Bool}
-- Model {a -> true :: Bool, c -> false :: Bool}
class
(SymbolSetOps symbolSet typedSymbol) =>
ModelOps model symbolSet typedSymbol
Expand Down Expand Up @@ -166,5 +166,5 @@ class ModelRep rep model | rep -> model where
-- >>> let aBool = "a" :: TypedAnySymbol Bool
-- >>> let bBool = "b" :: TypedAnySymbol Bool
-- >>> buildModel (aBool ::= True, bBool ::= False) :: Model
-- Model {a -> True :: Bool, b -> False :: Bool}
-- Model {a -> true :: Bool, b -> false :: Bool}
buildModel :: rep -> model
6 changes: 3 additions & 3 deletions src/Grisette/Internal/Core/Data/Class/Solver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -167,7 +167,7 @@ class Solver handle where
--
-- >>> solver <- newSolver z3
-- >>> solverSolve solver "a"
-- Right (Model {a -> True :: Bool})
-- Right (Model {a -> true :: Bool})
-- >>> solverSolve solver $ symNot "a"
-- Left Unsat
--
Expand All @@ -176,7 +176,7 @@ class Solver handle where
-- >>> solverResetAssertions solver
-- Right ()
-- >>> solverSolve solver $ symNot "a"
-- Right (Model {a -> False :: Bool})
-- Right (Model {a -> false :: Bool})
solverResetAssertions :: handle -> IO (Either SolvingFailure ())
solverResetAssertions handle =
solverRunCommand (const $ return $ Right ()) handle SolverResetAssertions
Expand Down Expand Up @@ -313,7 +313,7 @@ withSolver config action =
-- | Solve a single formula. Find an assignment to it to make it true.
--
-- >>> solve z3 ("a" .&& ("b" :: SymInteger) .== 1)
-- Right (Model {a -> True :: Bool, b -> 1 :: Integer})
-- Right (Model {a -> true :: Bool, b -> 1 :: Integer})
-- >>> solve z3 ("a" .&& symNot "a")
-- Left Unsat
solve ::
Expand Down
1 change: 1 addition & 0 deletions src/Grisette/Internal/SymPrim/FunInstanceGen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -226,6 +226,7 @@ supportedPrimFun
sequence
[ [t|SupportedNonFuncPrim $ty|],
[t|Eq $ty|],
[t|Show $ty|],
[t|Hashable $ty|]
]
)
Expand Down
2 changes: 1 addition & 1 deletion src/Grisette/Internal/SymPrim/ModelRep.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ import Grisette.Internal.SymPrim.Prim.Term
-- This is used to build a model from a list of symbolic constants and their values.
--
-- >>> buildModel ("a" := (1 :: Integer), "b" := True) :: Model
-- Model {a -> 1 :: Integer, b -> True :: Bool}
-- Model {a -> 1 :: Integer, b -> true :: Bool}
data ModelSymPair ct st where
(:=) :: (LinkedRep ct st) => st -> ct -> ModelSymPair ct st

Expand Down
9 changes: 6 additions & 3 deletions src/Grisette/Internal/SymPrim/Prim/Internal/Caches.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ module Grisette.Internal.SymPrim.Prim.Internal.Caches
intern,
haveCache,
threadCacheSize,
dumpThreadCache,
-- dumpThreadCache,
threadCacheLiveSize,
)
where
Expand Down Expand Up @@ -83,8 +83,7 @@ data CacheState t where

-- | A class for interning terms.
class
( Show (Description t),
Hashable (Description t),
( Hashable (Description t),
Eq (Description t),
Typeable t,
Show t
Expand Down Expand Up @@ -242,6 +241,7 @@ cacheStateLiveSize (CacheState sem s) = do
putMVar sem ()
return r

{-
dumpCacheState :: CacheState t -> IO ()
dumpCacheState (CacheState sem s) = do
takeMVar sem
Expand All @@ -258,6 +258,7 @@ dumpCacheState (CacheState sem s) = do
dumpCache :: Cache t -> IO ()
dumpCache (Cache a) = mapM_ dumpCacheState (A.elems a)
-}

cacheSize :: Cache t -> IO Int
cacheSize (Cache a) = sum <$> mapM cacheStateSize (A.elems a)
Expand Down Expand Up @@ -285,6 +286,7 @@ threadCacheLiveSize tid = do
sum <$> mapM cacheLiveSize (HM.elems cache)
Nothing -> return 0

{-
-- | Dump the current thread's cache.
dumpThreadCache :: WeakThreadId -> IO ()
dumpThreadCache tid = do
Expand All @@ -294,3 +296,4 @@ dumpThreadCache tid = do
cache <- readIORef cref
mapM_ dumpCache (HM.elems cache)
Nothing -> return ()
-}
11 changes: 3 additions & 8 deletions src/Grisette/Internal/SymPrim/Prim/Internal/Term.hs
Original file line number Diff line number Diff line change
Expand Up @@ -393,7 +393,6 @@ class SupportedPrimConstraint t where
class
( Lift t,
Typeable t,
Show t,
NFData t,
SupportedPrimConstraint t,
SBVRep t
Expand All @@ -409,8 +408,6 @@ class
pformatCon :: t -> String
default pformatCon :: (Show t) => t -> String
pformatCon = show
pformatSym :: TypedSymbol 'AnyKind t -> String
pformatSym = showUntyped
defaultValue :: t
defaultValueDynamic :: proxy t -> ModelValue
default defaultValueDynamic :: (Hashable t) => proxy t -> ModelValue
Expand Down Expand Up @@ -466,7 +463,7 @@ data ModelValue where
ModelValue :: forall v. (SupportedPrim v) => v -> ModelValue

instance Show ModelValue where
show (ModelValue (v :: v)) = show v ++ " :: " ++ show (typeRep @v)
show (ModelValue (v :: v)) = pformatCon v ++ " :: " ++ show (typeRep @v)

instance Eq ModelValue where
(ModelValue (v1 :: v1)) == (ModelValue (v2 :: v2)) =
Expand Down Expand Up @@ -1609,7 +1606,7 @@ introSupportedPrimConstraint ToFPTerm {} x = x
-- | Pretty-print a term.
pformatTerm :: forall t. Term t -> String
pformatTerm (ConTerm _ _ _ t) = pformatCon t
pformatTerm (SymTerm _ _ _ sym) = pformatSym sym
pformatTerm (SymTerm _ _ _ sym) = showUntyped sym
pformatTerm (ForallTerm _ _ _ sym arg) = "(forall " ++ show sym ++ " " ++ pformatTerm arg ++ ")"
pformatTerm (ExistsTerm _ _ _ sym arg) = "(exists " ++ show sym ++ " " ++ pformatTerm arg ++ ")"
pformatTerm (NotTerm _ _ _ arg) = "(! " ++ pformatTerm arg ++ ")"
Expand Down Expand Up @@ -1675,7 +1672,7 @@ instance Lift (Term t) where

instance Show (Term ty) where
show (ConTerm tid _ i v) =
"ConTerm{tid=" ++ show tid ++ ", id=" ++ show i ++ ", v=" ++ show v ++ "}"
"ConTerm{tid=" ++ show tid ++ ", id=" ++ show i ++ ", v=" ++ pformatCon v ++ "}"
show (SymTerm tid _ i name) =
"SymTerm{tid="
++ show tid
Expand Down Expand Up @@ -3306,8 +3303,6 @@ termThreadId (FromFPOrTerm tid _ _ _ _ _) = tid
termThreadId (ToFPTerm tid _ _ _ _ _ _) = tid
{-# INLINE termThreadId #-}

deriving instance (SupportedPrim t) => Show (Description (Term t))

instance (SupportedPrim t) => Eq (Description (Term t)) where
DConTerm _ (l :: tyl) == DConTerm _ (r :: tyr) =
case cast @tyl @tyr l of
Expand Down
2 changes: 1 addition & 1 deletion src/Grisette/Internal/SymPrim/Prim/Model.hs
Original file line number Diff line number Diff line change
Expand Up @@ -386,7 +386,7 @@ evalTerm fillDefault (Model ma) =
-- A type used for building a model by hand.
--
-- >>> buildModel ("x" ::= (1 :: Integer), "y" ::= True) :: Model
-- Model {x -> 1 :: Integer, y -> True :: Bool}
-- Model {x -> 1 :: Integer, y -> true :: Bool}
data ModelValuePair t = (TypedAnySymbol t) ::= t deriving (Show)

instance ModelRep (ModelValuePair t) Model where
Expand Down
19 changes: 14 additions & 5 deletions test/Grisette/Backend/TermRewritingTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -633,7 +633,11 @@ termRewritingTests =
testGroup "bitCast" $ do
let bitCastCase ::
forall a b.
(Arbitrary a, PEvalBitCastTerm a b, SupportedNonFuncPrim a) =>
( Arbitrary a,
PEvalBitCastTerm a b,
SupportedNonFuncPrim a,
Show a
) =>
Test
bitCastCase = testProperty
(show (typeRep @a) <> " -> " <> show (typeRep @b))
Expand All @@ -650,7 +654,9 @@ termRewritingTests =
Arbitrary b,
PEvalBitCastOrTerm a b,
RealFloat a,
SupportedNonFuncPrim a
SupportedNonFuncPrim a,
Show b,
Show a
) =>
Test
fromFPCase = testProperty
Expand All @@ -668,7 +674,8 @@ termRewritingTests =
( Arbitrary a,
PEvalBitCastTerm a b,
RealFloat b,
SupportedNonFuncPrim a
SupportedNonFuncPrim a,
Show a
) =>
Test
toFPCase = testProperty
Expand Down Expand Up @@ -746,7 +753,8 @@ termRewritingTests =
( ValidFP eb sb,
Arbitrary b,
PEvalIEEEFPConvertibleTerm b,
TermRewritingSpec spec b
TermRewritingSpec spec b,
Show b
) =>
Bool ->
Test
Expand Down Expand Up @@ -815,7 +823,8 @@ termRewritingTests =
SupportedNonFuncPrim b,
LinkedRep b bs,
Solvable b bs,
SymEq bs
SymEq bs,
Show b
) =>
Test
toFPCase = testProperty
Expand Down
9 changes: 4 additions & 5 deletions test/Grisette/Core/Data/Class/SafeSymRotateTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,6 @@ import Grisette
Union,
WordN,
)
import Grisette.Internal.SymPrim.Prim.Term (LinkedRep)
import Grisette.Lib.Control.Monad (mrgReturn)
import Grisette.Lib.Control.Monad.Except (mrgThrowError)
import Test.Framework (Test, testGroup)
Expand Down Expand Up @@ -99,8 +98,8 @@ concreteUnsignedSymTypeSafeSymRotateTests ::
FiniteBits c,
Bounded c,
Integral c,
LinkedRep c s,
Solvable c s
Solvable c s,
Show c
) =>
proxy s ->
[Test]
Expand Down Expand Up @@ -129,8 +128,8 @@ concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests ::
FiniteBits c,
Bounded c,
Integral c,
LinkedRep c s,
Solvable c s
Solvable c s,
Show c
) =>
proxy s ->
[Test]
Expand Down
9 changes: 4 additions & 5 deletions test/Grisette/Core/Data/Class/SafeSymShiftTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,6 @@ import Grisette
Union,
WordN,
)
import Grisette.Internal.SymPrim.Prim.Term (LinkedRep)
import Grisette.Lib.Control.Monad (mrgReturn)
import Grisette.Lib.Control.Monad.Except (mrgThrowError)
import Test.Framework (Test, testGroup)
Expand Down Expand Up @@ -115,8 +114,8 @@ concreteUnsignedSymTypeSafeSymShiftTests ::
FiniteBits c,
FiniteBits s,
Bounded c,
LinkedRep c s,
Solvable c s
Solvable c s,
Show c
) =>
proxy s ->
[Test]
Expand Down Expand Up @@ -158,8 +157,8 @@ concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests ::
FiniteBits s,
Bounded c,
Integral c,
LinkedRep c s,
Solvable c s
Solvable c s,
Show c
) =>
proxy s ->
[Test]
Expand Down
3 changes: 2 additions & 1 deletion test/Grisette/Core/Data/Class/SymRotateTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,8 @@ symbolicTypeSymRotateTests ::
Typeable s,
Integral c,
LinkedRep c s,
Solvable c s
Solvable c s,
Show c
) =>
proxy s ->
Test
Expand Down
4 changes: 2 additions & 2 deletions test/Grisette/Core/Data/Class/SymShiftTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -116,8 +116,8 @@ symbolicTypeSymShiftTests ::
Bounded c,
Typeable s,
Integral c,
LinkedRep c s,
Solvable c s
Solvable c s,
Show c
) =>
proxy s ->
Test
Expand Down

0 comments on commit b21bf2d

Please sign in to comment.