diff --git a/kore/CHANGELOG.md b/kore/CHANGELOG.md index b89ec48a83..98bfdce401 100644 --- a/kore/CHANGELOG.md +++ b/kore/CHANGELOG.md @@ -14,6 +14,9 @@ All notable changes to this project will be documented in this file. ### Fixed +- A bug is fixed where variables introduced by symbolic narrowing could be + captured incorrectly. + ## [0.25.0.0] - 2020-07-08 ### Added diff --git a/kore/src/Kore/Internal/Pattern.hs b/kore/src/Kore/Internal/Pattern.hs index b62316bb80..21b792e9a5 100644 --- a/kore/src/Kore/Internal/Pattern.hs +++ b/kore/src/Kore/Internal/Pattern.hs @@ -28,6 +28,7 @@ module Kore.Internal.Pattern , simplifiedAttribute , assign , requireDefined + , substitute -- * Re-exports , Conditional (..) , Conditional.andCondition @@ -40,6 +41,10 @@ module Kore.Internal.Pattern import Prelude.Kore +import Data.Map.Strict + ( Map + ) + import Kore.Attribute.Pattern.FreeVariables ( freeVariables , getFreeElementVariables @@ -350,3 +355,20 @@ requireDefined Conditional { term, predicate, substitution } = } where sort = termLikeSort term + +{- | Apply a normalized 'Substitution' to a 'Pattern'. + +The 'Substitution' of the result will not be normalized. + + -} +substitute + :: InternalVariable variable + => Map (SomeVariableName variable) (TermLike variable) + -> Pattern variable + -> Pattern variable +substitute subst Conditional { term, predicate, substitution } = + Conditional + { term = TermLike.substitute subst term + , predicate = Predicate.substitute subst predicate + , substitution = Substitution.substitute subst substitution + } diff --git a/kore/src/Kore/Internal/Substitution.hs b/kore/src/Kore/Internal/Substitution.hs index fb98717503..8238750a71 100644 --- a/kore/src/Kore/Internal/Substitution.hs +++ b/kore/src/Kore/Internal/Substitution.hs @@ -46,6 +46,7 @@ module Kore.Internal.Substitution , wrapNormalization , mkNormalization , applyNormalized + , substitute ) where import Prelude.Kore hiding @@ -702,16 +703,30 @@ applyNormalized applyNormalized Normalization { normalized, denormalized } = Normalization { normalized - , denormalized = - mapAssignedTerm substitute <$> denormalized + , denormalized = mapAssignedTerm substitute' <$> denormalized } where - substitute = + substitute' = TermLike.substitute $ Map.mapKeys variableName $ Map.fromList $ map assignmentToPair normalized +{- | Apply a 'Map' from names to terms to a substitution. + +The given mapping will be applied only to the right-hand sides of the +substitutions (see 'mapAssignedTerm'). The result will not be a normalized +'Substitution'. + + -} +substitute + :: InternalVariable variable + => Map (SomeVariableName variable) (TermLike variable) + -> Substitution variable + -> Substitution variable +substitute subst = + wrap . (map . mapAssignedTerm) (TermLike.substitute subst) . unwrap + {- | @toPredicate@ constructs a 'Predicate' equivalent to 'Substitution'. An empty substitution list returns a true predicate. A non-empty substitution diff --git a/kore/src/Kore/Rewriting/RewritingVariable.hs b/kore/src/Kore/Rewriting/RewritingVariable.hs index 2e416e91d2..ffb75aabb9 100644 --- a/kore/src/Kore/Rewriting/RewritingVariable.hs +++ b/kore/src/Kore/Rewriting/RewritingVariable.hs @@ -210,11 +210,7 @@ getResultPattern initial config@Conditional { substitution } = . Map.map (TermLike.mkVar . mkUnifiedConfigVariable) $ refreshVariables avoiding introduced renamed :: Pattern RewritingVariableName - renamed = - filtered - { term = TermLike.substitute renaming (term filtered) - , predicate = Predicate.substitute renaming (predicate filtered) - } + renamed = filtered & Pattern.substitute renaming {- | Prepare a rule for unification or matching with the configuration. diff --git a/kore/test/Test/Kore/Internal/Pattern.hs b/kore/test/Test/Kore/Internal/Pattern.hs index 593a42b517..750e7c3980 100644 --- a/kore/test/Test/Kore/Internal/Pattern.hs +++ b/kore/test/Test/Kore/Internal/Pattern.hs @@ -30,6 +30,7 @@ import Test.Kore.Internal.TermLike hiding , mapVariables , markSimplified , simplifiedAttribute + , substitute ) import Test.Kore.Variables.V import Test.Kore.Variables.W diff --git a/kore/test/Test/Kore/Internal/Substitution.hs b/kore/test/Test/Kore/Internal/Substitution.hs index 1aa1cffa49..72820c0e0d 100644 --- a/kore/test/Test/Kore/Internal/Substitution.hs +++ b/kore/test/Test/Kore/Internal/Substitution.hs @@ -1,10 +1,11 @@ module Test.Kore.Internal.Substitution ( test_substitution , test_toPredicate + , test_substitute -- * Re-exports , TestAssignment , TestSubstitution - , module Kore.Internal.Substitution + , module Substitution , module Test.Kore.Internal.TermLike ) where @@ -14,9 +15,10 @@ import Prelude.Kore hiding import Test.Tasty +import qualified Data.Map.Strict as Map import qualified Data.Set as Set -import Kore.Internal.Substitution +import Kore.Internal.Substitution as Substitution import Kore.TopBottom ( isBottom , isTop @@ -39,6 +41,8 @@ import Test.Kore.Internal.TermLike hiding , mapVariables , markSimplified , simplifiedAttribute + , substitute + , test_substitute ) import qualified Test.Kore.Step.MockSymbols as Mock import Test.Tasty.HUnit.Ext @@ -361,3 +365,33 @@ pr1 = a, b :: Sort -> ElementVariable' a = fmap ElementVariableName . Variable (VariableName (testId "a") mempty) b = fmap ElementVariableName . Variable (VariableName (testId "b") mempty) + +test_substitute :: [TestTree] +test_substitute = + [ testGroup "is denormalized" + [ testCase "Denormalized" $ do + let input = wrap [assign (inject Mock.x) Mock.a] + actual = Substitution.substitute Map.empty input + assertDenormalized actual + , testCase "Normalized" $ do + let input = unsafeWrap [(inject Mock.x, Mock.a)] + actual = Substitution.substitute Map.empty input + assertDenormalized actual + ] + , testCase "applies to right-hand side" $ do + let input = wrap [assign (inject Mock.x) (Mock.f (mkElemVar Mock.y))] + subst = Map.singleton (inject $ variableName Mock.y) Mock.a + expect = wrap [assign (inject Mock.x) (Mock.f Mock.a)] + actual = Substitution.substitute subst input + assertEqual "" expect actual + , testCase "does not apply to left-hand side" $ do + let input = wrap [assign (inject Mock.x) (Mock.f (mkElemVar Mock.y))] + subst = Map.singleton (inject $ variableName Mock.x) Mock.a + expect = input + actual = Substitution.substitute subst input + assertEqual "" expect actual + ] + +assertDenormalized :: HasCallStack => Substitution VariableName -> Assertion +assertDenormalized = + assertBool "expected denormalized substitution" . (not . isNormalized) diff --git a/kore/test/Test/Kore/Step/RewriteStep.hs b/kore/test/Test/Kore/Step/RewriteStep.hs index a33a103d45..10d86372dc 100644 --- a/kore/test/Test/Kore/Step/RewriteStep.hs +++ b/kore/test/Test/Kore/Step/RewriteStep.hs @@ -5,6 +5,7 @@ module Test.Kore.Step.RewriteStep , test_applyRewriteRule_ , test_applyRewriteRulesParallel , test_applyRewriteRulesSequence + , test_narrowing ) where import Prelude.Kore @@ -41,6 +42,7 @@ import Kore.Internal.Predicate as Predicate , makeTruePredicate , makeTruePredicate_ ) +import qualified Kore.Internal.Predicate as Predicate import qualified Kore.Internal.Substitution as Substitution import Kore.Internal.TermLike import Kore.Rewriting.RewritingVariable @@ -738,6 +740,57 @@ test_applyRewriteRule_ = ) (Mock.sigma (mkElemVar Mock.x) (mkElemVar Mock.y)) +{- | Tests for symbolic narrowing. + +Narrowing happens when a variable in a symbolic configuration is instantiated +with a particular value. + + -} +test_narrowing :: [TestTree] +test_narrowing = + [ testCase "applyRewriteRulesParallel" $ do + actual <- apply axiom (Pattern.fromTermLike initial) + let results = OrPattern.fromPatterns [result] + checkResults results actual + let remainders = OrPattern.fromPatterns [remainder] + checkRemainders remainders actual + , testCase "getResultPattern" $ do + let resultRewriting = + Pattern.withCondition (Mock.sigma Mock.b (mkElemVar xRule)) + $ Condition.fromSingleSubstitution + $ Substitution.assign + (inject xConfig) + (Mock.sigma Mock.a (mkElemVar xRule)) + initialVariables = FreeVariables.freeVariable (inject xConfig) + actual = getResultPattern initialVariables resultRewriting + assertEqual "" result actual + ] + where + apply rule config = applyRewriteRulesParallel config [rule] + x = Mock.x + x' = traverse (\name -> nextName name name) x & fromJust + xConfig = mkElementConfigVariable x + xRule = mkElementRuleVariable x + initial = mkElemVar x + -- The significance of this axiom is that it narrows the initial term and + -- introduces a new variable. + axiom = + RewriteRule $ rulePattern + (Mock.sigma Mock.a (mkElemVar x)) + (Mock.sigma Mock.b (mkElemVar x)) + result = + Pattern.withCondition (Mock.sigma Mock.b (mkElemVar x')) + $ Condition.fromSingleSubstitution + $ Substitution.assign (inject x) (Mock.sigma Mock.a (mkElemVar x')) + remainder = + Pattern.withCondition initial + $ Condition.fromPredicate + $ Predicate.makeNotPredicate + $ Predicate.makeExistsPredicate x' + $ Predicate.makeEqualsPredicate_ + (mkElemVar x) + (Mock.sigma Mock.a (mkElemVar x')) + -- | Apply the 'RewriteRule's to the configuration. applyRewriteRulesParallel :: TestPattern