Skip to content

Commit f5a76b3

Browse files
committed
Merge remote-tracking branch 'origin/master' into release
2 parents 19a6bf5 + 7bbc744 commit f5a76b3

21 files changed

+116132
-10
lines changed

booster/library/Booster/SMT/Translate.hs

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -88,12 +88,16 @@ translateTerm t =
8888
SymbolApplication sym _sorts args ->
8989
case sym.attributes.smt of
9090
Nothing -> asSMTVar t
91-
Just (SMTLib name) -> do
92-
smtArgs <- mapM translateTerm args
93-
pure . List $ Atom (SMTId name) : smtArgs
94-
Just (SMTHook hook@Atom{}) -> do
95-
smtArgs <- mapM translateTerm args
96-
pure . List $ hook : smtArgs
91+
Just (SMTLib name)
92+
| null args -> pure (Atom (SMTId name))
93+
| otherwise -> do
94+
smtArgs <- mapM translateTerm args
95+
pure . List $ Atom (SMTId name) : smtArgs
96+
Just (SMTHook hook@Atom{})
97+
| null args -> pure hook
98+
| otherwise -> do
99+
smtArgs <- mapM translateTerm args
100+
pure . List $ hook : smtArgs
97101
Just (SMTHook sexpr) -> do
98102
smtArgs <- mapM translateTerm args
99103
fillPlaceholders sexpr smtArgs

booster/library/Booster/Syntax/ParsedKore/Internalise.hs

Lines changed: 36 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ import Control.Monad.Trans.Class
2424
import Control.Monad.Trans.Except
2525
import Control.Monad.Trans.State
2626
import Data.Bifunctor (first, second)
27-
import Data.ByteString.Char8 (ByteString)
27+
import Data.ByteString.Char8 as BS (ByteString, pack)
2828
import Data.Coerce (Coercible, coerce)
2929
import Data.Function (on)
3030
import Data.Generics (extQ)
@@ -44,6 +44,7 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ)
4444
import Prettyprinter as Pretty
4545

4646
import Booster.Definition.Attributes.Base hiding (Partial)
47+
import Booster.Definition.Attributes.Base qualified as Def
4748
import Booster.Definition.Attributes.Reader as Attributes (
4849
HasAttributes (mkAttributes),
4950
readLocation,
@@ -280,7 +281,9 @@ addModule
280281
DuplicateSymbols symCollisions
281282
let sorts' = currentSorts <> newSorts'
282283
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'
284287

285288
let defWithNewSortsAndSymbols =
286289
Partial
@@ -362,8 +365,9 @@ addModule
362365
addToTheoryWith (Idx.termTopIndex . (.lhs)) newSimplifications currentSimpls
363366
ceils =
364367
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+
367371
pure $
368372
defWithAliases.partial
369373
{ sorts
@@ -389,6 +393,34 @@ addModule
389393
, [(getKey $ head d, d) | d <- dups]
390394
)
391395

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+
392424
subsortClosure ::
393425
Map Def.SortName (SortAttributes, Set Def.SortName) ->
394426
[(Def.SortName, Def.SortName)] ->

0 commit comments

Comments
 (0)