@@ -24,7 +24,7 @@ import Control.Monad.Trans.Class
24
24
import Control.Monad.Trans.Except
25
25
import Control.Monad.Trans.State
26
26
import Data.Bifunctor (first , second )
27
- import Data.ByteString.Char8 (ByteString )
27
+ import Data.ByteString.Char8 as BS (ByteString , pack )
28
28
import Data.Coerce (Coercible , coerce )
29
29
import Data.Function (on )
30
30
import Data.Generics (extQ )
@@ -44,6 +44,7 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ)
44
44
import Prettyprinter as Pretty
45
45
46
46
import Booster.Definition.Attributes.Base hiding (Partial )
47
+ import Booster.Definition.Attributes.Base qualified as Def
47
48
import Booster.Definition.Attributes.Reader as Attributes (
48
49
HasAttributes (mkAttributes ),
49
50
readLocation ,
@@ -280,7 +281,9 @@ addModule
280
281
DuplicateSymbols symCollisions
281
282
let sorts' = currentSorts <> newSorts'
282
283
newSymbols' <- traverse (internaliseSymbol sorts') parsedSymbols
283
- symbols <- (<> currentSymbols) <$> addKmapSymbols newSorts' (Map. fromList newSymbols')
284
+ symbols' <- (<> currentSymbols) <$> addKmapSymbols newSorts' (Map. fromList newSymbols')
285
+ let symbols =
286
+ renameSmtLibDuplicates symbols'
284
287
285
288
let defWithNewSortsAndSymbols =
286
289
Partial
@@ -362,8 +365,9 @@ addModule
362
365
addToTheoryWith (Idx. termTopIndex . (. lhs)) newSimplifications currentSimpls
363
366
ceils =
364
367
addToTheoryWith (Idx. termTopIndex . (. lhs)) newCeils currentCeils
365
- -- addToTheoryWith (Idx.termTopIndex . (\InternalCeil t -> t) . (.lhs)) newCeils currentCeils
366
- sorts = subsortClosure sorts' subsortPairs
368
+ sorts =
369
+ subsortClosure sorts' subsortPairs
370
+
367
371
pure $
368
372
defWithAliases. partial
369
373
{ sorts
@@ -389,6 +393,34 @@ addModule
389
393
, [(getKey $ head d, d) | d <- dups]
390
394
)
391
395
396
+ -- if two symbols have the same smtlib attribute, they get renamed
397
+ renameSmtLibDuplicates ::
398
+ Map Def. SymbolName Def. Symbol -> Map Def. SymbolName Def. Symbol
399
+ renameSmtLibDuplicates original =
400
+ let retractSMTLib sym
401
+ | Just smt@ SMTLib {} <- sym. attributes. smt = Just smt
402
+ | otherwise = Nothing
403
+
404
+ smtNamePairs = Map. assocs $ Map. mapMaybe retractSMTLib original
405
+
406
+ duplicates :: [(Def. SMTType , [Def. SymbolName ])]
407
+ duplicates = map (second $ map fst ) . snd $ smtNamePairs `mappedBy` snd
408
+
409
+ -- lookup map with 1..N appended to the conflicting smtlib names
410
+ newSMTLibs =
411
+ Map. fromList $
412
+ concat
413
+ [ zip symNames (map (Def. SMTLib . (smtName <> ) . BS. pack . show ) [(1 :: Int ) .. ])
414
+ | (Def. SMTLib smtName, symNames) <- duplicates
415
+ ]
416
+
417
+ rename symName sym@ Def. Symbol {attributes}
418
+ | Just smtLib <- Map. lookup symName newSMTLibs =
419
+ sym{Def.Symbol. attributes = attributes{smt = Just smtLib}}
420
+ | otherwise =
421
+ sym
422
+ in Map. mapWithKey rename original
423
+
392
424
subsortClosure ::
393
425
Map Def. SortName (SortAttributes , Set Def. SortName ) ->
394
426
[(Def. SortName , Def. SortName )] ->
0 commit comments