Skip to content

Commit 63d0306

Browse files
author
Brian Huffman
committed
saw-core-sbv: Use meaningful user variable names in smtlib2 output.
Fixes #1144.
1 parent 2906402 commit 63d0306

File tree

1 file changed

+33
-20
lines changed
  • saw-core-sbv/src/Verifier/SAW/Simulator

1 file changed

+33
-20
lines changed

saw-core-sbv/src/Verifier/SAW/Simulator/SBV.hs

+33-20
Original file line numberDiff line numberDiff line change
@@ -635,10 +635,11 @@ sbvSATQuery sc addlPrims query =
635635
t <- liftIO (foldM (scAnd sc) true (satAsserts query))
636636
let qvars = Map.toList (satVariables query)
637637
let unintSet = satUninterp query
638+
let ecVars (ec, fot) = newVars (Text.unpack (toShortName (ecName ec))) fot
638639

639640
(labels, vars) <-
640641
flip evalStateT 0 $ unzip <$>
641-
mapM (newVars . snd) qvars
642+
mapM ecVars qvars
642643

643644
m <- liftIO (scGetModuleMap sc)
644645

@@ -674,29 +675,41 @@ data Labeler
674675
deriving (Show)
675676

676677
nextId :: StateT Int IO String
677-
nextId = ST.get >>= (\s-> modify (+1) >> return ("x" ++ show s))
678+
nextId = ST.get >>= (\s -> modify (+1) >> return ("x" ++ show s))
679+
680+
nextId' :: String -> StateT Int IO String
681+
nextId' nm = nextId <&> \s -> s ++ "_" ++ nm
678682

679683
unzipMap :: Map k (a, b) -> (Map k a, Map k b)
680684
unzipMap m = (fmap fst m, fmap snd m)
681685

682-
newVars :: FirstOrderType -> StateT Int IO (Labeler, Symbolic SValue)
683-
newVars FOTBit = nextId <&> \s-> (BoolLabel s, vBool <$> existsSBool s)
684-
newVars FOTInt = nextId <&> \s-> (IntegerLabel s, vInteger <$> existsSInteger s)
685-
newVars (FOTIntMod n) = nextId <&> \s-> (IntegerLabel s, VIntMod n <$> existsSInteger s)
686-
newVars (FOTVec n FOTBit) =
687-
if n == 0
688-
then pure (ZeroWidthWordLabel, pure (vWord (literalSWord 0 0)))
689-
else nextId <&> \s-> (WordLabel s, vWord <$> existsSWord s (fromIntegral n))
690-
newVars (FOTVec n tp) = do
691-
(labels, vals) <- V.unzip <$> V.replicateM (fromIntegral n) (newVars tp)
692-
return (VecLabel labels, VVector <$> traverse (fmap ready) vals)
693-
newVars (FOTArray{}) = fail "FOTArray unimplemented for backend"
694-
newVars (FOTTuple ts) = do
695-
(labels, vals) <- V.unzip <$> traverse newVars (V.fromList ts)
696-
return (TupleLabel labels, vTuple <$> traverse (fmap ready) (V.toList vals))
697-
newVars (FOTRec tm) = do
698-
(labels, vals) <- unzipMap <$> (traverse newVars tm :: StateT Int IO (Map FieldName (Labeler, Symbolic SValue)))
699-
return (RecLabel labels, vRecord <$> traverse (fmap ready) (vals :: (Map FieldName (Symbolic SValue))))
686+
newVars :: String -> FirstOrderType -> StateT Int IO (Labeler, Symbolic SValue)
687+
newVars nm fot =
688+
case fot of
689+
FOTBit ->
690+
nextId' nm <&> \s -> (BoolLabel s, vBool <$> existsSBool s)
691+
FOTInt ->
692+
nextId' nm <&> \s -> (IntegerLabel s, vInteger <$> existsSInteger s)
693+
FOTIntMod n ->
694+
nextId' nm <&> \s -> (IntegerLabel s, VIntMod n <$> existsSInteger s)
695+
FOTVec 0 FOTBit ->
696+
pure (ZeroWidthWordLabel, pure (vWord (literalSWord 0 0)))
697+
FOTVec n FOTBit ->
698+
nextId' nm <&> \s -> (WordLabel s, vWord <$> existsSWord s (fromIntegral n))
699+
FOTVec n tp ->
700+
do let f i = newVars (nm ++ "." ++ show i) tp
701+
(labels, vals) <- V.unzip <$> V.generateM (fromIntegral n) f
702+
pure (VecLabel labels, VVector <$> traverse (fmap ready) vals)
703+
FOTArray{} ->
704+
fail "FOTArray unimplemented for backend"
705+
FOTTuple ts ->
706+
do let f i t = newVars (nm ++ "." ++ show i) t
707+
(labels, vals) <- V.unzip <$> V.imapM f (V.fromList ts)
708+
pure (TupleLabel labels, vTuple <$> traverse (fmap ready) (V.toList vals))
709+
FOTRec tm ->
710+
do let f k t = newVars (nm ++ "." ++ Text.unpack k) t
711+
(labels, vals) <- unzipMap <$> (Map.traverseWithKey f tm)
712+
pure (RecLabel labels, vRecord <$> traverse (fmap ready) vals)
700713

701714

702715
getLabels ::

0 commit comments

Comments
 (0)