@@ -635,10 +635,11 @@ sbvSATQuery sc addlPrims query =
635
635
t <- liftIO (foldM (scAnd sc) true (satAsserts query))
636
636
let qvars = Map. toList (satVariables query)
637
637
let unintSet = satUninterp query
638
+ let ecVars (ec, fot) = newVars (Text. unpack (toShortName (ecName ec))) fot
638
639
639
640
(labels, vars) <-
640
641
flip evalStateT 0 $ unzip <$>
641
- mapM (newVars . snd ) qvars
642
+ mapM ecVars qvars
642
643
643
644
m <- liftIO (scGetModuleMap sc)
644
645
@@ -674,29 +675,41 @@ data Labeler
674
675
deriving (Show )
675
676
676
677
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
678
682
679
683
unzipMap :: Map k (a , b ) -> (Map k a , Map k b )
680
684
unzipMap m = (fmap fst m, fmap snd m)
681
685
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)
700
713
701
714
702
715
getLabels ::
0 commit comments