Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion kore/src/Kore/Log/ErrorDecidePredicateUnknown.hs
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ instance Entry ErrorDecidePredicateUnknown where
errorDecidePredicateUnknown
:: InternalVariable variable
=> NonEmpty (Predicate variable)
-> log ()
-> log a
errorDecidePredicateUnknown predicates' =
throw ErrorDecidePredicateUnknown { predicates }
where
Expand Down
4 changes: 4 additions & 0 deletions kore/src/Kore/Log/Registry.hs
Original file line number Diff line number Diff line change
Expand Up @@ -101,6 +101,9 @@ import Kore.Log.WarnFunctionWithoutEvaluators
import Kore.Log.WarnIfLowProductivity
( WarnIfLowProductivity
)
import Kore.Log.WarnRetrySolverQuery
( WarnRetrySolverQuery
)
import Kore.Log.WarnStuckClaimState
( WarnStuckClaimState
)
Expand Down Expand Up @@ -160,6 +163,7 @@ entryHelpDocs :: [Pretty.Doc ()]
, mk $ Proxy @WarnStuckClaimState
, mk $ Proxy @WarnIfLowProductivity
, mk $ Proxy @WarnTrivialClaim
, mk $ Proxy @WarnRetrySolverQuery
, mk $ Proxy @DebugEvaluateCondition
, mk $ Proxy @ErrorException
, mk $ Proxy @ErrorRewriteLoop
Expand Down
68 changes: 68 additions & 0 deletions kore/src/Kore/Log/WarnRetrySolverQuery.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,68 @@
{- |
Copyright : (c) Runtime Verification, 2020
License : NCSA

-}

module Kore.Log.WarnRetrySolverQuery
( WarnRetrySolverQuery
, warnRetrySolverQuery
) where

import Prelude.Kore

import Kore.Internal.Predicate
( Predicate
)
import qualified Kore.Internal.Predicate as Predicate
import Kore.Internal.Variable
( InternalVariable
, VariableName
, toVariableName
)
import Kore.Unparser
( unparse
)
import Log
import Pretty
( Pretty (..)
)
import qualified Pretty

newtype WarnRetrySolverQuery =
WarnRetrySolverQuery
{ predicates :: NonEmpty (Predicate VariableName) }
deriving (Show)

instance Pretty WarnRetrySolverQuery where
pretty WarnRetrySolverQuery { predicates } =
Pretty.vsep $
[ "The SMT solver initially failed to solve the following query:"
, Pretty.indent 2 "Decide predicate:"
, Pretty.indent 4 (unparse predicate)
, Pretty.indent 2 "with side conditions:"
]
<> fmap (Pretty.indent 4 . unparse) sideConditions
<> ["The SMT solver was reset and the query\
\ was tried one more time."
]
where
predicate :| sideConditions = predicates

instance Entry WarnRetrySolverQuery where
entrySeverity _ = Warning
helpDoc _ =
"warning raised when the solver failed to decide\
\ the satisfiability of a formula, indicating that\
\ the solver was reset and the formula retried"

warnRetrySolverQuery
:: InternalVariable variable
=> MonadLog log
=> NonEmpty (Predicate variable)
-> log ()
warnRetrySolverQuery predicates' =
logEntry WarnRetrySolverQuery { predicates }
where
predicates =
Predicate.mapVariables (pure toVariableName) <$> predicates'
50 changes: 36 additions & 14 deletions kore/src/Kore/Step/SMT/Evaluator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,8 @@ module Kore.Step.SMT.Evaluator
import Prelude.Kore

import Control.Error
( hoistMaybe
( MaybeT
, hoistMaybe
, runMaybeT
)
import qualified Control.Lens as Lens
Expand Down Expand Up @@ -65,6 +66,9 @@ import Kore.Log.DebugEvaluateCondition
import Kore.Log.ErrorDecidePredicateUnknown
( errorDecidePredicateUnknown
)
import Kore.Log.WarnRetrySolverQuery
( warnRetrySolverQuery
)
import Kore.Step.Simplification.Simplify as Simplifier
import Kore.Step.SMT.Translate
import Kore.TopBottom
Expand Down Expand Up @@ -172,19 +176,37 @@ decidePredicate
=> NonEmpty (Predicate variable)
-> simplifier (Maybe Bool)
decidePredicate predicates =
whileDebugEvaluateCondition predicates
$ SMT.withSolver $ runMaybeT $ evalTranslator $ do
tools <- Simplifier.askMetadataTools
predicates' <- traverse (translatePredicate tools) predicates
Foldable.traverse_ SMT.assert predicates'
result <- SMT.check
debugEvaluateConditionResult result
case result of
Unsat -> return False
Sat -> empty
Unknown -> do
errorDecidePredicateUnknown predicates
empty
whileDebugEvaluateCondition predicates go
where
go =
do
result <- query >>= whenUnknown retry
debugEvaluateConditionResult result
case result of
Unsat -> return False
Sat -> empty
Unknown ->
errorDecidePredicateUnknown predicates
& runMaybeT

whenUnknown f Unknown = f
whenUnknown _ result = return result

-- | Run the SMT query once.
query :: MaybeT simplifier Result
query =
SMT.withSolver $ evalTranslator $ do
tools <- Simplifier.askMetadataTools
predicates' <- traverse (translatePredicate tools) predicates
Foldable.traverse_ SMT.assert predicates'
SMT.check

-- | Re-run the SMT query.
retry = do
SMT.reinit
result <- query
warnRetrySolverQuery predicates
return result

translatePredicate
:: forall variable m.
Expand Down