Skip to content

Commit

Permalink
💥 Changed the symbolic identifier type to Text
Browse files Browse the repository at this point in the history
  • Loading branch information
lsrcz committed Oct 5, 2023
1 parent 2bc901a commit 7e73b9c
Show file tree
Hide file tree
Showing 25 changed files with 78 additions and 51 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
Expand Up @@ -30,6 +30,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Reorganized the files for `MonadTrans`. ([#132](https://github.com/lsrcz/grisette/pull/132))
- [Breaking] Changed the name of `Union` constructors and patterns. ([#133](https://github.com/lsrcz/grisette/pull/133))
- The `Union` patterns, when used as constructors, now merges the result. ([#133](https://github.com/lsrcz/grisette/pull/133))
- Changed the symbolic identifier type from `String` to `Data.Text.Text`. ([#141](https://github.com/lsrcz/grisette/pull/141))

## [0.3.1.1] -- 2023-09-29

Expand Down
1 change: 1 addition & 0 deletions src/Grisette/Backend/SBV/Data/SMT/Lowering.hs
Expand Up @@ -6,6 +6,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
Expand Down
14 changes: 7 additions & 7 deletions src/Grisette/Core/Data/Class/GenSym.hs
Expand Up @@ -214,15 +214,15 @@ instance SimpleMergeable FreshIndex where
-- >>> nameWithInfo "a" (1 :: Int)
-- a:1
data FreshIdent where
FreshIdent :: String -> FreshIdent
FreshIdentWithInfo :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> a -> FreshIdent
FreshIdent :: T.Text -> FreshIdent
FreshIdentWithInfo :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> a -> FreshIdent

instance Show FreshIdent where
show (FreshIdent i) = i
show (FreshIdentWithInfo s i) = s ++ ":" ++ show i
show (FreshIdent i) = T.unpack i
show (FreshIdentWithInfo s i) = T.unpack s ++ ":" ++ show i

instance IsString FreshIdent where
fromString = name
fromString = name . T.pack

instance Eq FreshIdent where
FreshIdent l == FreshIdent r = l == r
Expand Down Expand Up @@ -261,7 +261,7 @@ instance NFData FreshIdent where
--
-- The user may need to use unique names to avoid unintentional identifier
-- collision.
name :: String -> FreshIdent
name :: T.Text -> FreshIdent
name = FreshIdent

-- | Identifier with extra information.
Expand All @@ -270,7 +270,7 @@ name = FreshIdent
--
-- The user may need to use unique names or additional information to avoid
-- unintentional identifier collision.
nameWithInfo :: forall a. (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> a -> FreshIdent
nameWithInfo :: forall a. (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> a -> FreshIdent
nameWithInfo = FreshIdentWithInfo

-- | Monad class for fresh symbolic value generation.
Expand Down
10 changes: 6 additions & 4 deletions src/Grisette/Core/Data/Class/Solvable.hs
Expand Up @@ -21,12 +21,14 @@ where
import Control.DeepSeq (NFData)
import Data.Hashable (Hashable)
import Data.String (IsString)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Language.Haskell.TH.Syntax (Lift)

-- $setup
-- >>> import Grisette.Core
-- >>> import Grisette.IR.SymPrim
-- >>> :set -XOverloadedStrings

-- | The class defines the creation and pattern matching of solvable type
-- values.
Expand Down Expand Up @@ -59,7 +61,7 @@ class (IsString t) => Solvable c t | t -> c where
-- False
-- >>> (ssym "a" :: SymBool) &&~ ssym "a"
-- a
ssym :: String -> t
ssym :: T.Text -> t

-- | Generate indexed symbolic constants.
--
Expand All @@ -68,7 +70,7 @@ class (IsString t) => Solvable c t | t -> c where
--
-- >>> isym "a" 1 :: SymBool
-- a@1
isym :: String -> Int -> t
isym :: T.Text -> Int -> t

-- | Generate simply-named symbolic constants with some extra information for
-- disambiguation.
Expand All @@ -78,7 +80,7 @@ class (IsString t) => Solvable c t | t -> c where
--
-- >>> sinfosym "a" "someInfo" :: SymInteger
-- a:"someInfo"
sinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> a -> t
sinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> a -> t

-- | Generate indexed symbolic constants with some extra information for
-- disambiguation.
Expand All @@ -89,7 +91,7 @@ class (IsString t) => Solvable c t | t -> c where
--
-- >>> iinfosym "a" 1 "someInfo" :: SymInteger
-- a@1:"someInfo"
iinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> Int -> a -> t
iinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> Int -> a -> t

-- | Extract the concrete value from a solvable value with 'conView'.
--
Expand Down
7 changes: 4 additions & 3 deletions src/Grisette/Core/Data/FileLocation.hs
Expand Up @@ -25,6 +25,7 @@ where

import Control.DeepSeq (NFData)
import Data.Hashable (Hashable)
import qualified Data.Text as T
import Debug.Trace.LocationTH (__LOCATION__)
import GHC.Generics (Generic)
import Grisette.Core.Data.Class.GenSym (FreshIdent, nameWithInfo)
Expand Down Expand Up @@ -60,7 +61,7 @@ parseFileLocation str =
-- a:<interactive>:...
--
-- The uniqueness is ensured for the call to 'nameWithLoc' at different location.
nameWithLoc :: String -> SpliceQ FreshIdent
nameWithLoc :: T.Text -> SpliceQ FreshIdent
nameWithLoc s = [||nameWithInfo s (parseFileLocation $$(liftSplice $ unsafeTExpCoerce __LOCATION__))||]

-- | Generate simply-named symbolic variables. The file location will be
Expand All @@ -78,7 +79,7 @@ nameWithLoc s = [||nameWithInfo s (parseFileLocation $$(liftSplice $ unsafeTExpC
-- >>> let f _ = $$(slocsym "a") :: SymBool
-- >>> f () == f ()
-- True
slocsym :: (Solvable c s) => String -> SpliceQ s
slocsym :: (Solvable c s) => T.Text -> SpliceQ s
slocsym nm = [||sinfosym nm (parseFileLocation $$(liftSplice $ unsafeTExpCoerce __LOCATION__))||]

-- | Generate indexed symbolic variables. The file location will be attached to identifier.
Expand All @@ -89,5 +90,5 @@ slocsym nm = [||sinfosym nm (parseFileLocation $$(liftSplice $ unsafeTExpCoerce
-- Calling 'ilocsymb' with the same name and index at different location will
-- always generate different symbolic constants. Calling 'slocsymb' at the same
-- location for multiple times will generate the same symbolic constants.
ilocsym :: (Solvable c s) => String -> Int -> SpliceQ s
ilocsym :: (Solvable c s) => T.Text -> Int -> SpliceQ s
ilocsym nm idx = [||iinfosym nm idx (parseFileLocation $$(liftSplice $ unsafeTExpCoerce __LOCATION__))||]
Expand Up @@ -78,6 +78,7 @@ import Data.Interned.Internal
( Cache (getCache),
CacheState (CacheState),
)
import qualified Data.Text as T
import GHC.IO (unsafeDupablePerformIO)
import GHC.TypeNats (KnownNat, type (+), type (<=))
import Grisette.Core.Data.Class.BitVector
Expand Down Expand Up @@ -189,25 +190,25 @@ symTerm :: forall t. (SupportedPrim t, Typeable t) => TypedSymbol t -> Term t
symTerm t = internTerm $ USymTerm t
{-# INLINE symTerm #-}

ssymTerm :: (SupportedPrim t, Typeable t) => String -> Term t
ssymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Term t
ssymTerm = symTerm . SimpleSymbol
{-# INLINE ssymTerm #-}

isymTerm :: (SupportedPrim t, Typeable t) => String -> Int -> Term t
isymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Int -> Term t
isymTerm str idx = symTerm $ IndexedSymbol str idx
{-# INLINE isymTerm #-}

sinfosymTerm ::
(SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
String ->
T.Text ->
a ->
Term t
sinfosymTerm s info = symTerm $ WithInfo (SimpleSymbol s) info
{-# INLINE sinfosymTerm #-}

iinfosymTerm ::
(SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
String ->
T.Text ->
Int ->
a ->
Term t
Expand Down
Expand Up @@ -57,6 +57,7 @@ where
import Control.DeepSeq (NFData)
import Data.Bits (Bits)
import Data.Hashable (Hashable)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import GHC.TypeNats (KnownNat, type (+), type (<=))
import Grisette.Core.Data.Class.BitVector
Expand Down Expand Up @@ -100,16 +101,16 @@ constructTernary ::
Term t
conTerm :: (SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) => t -> Term t
symTerm :: (SupportedPrim t, Typeable t) => TypedSymbol t -> Term t
ssymTerm :: (SupportedPrim t, Typeable t) => String -> Term t
isymTerm :: (SupportedPrim t, Typeable t) => String -> Int -> Term t
ssymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Term t
isymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Int -> Term t
sinfosymTerm ::
(SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
String ->
T.Text ->
a ->
Term t
iinfosymTerm ::
(SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
String ->
T.Text ->
Int ->
a ->
Term t
Expand Down
15 changes: 8 additions & 7 deletions src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs
Expand Up @@ -152,6 +152,7 @@ import Prettyprinter
PageWidth(Unbounded, AvailablePerLine),
Pretty(pretty),
)
import qualified Data.Text as T
#else
import Data.Text.Prettyprint.Doc
( column,
Expand Down Expand Up @@ -256,8 +257,8 @@ class
-- >>> "a" :: TypedSymbol Bool
-- a :: Bool
data TypedSymbol t where
SimpleSymbol :: (SupportedPrim t) => String -> TypedSymbol t
IndexedSymbol :: (SupportedPrim t) => String -> Int -> TypedSymbol t
SimpleSymbol :: (SupportedPrim t) => T.Text -> TypedSymbol t
IndexedSymbol :: (SupportedPrim t) => T.Text -> Int -> TypedSymbol t
WithInfo ::
forall t a.
( SupportedPrim t,
Expand Down Expand Up @@ -296,13 +297,13 @@ instance Lift (TypedSymbol t) where
liftTyped (WithInfo s1 i1) = [||WithInfo s1 i1||]

instance Show (TypedSymbol t) where
show (SimpleSymbol str) = str ++ " :: " ++ show (typeRep @t)
show (IndexedSymbol str i) = str ++ "@" ++ show i ++ " :: " ++ show (typeRep @t)
show (SimpleSymbol str) = T.unpack str ++ " :: " ++ show (typeRep @t)
show (IndexedSymbol str i) = T.unpack str ++ "@" ++ show i ++ " :: " ++ show (typeRep @t)
show (WithInfo s info) = showUntyped s ++ ":" ++ show info ++ " :: " ++ show (typeRep @t)

showUntyped :: TypedSymbol t -> String
showUntyped (SimpleSymbol str) = str
showUntyped (IndexedSymbol str i) = str ++ "@" ++ show i
showUntyped (SimpleSymbol str) = T.unpack str
showUntyped (IndexedSymbol str i) = T.unpack str ++ "@" ++ show i
showUntyped (WithInfo s info) = showUntyped s ++ ":" ++ show info

instance Hashable (TypedSymbol t) where
Expand All @@ -316,7 +317,7 @@ instance NFData (TypedSymbol t) where
rnf (WithInfo s info) = rnf s `seq` rnf info

instance (SupportedPrim t) => IsString (TypedSymbol t) where
fromString = SimpleSymbol
fromString = SimpleSymbol . T.pack

withSymbolSupported :: TypedSymbol t -> ((SupportedPrim t) => a) -> a
withSymbolSupported (SimpleSymbol _) a = a
Expand Down
5 changes: 3 additions & 2 deletions src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs-boot
Expand Up @@ -33,6 +33,7 @@ import Data.Bits (Bits)
import Data.Hashable (Hashable)
import Data.Interned (Cache, Id)
import Data.Kind (Constraint)
import qualified Data.Text as T
import GHC.TypeNats (KnownNat, type (+), type (<=))
import Grisette.Core.Data.Class.BitVector
( BVSignConversion,
Expand Down Expand Up @@ -124,8 +125,8 @@ class
pformatTernary :: tag -> Term arg1 -> Term arg2 -> Term arg3 -> String

data TypedSymbol t where
SimpleSymbol :: (SupportedPrim t) => String -> TypedSymbol t
IndexedSymbol :: (SupportedPrim t) => String -> Int -> TypedSymbol t
SimpleSymbol :: (SupportedPrim t) => T.Text -> TypedSymbol t
IndexedSymbol :: (SupportedPrim t) => T.Text -> Int -> TypedSymbol t
WithInfo ::
forall t a.
( SupportedPrim t,
Expand Down
6 changes: 3 additions & 3 deletions src/Grisette/IR/SymPrim/Data/SymPrim.hs
Expand Up @@ -1045,15 +1045,15 @@ EQ_BV_SOME(SomeSymWordN, binSomeSymWordN)

#define IS_STRING_SIMPLE(symtype) \
instance IsString symtype where \
fromString = ssym
fromString = ssym . fromString

#define IS_STRING_BV(symtype) \
instance (KnownNat n, 1 <= n) => IsString (symtype n) where \
fromString = ssym
fromString = ssym . fromString

#define IS_STRING_FUN(op, cons) \
instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => IsString (sa op sb) where \
fromString = ssym
fromString = ssym . fromString

#if 1
IS_STRING_SIMPLE(SymBool)
Expand Down
8 changes: 5 additions & 3 deletions test/Grisette/Backend/SBV/Data/SMT/LoweringTests.hs
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
Expand All @@ -18,6 +19,7 @@ import qualified Data.HashMap.Strict as M
import Data.Proxy (Proxy (Proxy))
import qualified Data.SBV as SBV
import qualified Data.SBV.Control as SBV
import qualified Data.Text as T
import GHC.Stack (HasCallStack)
import Grisette.Backend.SBV.Data.SMT.Lowering (lowerSinglePrim)
import Grisette.Backend.SBV.Data.SMT.Solving
Expand Down Expand Up @@ -231,7 +233,7 @@ testTernaryOpLowering ::
) =>
GrisetteSMTConfig n ->
(Term a -> Term b -> Term c -> Term d) ->
String ->
T.Text ->
(TermTy n a -> TermTy n b -> TermTy n c -> TermTy n d) ->
Assertion
testTernaryOpLowering config f name sbvfun = do
Expand All @@ -250,7 +252,7 @@ testTernaryOpLowering config f name sbvfun = do
satres <- SBV.checkSat
case satres of
SBV.Sat -> return ()
_ -> lift $ assertFailure $ "Lowering for " ++ name ++ " generated unsolvable formula"
_ -> lift $ assertFailure $ T.unpack $ "Lowering for " <> name <> " generated unsolvable formula"
_ -> lift $ assertFailure "Failed to extract the term"
SBV.runSMTWith (sbvConfig config) $ do
(m, lt) <- lowerSinglePrim config fabc
Expand All @@ -271,7 +273,7 @@ testTernaryOpLowering config f name sbvfun = do
"Translation counter example found: "
++ show (counterExampleA, counterExampleB, counterExampleC)
SBV.Unsat -> return ()
_ -> lift $ assertFailure $ "Lowering for " ++ name ++ " generated unknown formula"
_ -> lift $ assertFailure $ T.unpack $ "Lowering for " <> name <> " generated unknown formula"
_ -> lift $ assertFailure "Failed to extract the term"

-- testTernaryOpLowering' ::
Expand Down

0 comments on commit 7e73b9c

Please sign in to comment.