From fdcb21ad65d6b03edae527d3958f0f44fff2c5dd Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Wed, 21 Jul 2021 16:24:54 +0300 Subject: [PATCH 01/40] Overhaul Predicate simplifier: In simplifier --- kore/src/Kore/Simplify/Predicate.hs | 12 ++++++++++ kore/test/Test/Kore/Simplify/Predicate.hs | 29 +++++++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index f821d63259..139da75ce8 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -56,6 +56,7 @@ import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) import qualified Kore.Simplify.Ceil as Ceil +import qualified Kore.Simplify.In as In import qualified Kore.Simplify.Not as Not import Kore.Simplify.Simplify import Kore.Substitute @@ -72,6 +73,7 @@ import Kore.Syntax ( Or (..), SomeVariableName, Top (..), + In (..), variableName, ) import qualified Kore.Syntax.Exists as Exists @@ -178,6 +180,8 @@ simplify sideCondition original = ForallF forallF -> traverse worker (Forall.refreshForall avoid forallF) >>= simplifyForall sideCondition + InF inF -> + simplifyIn sideCondition =<< traverse simplifyTerm inF _ -> simplifyPredicateTODO sideCondition predicate & MultiOr.observeAllT where _ :< predicateF = Recursive.project predicate @@ -522,3 +526,11 @@ extractFirstAssignment someVariableName predicates = guard (TermLike.isFunctionPattern termLike) (guard . not) (someVariableName `occursIn` termLike) pure termLike + +simplifyIn :: + MonadSimplify simplifier => + SideCondition RewritingVariableName -> + In sort (OrPattern RewritingVariableName) -> + simplifier NormalForm +simplifyIn sideCondition = + In.simplify sideCondition >=> return . MultiOr.map (from @(Condition _)) diff --git a/kore/test/Test/Kore/Simplify/Predicate.hs b/kore/test/Test/Kore/Simplify/Predicate.hs index d24477e891..412d5b1f7b 100644 --- a/kore/test/Test/Kore/Simplify/Predicate.hs +++ b/kore/test/Test/Kore/Simplify/Predicate.hs @@ -20,6 +20,7 @@ import Kore.Internal.TermLike ( TermLike, mkAnd, mkBottom, + mkCeil, mkElemVar, mkEquals, mkNot, @@ -328,6 +329,34 @@ test_simplify = (fromEquals_ (mkElemVar x) (mkElemVar y)) [[fromEquals_ (mkElemVar x) (mkElemVar y)]] ] + , testGroup + "\\in" + [ test + "\\top" + (fromIn_ Mock.a Mock.a) + [[]] + , test + "\\bottom" + (fromIn_ Mock.a Mock.b) + [] + , test + "\\ceil" + (fromIn_ fa fa) + [[faCeil]] + , test + "\\or" + (fromIn_ (mkElemVar Mock.xConfig) (mkOr fa fb)) + [ [faCeil, fromEquals_ (mkElemVar Mock.xConfig) fa] + , [fbCeil, fromEquals_ (mkElemVar Mock.xConfig) fb] + ] + , test + "Predicates" + (fromIn_ + (mkEquals Mock.testSort (mkElemVar Mock.xConfig) fb) + (mkCeil Mock.testSort fa) + ) + [[fromEquals_ (mkElemVar Mock.xConfig ) fb, faCeil, fbCeil]] + ] , testGroup "Other" [ test From 441730335acb7df62f2a6577c62a96b71c92ef00 Mon Sep 17 00:00:00 2001 From: github-actions Date: Wed, 21 Jul 2021 13:26:50 +0000 Subject: [PATCH 02/40] Format with fourmolu --- kore/src/Kore/Simplify/Predicate.hs | 2 +- kore/test/Test/Kore/Simplify/Predicate.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index 139da75ce8..73b35d72b6 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -69,11 +69,11 @@ import Kore.Syntax ( Forall (Forall), Iff (..), Implies (..), + In (..), Not (..), Or (..), SomeVariableName, Top (..), - In (..), variableName, ) import qualified Kore.Syntax.Exists as Exists diff --git a/kore/test/Test/Kore/Simplify/Predicate.hs b/kore/test/Test/Kore/Simplify/Predicate.hs index 412d5b1f7b..b0727e2326 100644 --- a/kore/test/Test/Kore/Simplify/Predicate.hs +++ b/kore/test/Test/Kore/Simplify/Predicate.hs @@ -351,11 +351,11 @@ test_simplify = ] , test "Predicates" - (fromIn_ + ( fromIn_ (mkEquals Mock.testSort (mkElemVar Mock.xConfig) fb) (mkCeil Mock.testSort fa) ) - [[fromEquals_ (mkElemVar Mock.xConfig ) fb, faCeil, fbCeil]] + [[fromEquals_ (mkElemVar Mock.xConfig) fb, faCeil, fbCeil]] ] , testGroup "Other" From 2abc1c41e10332a7089e01a0b38a464a8e6feab8 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Fri, 23 Jul 2021 12:29:47 +0300 Subject: [PATCH 03/40] Retrigger workflows From ebfcc36a5a879182244b6cb404e8f2e99b725360 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Mon, 26 Jul 2021 15:18:57 +0300 Subject: [PATCH 04/40] Overhaul Predicate simplifier: Equals, v2 --- kore/src/Kore/Simplify/Equals.hs | 2 +- kore/src/Kore/Simplify/Predicate.hs | 14 ++++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/kore/src/Kore/Simplify/Equals.hs b/kore/src/Kore/Simplify/Equals.hs index 79eac812a6..e02f5984cd 100644 --- a/kore/src/Kore/Simplify/Equals.hs +++ b/kore/src/Kore/Simplify/Equals.hs @@ -159,7 +159,7 @@ Equals(a and b, b and a) will not be evaluated to Top. simplify :: MonadSimplify simplifier => SideCondition RewritingVariableName -> - Equals Sort (OrPattern RewritingVariableName) -> + Equals sort (OrPattern RewritingVariableName) -> simplifier (OrCondition RewritingVariableName) simplify sideCondition Equals{equalsFirst = first, equalsSecond = second} = simplifyEvaluated sideCondition first' second' diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index f821d63259..e745ef73b3 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -56,6 +56,7 @@ import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) import qualified Kore.Simplify.Ceil as Ceil +import qualified Kore.Simplify.Equals as Equals import qualified Kore.Simplify.Not as Not import Kore.Simplify.Simplify import Kore.Substitute @@ -63,6 +64,7 @@ import Kore.Syntax ( And (..), Bottom (..), Ceil (..), + Equals (..), Exists (..), Floor (..), Forall (Forall), @@ -178,6 +180,8 @@ simplify sideCondition original = ForallF forallF -> traverse worker (Forall.refreshForall avoid forallF) >>= simplifyForall sideCondition + EqualsF equalsF -> + simplifyEquals sideCondition =<< traverse simplifyTerm equalsF _ -> simplifyPredicateTODO sideCondition predicate & MultiOr.observeAllT where _ :< predicateF = Recursive.project predicate @@ -522,3 +526,13 @@ extractFirstAssignment someVariableName predicates = guard (TermLike.isFunctionPattern termLike) (guard . not) (someVariableName `occursIn` termLike) pure termLike + +simplifyEquals :: + forall simplifier sort. + MonadSimplify simplifier => + SideCondition RewritingVariableName -> + Equals sort (OrPattern RewritingVariableName) -> + simplifier NormalForm +simplifyEquals sideCondition = + Equals.simplify sideCondition + >=> return . MultiOr.map (from @(Condition _)) From e0c90c274965f3d3899c7b12b1a96cbdbd116792 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Mon, 26 Jul 2021 15:57:00 +0300 Subject: [PATCH 05/40] Remove the old TermLike simplifier --- kore/src/Kore/Simplify/Data.hs | 5 - kore/src/Kore/Simplify/Predicate.hs | 40 +- kore/src/Kore/Simplify/Predicate.hs-boot | 2 - kore/src/Kore/Simplify/Simplify.hs | 15 - kore/src/Kore/Simplify/TermLike.hs | 375 +----------------- .../Test/Kore/Reachability/MockAllPath.hs | 1 - kore/test/Test/Kore/Simplify/TermLike.hs | 9 +- 7 files changed, 7 insertions(+), 440 deletions(-) diff --git a/kore/src/Kore/Simplify/Data.hs b/kore/src/Kore/Simplify/Data.hs index 70d0c26b9a..f6d6ea178a 100644 --- a/kore/src/Kore/Simplify/Data.hs +++ b/kore/src/Kore/Simplify/Data.hs @@ -141,11 +141,6 @@ instance traceProfSimplify termLike (TermLike.simplify sideCondition termLike) {-# INLINE simplifyTermLike #-} - simplifyTermLikeOnly sideCondition termLike = - (traceProfSimplify termLike) - (TermLike.simplifyOnly sideCondition termLike) - {-# INLINE simplifyTermLikeOnly #-} - simplifyCondition topCondition conditional = do ConditionSimplifier simplify <- asks simplifierCondition simplify topCondition conditional diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index a40de318c3..ddf2e3832c 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -16,7 +16,6 @@ import Kore.Attribute.Pattern.FreeVariables ( freeVariableNames, occursIn, ) -import qualified Kore.Internal.Conditional as Conditional import Kore.Internal.From import Kore.Internal.MultiAnd ( MultiAnd, @@ -29,11 +28,9 @@ import qualified Kore.Internal.MultiOr as MultiOr import Kore.Internal.OrPattern ( OrPattern, ) -import qualified Kore.Internal.OrPattern as OrPattern import Kore.Internal.Pattern ( Condition, ) -import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( Predicate, PredicateF (..), @@ -80,42 +77,8 @@ import Kore.Syntax ( ) import qualified Kore.Syntax.Exists as Exists import qualified Kore.Syntax.Forall as Forall -import qualified Kore.TopBottom as TopBottom -import Kore.Unparser import Logic import Prelude.Kore -import qualified Pretty - -{- | Simplify the 'Predicate' once. - -@simplifyPredicate@ does not attempt to apply the resulting substitution and -re-simplify the result. - -See also: 'simplify' --} -simplifyPredicateTODO :: - ( HasCallStack - , MonadSimplify simplifier - ) => - SideCondition RewritingVariableName -> - Predicate RewritingVariableName -> - LogicT simplifier (MultiAnd (Predicate RewritingVariableName)) -simplifyPredicateTODO sideCondition predicate = do - patternOr <- - simplifyTermLike sideCondition (Predicate.fromPredicate_ predicate) - & lift - -- Despite using lift above, we do not need to - -- explicitly check for \bottom because patternOr is an OrPattern. - from @(Condition _) @(MultiAnd (Predicate _)) <$> scatter (OrPattern.map eraseTerm patternOr) - where - eraseTerm conditional - | TopBottom.isTop (Pattern.term conditional) = - Conditional.withoutTerm conditional - | otherwise = - (error . show . Pretty.vsep) - [ "Expecting a \\top term, but found:" - , unparse conditional - ] {- | @NormalForm@ is the normal form result of simplifying 'Predicate'. The primary purpose of this form is to transmit to the external solver. @@ -126,7 +89,6 @@ type NormalForm = MultiOr (MultiAnd (Predicate RewritingVariableName)) simplify :: forall simplifier. - HasCallStack => MonadSimplify simplifier => SideCondition RewritingVariableName -> Predicate RewritingVariableName -> @@ -151,7 +113,7 @@ simplify sideCondition original = replacePredicate = SideCondition.replacePredicate sideCondition - simplifyTerm = simplifyTermLikeOnly sideCondition + simplifyTerm = simplifyTermLike sideCondition repr = SideCondition.toRepresentation sideCondition diff --git a/kore/src/Kore/Simplify/Predicate.hs-boot b/kore/src/Kore/Simplify/Predicate.hs-boot index 32b5374caf..73de032a2d 100644 --- a/kore/src/Kore/Simplify/Predicate.hs-boot +++ b/kore/src/Kore/Simplify/Predicate.hs-boot @@ -22,7 +22,6 @@ import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) import Kore.Simplify.Simplify -import Prelude.Kore -- TODO (thomas.tuegel): Remove this file when the TermLike simplifier no longer -- depends on the Condition simplifier. @@ -31,7 +30,6 @@ type NormalForm = MultiOr (MultiAnd (Predicate RewritingVariableName)) simplify :: forall simplifier. - HasCallStack => MonadSimplify simplifier => SideCondition RewritingVariableName -> Predicate RewritingVariableName -> diff --git a/kore/src/Kore/Simplify/Simplify.hs b/kore/src/Kore/Simplify/Simplify.hs index 83eac98270..b3fc6e149c 100644 --- a/kore/src/Kore/Simplify/Simplify.hs +++ b/kore/src/Kore/Simplify/Simplify.hs @@ -157,21 +157,6 @@ class (MonadLog m, MonadSMT m) => MonadSimplify m where simplifyTermLike sideCondition termLike = lift (simplifyTermLike sideCondition termLike) - -- | Simplify a 'TermLike' to a disjunction of 'Pattern'. - -- - -- Unlike 'simplifyTermLike', this method does not simplify the condition. - simplifyTermLikeOnly :: - SideCondition RewritingVariableName -> - TermLike RewritingVariableName -> - m (OrPattern RewritingVariableName) - default simplifyTermLikeOnly :: - (MonadTrans t, MonadSimplify n, m ~ t n) => - SideCondition RewritingVariableName -> - TermLike RewritingVariableName -> - m (OrPattern RewritingVariableName) - simplifyTermLikeOnly sideCondition termLike = - lift (simplifyTermLikeOnly sideCondition termLike) - simplifyCondition :: SideCondition RewritingVariableName -> Conditional RewritingVariableName term -> diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index 3ec7902afa..af355efc72 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -4,7 +4,6 @@ License : BSD-3-Clause -} module Kore.Simplify.TermLike ( simplify, - simplifyOnly, ) where import qualified Control.Lens.Combinators as Lens @@ -17,13 +16,6 @@ import Kore.Attribute.Pattern.FreeVariables ( freeVariableNames, freeVariables, ) -import Kore.Internal.Condition ( - Condition, - ) -import qualified Kore.Internal.Condition as Condition -import Kore.Internal.Conditional ( - Conditional (Conditional), - ) import qualified Kore.Internal.Conditional as Conditional import Kore.Internal.From import qualified Kore.Internal.MultiAnd as MultiAnd @@ -32,21 +24,11 @@ import Kore.Internal.OrPattern ( OrPattern, ) import qualified Kore.Internal.OrPattern as OrPattern -import Kore.Internal.Pattern ( - Pattern, - ) import qualified Kore.Internal.Pattern as Pattern -import qualified Kore.Internal.Predicate as Predicate import Kore.Internal.SideCondition ( SideCondition, ) import qualified Kore.Internal.SideCondition as SideCondition -import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( - Representation, - ) -import qualified Kore.Internal.Substitution as Substitution ( - toMap, - ) import Kore.Internal.TermLike ( TermLike, TermLikeF (..), @@ -62,24 +44,12 @@ import qualified Kore.Simplify.And as And ( import qualified Kore.Simplify.Application as Application ( simplify, ) -import qualified Kore.Simplify.Bottom as Bottom ( - simplify, - ) -import qualified Kore.Simplify.Ceil as Ceil ( - simplify, - ) import qualified Kore.Simplify.DomainValue as DomainValue ( simplify, ) -import qualified Kore.Simplify.Equals as Equals ( - simplify, - ) import qualified Kore.Simplify.Exists as Exists ( simplify, ) -import qualified Kore.Simplify.Floor as Floor ( - simplify, - ) import qualified Kore.Simplify.Forall as Forall ( simplify, ) @@ -89,9 +59,6 @@ import qualified Kore.Simplify.Iff as Iff ( import qualified Kore.Simplify.Implies as Implies ( simplify, ) -import qualified Kore.Simplify.In as In ( - simplify, - ) import qualified Kore.Simplify.Inhabitant as Inhabitant ( simplify, ) @@ -139,13 +106,9 @@ import Kore.Simplify.Simplify import qualified Kore.Simplify.StringLiteral as StringLiteral ( simplify, ) -import qualified Kore.Simplify.Top as Top ( - simplify, - ) import qualified Kore.Simplify.Variable as Variable ( simplify, ) -import Kore.Substitute import Kore.Syntax ( Ceil (..), Equals (..), @@ -154,355 +117,21 @@ import Kore.Syntax ( refreshExists, refreshForall, ) -import Kore.TopBottom ( - TopBottom (..), - ) -import Kore.Unparser ( - unparse, - ) import qualified Kore.Variables.Binding as Binding -import qualified Logic import Prelude.Kore -import Pretty ( - Pretty (..), - ) -import qualified Pretty -- TODO(virgil): Add a Simplifiable class and make all pattern types -- instances of that. -{- | Simplify 'TermLike' pattern to a disjunction of function-like 'Pattern's. - All the resulting terms and conditions will be fully simplified, because after - the term simplification procedure, the condition simplifier will be called as well. --} -simplify :: - forall simplifier. - HasCallStack => - MonadSimplify simplifier => - MonadThrow simplifier => - SideCondition RewritingVariableName -> - TermLike RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) -simplify sideCondition = \termLike -> - simplifyInternalWorker termLike - >>= ensureSimplifiedResult sideConditionRepresentation termLike - where - sideConditionRepresentation = SideCondition.toRepresentation sideCondition - - simplifyChildren :: - Traversable t => - t (TermLike RewritingVariableName) -> - simplifier (t (OrPattern RewritingVariableName)) - simplifyChildren = traverse (simplifyTermLike sideCondition) - - simplifyInternalWorker :: - TermLike RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) - simplifyInternalWorker termLike - | Just termLike' <- continueSimplificationWith termLike = - assertTermNotPredicate $ do - unfixedTermOr <- descendAndSimplify termLike' - let termOr = - OrPattern.coerceSort - (termLikeSort termLike') - unfixedTermOr - returnIfSimplifiedOrContinue - termLike' - (OrPattern.toPatterns termOr) - ( do - termPredicateList <- Logic.observeAllT $ do - termOrElement <- Logic.scatter termOr - simplified <- - simplifyCondition sideCondition termOrElement - return (applyTermSubstitution simplified) - - returnIfSimplifiedOrContinue - termLike' - termPredicateList - ( do - resultsList <- mapM resimplify termPredicateList - return (MultiOr.mergeAll resultsList) - ) - ) - | otherwise = - case Predicate.makePredicate termLike of - Left _ -> return . OrPattern.fromTermLike $ termLike - Right predicate -> do - condition <- - Condition.fromPredicate predicate - & ensureSimplifiedCondition - sideConditionRepresentation - termLike - condition - & Pattern.fromCondition (termLikeSort termLike) - & OrPattern.fromPattern - & pure - where - continueSimplificationWith :: - TermLike RewritingVariableName -> - Maybe (TermLike RewritingVariableName) - continueSimplificationWith original = - let isOriginalNotSimplified - | TermLike.isSimplified sideConditionRepresentation original = - Nothing - | otherwise = Just original - in SideCondition.replaceTerm sideCondition original - <|> isOriginalNotSimplified - - resimplify :: - Pattern RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) - resimplify result = do - let (resultTerm, resultPredicate) = Pattern.splitTerm result - simplified <- simplifyInternalWorker resultTerm - return - ( MultiOr.map - (`Conditional.andCondition` resultPredicate) - simplified - ) - - applyTermSubstitution :: - InternalVariable variable => - Pattern variable -> - Pattern variable - applyTermSubstitution conditional@Conditional{substitution} = - fmap (substitute (Substitution.toMap substitution)) conditional - - assertTermNotPredicate getResults = do - results <- getResults - let -- The term of a result should never be any predicate other than - -- Top or Bottom. - hasPredicateTerm Conditional{term = term'} - | isTop term' || isBottom term' = False - | otherwise = Predicate.isPredicate term' - unsimplified = - filter hasPredicateTerm $ OrPattern.toPatterns results - if null unsimplified - then return results - else - (error . show . Pretty.vsep) - [ "Incomplete simplification!" - , Pretty.indent 2 "input:" - , Pretty.indent 4 (unparse termLike) - , Pretty.indent 2 "unsimplified results:" - , (Pretty.indent 4 . Pretty.vsep) - (unparse <$> unsimplified) - , "Expected all predicates to be removed from the term." - ] - - returnIfSimplifiedOrContinue :: - TermLike RewritingVariableName -> - [Pattern RewritingVariableName] -> - simplifier (OrPattern RewritingVariableName) -> - simplifier (OrPattern RewritingVariableName) - returnIfSimplifiedOrContinue originalTerm resultList continuation = - case resultList of - [] -> return OrPattern.bottom - [result] -> - returnIfResultSimplifiedOrContinue - originalTerm - result - continuation - _ -> continuation - - returnIfResultSimplifiedOrContinue :: - TermLike RewritingVariableName -> - Pattern RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) -> - simplifier (OrPattern RewritingVariableName) - returnIfResultSimplifiedOrContinue originalTerm result continuation - | Pattern.isSimplified sideConditionRepresentation result - , isTop resultTerm - , resultSubstitutionIsEmpty - , SideCondition.cannotReplaceTerm sideCondition (Pattern.term result) = - return (OrPattern.fromPattern result) - | Pattern.isSimplified sideConditionRepresentation result - , isTop resultPredicate - , SideCondition.cannotReplaceTerm sideCondition (Pattern.term result) = - return (OrPattern.fromPattern result) - | isTop resultPredicate && resultTerm == originalTerm - , SideCondition.cannotReplaceTerm sideCondition (Pattern.term result) = - return - ( OrPattern.fromTermLike - ( TermLike.markSimplifiedConditional - sideConditionRepresentation - resultTerm - ) - ) - | isTop resultTerm - , Right condition <- termAsPredicate - , resultPredicate == condition = - return $ - OrPattern.fromPattern $ - Pattern.fromCondition_ $ - Condition.markPredicateSimplifiedConditional - sideConditionRepresentation - resultPredicate - | otherwise = continuation - where - (resultTerm, resultPredicate) = Pattern.splitTerm result - resultSubstitutionIsEmpty = - case resultPredicate of - Conditional{substitution} -> substitution == mempty - termAsPredicate = - Condition.fromPredicate <$> Predicate.makePredicate originalTerm - - descendAndSimplify :: - TermLike RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) - descendAndSimplify termLike = - let ~doNotSimplify = - assert - (TermLike.isSimplified sideConditionRepresentation termLike) - return - (OrPattern.fromTermLike termLike) - avoiding = freeVariables termLike <> freeVariables sideCondition - refreshSetBinder = TermLike.refreshSetBinder avoiding - ~sort = termLikeSort termLike - (_ :< termLikeF) = Recursive.project termLike - in case termLikeF of - -- Unimplemented cases - ApplyAliasF _ -> doNotSimplify - -- Do not simplify non-simplifiable patterns. - EndiannessF _ -> doNotSimplify - SignednessF _ -> doNotSimplify - -- We should never attempt to simplify a Rewrites term as this is only used for rules parsing. - RewritesF _ -> error "Attempting to simplify a Rewrites term. This is an error. Please report it at https://github.com/kframework/kore/issues" - -- - AndF andF -> do - let conjuncts = foldMap MultiAnd.fromTermLike andF - And.simplify Not.notSimplifier sideCondition - =<< MultiAnd.traverse - (simplifyTermLike sideCondition) - conjuncts - ApplySymbolF applySymbolF -> - Application.simplify sideCondition - =<< simplifyChildren applySymbolF - InjF injF -> - Inj.simplify =<< simplifyChildren injF - CeilF ceilF -> do - ceilF' <- simplifyChildren ceilF - conditions <- Ceil.simplify sideCondition ceilF' - pure (OrPattern.fromOrCondition sort conditions) - EqualsF equalsF -> do - equalsF' <- simplifyChildren equalsF - conditions <- Equals.simplify sideCondition equalsF' - pure (OrPattern.fromOrCondition sort conditions) - ExistsF exists -> do - simplifiedChildren <- - simplifyChildren (refresh exists) - Exists.simplify sideCondition simplifiedChildren - where - avoid = - freeVariableNames termLike - <> freeVariableNames sideCondition - refresh = refreshExists avoid - IffF iffF -> - Iff.simplify sideCondition =<< simplifyChildren iffF - ImpliesF impliesF -> - Implies.simplify sideCondition =<< simplifyChildren impliesF - InF inF -> do - inF' <- simplifyChildren inF - conditions <- In.simplify sideCondition inF' - pure (OrPattern.fromOrCondition sort conditions) - NotF notF -> - Not.simplify sideCondition =<< simplifyChildren notF - -- - BottomF bottomF -> - Bottom.simplify <$> simplifyChildren bottomF - InternalListF internalF -> - InternalList.simplify <$> simplifyChildren internalF - InternalMapF internalMapF -> - InternalMap.simplify <$> simplifyChildren internalMapF - InternalSetF internalSetF -> - InternalSet.simplify <$> simplifyChildren internalSetF - DomainValueF domainValueF -> - DomainValue.simplify <$> simplifyChildren domainValueF - FloorF floorF -> Floor.simplify <$> simplifyChildren floorF - ForallF forall -> - Forall.simplify <$> simplifyChildren (refresh forall) - where - avoid = - freeVariableNames termLike - <> freeVariableNames sideCondition - refresh = refreshForall avoid - InhabitantF inhF -> - Inhabitant.simplify <$> simplifyChildren inhF - MuF mu -> - Mu.simplify <$> simplifyChildren (refresh mu) - where - refresh = Lens.over Binding.muBinder refreshSetBinder - NuF nu -> - Nu.simplify <$> simplifyChildren (refresh nu) - where - refresh = Lens.over Binding.nuBinder refreshSetBinder - -- TODO(virgil): Move next up through patterns. - NextF nextF -> Next.simplify <$> simplifyChildren nextF - OrF orF -> Or.simplify <$> simplifyChildren orF - TopF topF -> Top.simplify <$> simplifyChildren topF - -- - StringLiteralF stringLiteralF -> - return $ StringLiteral.simplify (getConst stringLiteralF) - InternalBoolF internalBoolF -> - return $ InternalBool.simplify (getConst internalBoolF) - InternalBytesF internalBytesF -> - return $ InternalBytes.simplify (getConst internalBytesF) - InternalIntF internalIntF -> - return $ InternalInt.simplify (getConst internalIntF) - InternalStringF internalStringF -> - return $ InternalString.simplify (getConst internalStringF) - VariableF variableF -> - return $ Variable.simplify (getConst variableF) - -{- | We expect each predicate in the result to have been fully - simplified with a different side condition. - See 'Kore.Simplify.Condition.simplifyPredicates'. --} -ensureSimplifiedResult :: - Monad simplifier => - SideCondition.Representation -> - TermLike RewritingVariableName -> - OrPattern RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) -ensureSimplifiedResult repr termLike results - | OrPattern.hasSimplifiedChildrenIgnoreConditions results = - pure results - | otherwise = - (error . show . Pretty.vsep) - [ "Internal error: expected simplified results, but found:" - , (Pretty.indent 4 . Pretty.vsep) - (unparse <$> OrPattern.toPatterns results) - , Pretty.indent 2 "while simplifying:" - , Pretty.indent 4 (unparse termLike) - , Pretty.indent 2 "with side condition:" - , Pretty.indent 4 (Pretty.pretty repr) - ] - -ensureSimplifiedCondition :: - Monad simplifier => - SideCondition.Representation -> - TermLike RewritingVariableName -> - Condition RewritingVariableName -> - simplifier (Condition RewritingVariableName) -ensureSimplifiedCondition repr termLike condition - | Condition.isSimplified repr condition = pure condition - | otherwise = - (error . show . Pretty.vsep) - [ "Internal error: expected simplified condition, but found:" - , Pretty.indent 4 (pretty condition) - , Pretty.indent 2 "while simplifying:" - , Pretty.indent 4 (unparse termLike) - ] - -- | Simplify the given 'TermLike'. Do not simplify any side conditions. -simplifyOnly :: +simplify :: forall simplifier. MonadSimplify simplifier => MonadThrow simplifier => SideCondition RewritingVariableName -> TermLike RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -simplifyOnly sideCondition = +simplify sideCondition = loop . OrPattern.fromTermLike where loop :: diff --git a/kore/test/Test/Kore/Reachability/MockAllPath.hs b/kore/test/Test/Kore/Reachability/MockAllPath.hs index 906c1c2c90..f97a7a92bf 100644 --- a/kore/test/Test/Kore/Reachability/MockAllPath.hs +++ b/kore/test/Test/Kore/Reachability/MockAllPath.hs @@ -416,7 +416,6 @@ instance MonadCatch AllPathIdentity where instance MonadSimplify AllPathIdentity where askMetadataTools = undefined simplifyTermLike = undefined - simplifyTermLikeOnly = undefined simplifyCondition = undefined askSimplifierAxioms = undefined localSimplifierAxioms = undefined diff --git a/kore/test/Test/Kore/Simplify/TermLike.hs b/kore/test/Test/Kore/Simplify/TermLike.hs index 77b603b27d..34f705434c 100644 --- a/kore/test/Test/Kore/Simplify/TermLike.hs +++ b/kore/test/Test/Kore/Simplify/TermLike.hs @@ -127,7 +127,6 @@ instance MonadSimplify TestSimplifier where -- Throw an error if any term would be simplified. simplifyTermLike = undefined - simplifyTermLikeOnly = undefined test_simplifyOnly :: [TestTree] test_simplifyOnly = @@ -172,7 +171,7 @@ test_simplifyOnly = test testName input maybeExpect = testCase testName $ do let expect = fromMaybe (OrPattern.fromTermLike input) maybeExpect - actual <- simplifyOnly input + actual <- simplify input let message = (show . Pretty.vsep) [ "Expected:" @@ -189,9 +188,9 @@ test_simplifyOnly = SideCondition.mkRepresentation (SideCondition.top @RewritingVariableName) -simplifyOnly :: +simplify :: TermLike RewritingVariableName -> IO (OrPattern RewritingVariableName) -simplifyOnly = +simplify = runSimplifier Mock.env - . TermLike.simplifyOnly SideCondition.top + . TermLike.simplify SideCondition.top From 004c324e4708d761e8c6b0d471e4aea00acf88a4 Mon Sep 17 00:00:00 2001 From: github-actions Date: Mon, 26 Jul 2021 12:59:26 +0000 Subject: [PATCH 06/40] Format with fourmolu --- kore/src/Kore/Simplify/Predicate.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index ddf2e3832c..7b3b955beb 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -500,7 +500,7 @@ simplifyEquals :: simplifier NormalForm simplifyEquals sideCondition = Equals.simplify sideCondition - >=> return . MultiOr.map (from @(Condition _)) + >=> return . MultiOr.map (from @(Condition _)) simplifyIn :: MonadSimplify simplifier => From bf3c210977ebf258a5bba42d43787b0ede753de1 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 27 Jul 2021 14:00:49 +0300 Subject: [PATCH 07/40] WIP: replace simplifyTermLike with simplifyPattern in MonadSimplify --- .../Kore/Builtin/AssociativeCommutative.hs | 7 ++++-- kore/src/Kore/ModelChecker/Simplification.hs | 5 ++++ kore/src/Kore/Rewrite/Function/Evaluator.hs | 7 +----- kore/src/Kore/Simplify/Data.hs | 13 ++++++---- kore/src/Kore/Simplify/Exists.hs | 6 ++--- kore/src/Kore/Simplify/Pattern.hs | 16 +++++++++++-- kore/src/Kore/Simplify/Rule.hs | 13 ++++++---- kore/src/Kore/Simplify/Simplify.hs | 24 +++++++++---------- .../Kore/Simplify/SubstitutionSimplifier.hs | 15 ++++++------ 9 files changed, 62 insertions(+), 44 deletions(-) diff --git a/kore/src/Kore/Builtin/AssociativeCommutative.hs b/kore/src/Kore/Builtin/AssociativeCommutative.hs index df9a83b994..6c5304cc58 100644 --- a/kore/src/Kore/Builtin/AssociativeCommutative.hs +++ b/kore/src/Kore/Builtin/AssociativeCommutative.hs @@ -985,7 +985,8 @@ unifyEqualsNormalizedAc TermLike RewritingVariableName -> unifier (Pattern RewritingVariableName) simplify term = - lowerLogicT $ simplifyConditionalTerm SideCondition.topTODO term + simplifyPatternScatter SideCondition.topTODO (Pattern.fromTermLike term) + & lowerLogicT simplifyPair :: ( TermLike RewritingVariableName @@ -1028,11 +1029,13 @@ unifyEqualsNormalizedAc `andCondition` simplifiedValueCondition ) where + -- TODO: can this be rewritten? simplifyTermLike' :: TermLike RewritingVariableName -> unifier (Pattern RewritingVariableName) simplifyTermLike' term = - lowerLogicT $ simplifyConditionalTerm SideCondition.topTODO term + simplifyPatternScatter SideCondition.topTODO (Pattern.fromTermLike term) + & lowerLogicT buildResultFromUnifiers :: forall normalized unifier variable. diff --git a/kore/src/Kore/ModelChecker/Simplification.hs b/kore/src/Kore/ModelChecker/Simplification.hs index 3f43564cf9..e9df657981 100644 --- a/kore/src/Kore/ModelChecker/Simplification.hs +++ b/kore/src/Kore/ModelChecker/Simplification.hs @@ -17,6 +17,10 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Pattern +import Logic (LogicT) +import Control.Monad.Catch ( + MonadThrow, + ) import qualified Kore.Internal.Predicate as Predicate import Kore.Internal.TermLike ( TermLike, @@ -48,6 +52,7 @@ import qualified Pretty checkImplicationIsTop :: MonadSimplify m => + MonadThrow (LogicT m) => Pattern RewritingVariableName -> TermLike RewritingVariableName -> m Bool diff --git a/kore/src/Kore/Rewrite/Function/Evaluator.hs b/kore/src/Kore/Rewrite/Function/Evaluator.hs index a5d73ae8cb..29f339a2c9 100644 --- a/kore/src/Kore/Rewrite/Function/Evaluator.hs +++ b/kore/src/Kore/Rewrite/Function/Evaluator.hs @@ -332,12 +332,7 @@ reevaluateFunctions :: -- | Function evaluation result. Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -reevaluateFunctions sideCondition rewriting = do - let (rewritingTerm, rewritingCondition) = Pattern.splitTerm rewriting - OrPattern.observeAllT $ do - simplifiedTerm <- simplifyConditionalTerm sideCondition rewritingTerm - simplifyCondition sideCondition $ - Pattern.andCondition simplifiedTerm rewritingCondition +reevaluateFunctions = simplifyPattern -- | Ands the given condition-substitution to the given function evaluation. mergeWithConditionAndSubstitution :: diff --git a/kore/src/Kore/Simplify/Data.hs b/kore/src/Kore/Simplify/Data.hs index f6d6ea178a..a35872ea64 100644 --- a/kore/src/Kore/Simplify/Data.hs +++ b/kore/src/Kore/Simplify/Data.hs @@ -38,6 +38,9 @@ import qualified Kore.Attribute.Symbol as Attribute ( ) import qualified Kore.Builtin as Builtin import qualified Kore.Equation as Equation +import qualified Kore.Internal.Pattern as Pattern +import qualified Kore.Simplify.Pattern as Pattern +import Kore.Internal.Pattern (Pattern) import Kore.IndexedModule.IndexedModule ( VerifiedModule, ) @@ -117,10 +120,10 @@ instance (MonadMask prof, MonadProf prof) => MonadProf (SimplifierT prof) where traceProfSimplify :: MonadProf prof => - TermLike RewritingVariableName -> + Pattern RewritingVariableName -> prof a -> prof a -traceProfSimplify termLike = +traceProfSimplify (Pattern.toTermLike -> termLike) = maybe id traceProf ident where ident = @@ -137,9 +140,9 @@ instance askMetadataTools = asks metadataTools {-# INLINE askMetadataTools #-} - simplifyTermLike sideCondition termLike = - traceProfSimplify termLike (TermLike.simplify sideCondition termLike) - {-# INLINE simplifyTermLike #-} + simplifyPattern sideCondition patt = + traceProfSimplify patt (Pattern.makeEvaluate sideCondition patt) + {-# INLINE simplifyPattern #-} simplifyCondition topCondition conditional = do ConditionSimplifier simplify <- asks simplifierCondition diff --git a/kore/src/Kore/Simplify/Exists.hs b/kore/src/Kore/Simplify/Exists.hs index fd62d00bbd..eba8bd8d1d 100644 --- a/kore/src/Kore/Simplify/Exists.hs +++ b/kore/src/Kore/Simplify/Exists.hs @@ -70,9 +70,6 @@ import Kore.Rewrite.RewritingVariable ( import qualified Kore.Simplify.AndPredicates as And ( simplifyEvaluatedMultiPredicate, ) -import qualified Kore.Simplify.Pattern as Pattern ( - makeEvaluate, - ) import Kore.Simplify.Simplify import Kore.Substitute import qualified Kore.TopBottom as TopBottom @@ -308,7 +305,8 @@ makeEvaluateBoundLeft sideCondition variable boundTerm normalized = Conditional.predicate normalized } orPattern <- - lift $ Pattern.makeEvaluate sideCondition substituted + simplifyPattern sideCondition substituted + & lift Logic.scatter (toList orPattern) where someVariableName = inject (variableName variable) diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index 92a711e42b..0f93babbc9 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -13,6 +13,11 @@ import Control.Monad ( (>=>), ) import qualified Kore.Internal.Conditional as Conditional +import Control.Monad.Catch ( + MonadThrow, + ) +import qualified Logic +import Logic (LogicT) import Kore.Internal.OrPattern ( OrPattern, ) @@ -39,14 +44,16 @@ import Kore.Internal.Substitution ( ) import Kore.Internal.TermLike ( pattern Exists_, + TermLike, ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) +import qualified Kore.Simplify.TermLike as TermLike import Kore.Simplify.Simplify ( MonadSimplify, simplifyCondition, - simplifyConditionalTerm, + simplifyPatternScatter, ) import Kore.Substitute import Prelude.Kore @@ -55,6 +62,7 @@ import Prelude.Kore simplifyTopConfiguration :: forall simplifier. MonadSimplify simplifier => + MonadThrow (LogicT simplifier) => Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) simplifyTopConfiguration = @@ -65,6 +73,7 @@ and removes the exists quantifiers at the top. -} simplifyTopConfigurationDefined :: MonadSimplify simplifier => + MonadThrow (LogicT simplifier) => Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) simplifyTopConfigurationDefined configuration = @@ -110,6 +119,7 @@ This should only be used when it's certain that the the 'Pattern'. -} makeEvaluate :: + forall simplifier. MonadSimplify simplifier => SideCondition RewritingVariableName -> Pattern RewritingVariableName -> @@ -124,7 +134,9 @@ makeEvaluate sideCondition pattern' = SideCondition.addConditionWithReplacements simplifiedCondition sideCondition - simplifiedTerm <- simplifyConditionalTerm termSideCondition term' + simplifiedTerm <- + TermLike.simplify termSideCondition term' + >>= Logic.scatter let simplifiedPattern = Conditional.andCondition simplifiedTerm simplifiedCondition simplifyCondition sideCondition simplifiedPattern diff --git a/kore/src/Kore/Simplify/Rule.hs b/kore/src/Kore/Simplify/Rule.hs index 7ad7c2736f..f8b1d0839d 100644 --- a/kore/src/Kore/Simplify/Rule.hs +++ b/kore/src/Kore/Simplify/Rule.hs @@ -15,6 +15,7 @@ import Kore.Internal.OrPattern ( OrPattern, ) import qualified Kore.Internal.OrPattern as OrPattern +import qualified Kore.Internal.SideCondition as SideCondition import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( pattern PredicateTrue, @@ -64,7 +65,7 @@ simplifyRulePattern :: simplifier (RulePattern RewritingVariableName) simplifyRulePattern rule = do let RulePattern{left} = rule - simplifiedLeft <- simplifyPattern left + simplifiedLeft <- simplifyPattern' left case OrPattern.toPatterns simplifiedLeft of [Conditional{term, predicate, substitution}] | PredicateTrue <- predicate -> do @@ -109,7 +110,7 @@ simplifyClaimPattern :: simplifier ClaimPattern simplifyClaimPattern claim = do let ClaimPattern{left} = claim - simplifiedLeft <- simplifyPattern (Pattern.term left) + simplifiedLeft <- simplifyPattern' (Pattern.term left) case OrPattern.toPatterns simplifiedLeft of [Conditional{term, predicate, substitution}] | PredicateTrue <- predicate -> @@ -132,10 +133,12 @@ simplifyClaimPattern claim = do return claim -- | Simplify a 'TermLike' using only matching logic rules. -simplifyPattern :: +simplifyPattern' :: MonadSimplify simplifier => TermLike RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -simplifyPattern termLike = +simplifyPattern' termLike = Simplifier.localSimplifierAxioms (const mempty) $ - Pattern.simplify (Pattern.fromTermLike termLike) + Simplifier.simplifyPattern + SideCondition.top + (Pattern.fromTermLike termLike) diff --git a/kore/src/Kore/Simplify/Simplify.hs b/kore/src/Kore/Simplify/Simplify.hs index b3fc6e149c..812821e256 100644 --- a/kore/src/Kore/Simplify/Simplify.hs +++ b/kore/src/Kore/Simplify/Simplify.hs @@ -5,7 +5,7 @@ License : BSD-3-Clause module Kore.Simplify.Simplify ( InternalVariable, MonadSimplify (..), - simplifyConditionalTerm, + simplifyPatternScatter, TermSimplifier, -- * Condition simplifiers @@ -144,18 +144,17 @@ class (MonadLog m, MonadSMT m) => MonadSimplify m where askMetadataTools = lift askMetadataTools {-# INLINE askMetadataTools #-} - -- | Simplify a 'TermLike' to a disjunction of function-like 'Pattern's. - simplifyTermLike :: + simplifyPattern :: SideCondition RewritingVariableName -> - TermLike RewritingVariableName -> + Pattern RewritingVariableName -> m (OrPattern RewritingVariableName) - default simplifyTermLike :: + default simplifyPattern :: (MonadTrans t, MonadSimplify n, m ~ t n) => SideCondition RewritingVariableName -> - TermLike RewritingVariableName -> + Pattern RewritingVariableName -> m (OrPattern RewritingVariableName) - simplifyTermLike sideCondition termLike = - lift (simplifyTermLike sideCondition termLike) + simplifyPattern sideCondition termLike = + lift (simplifyPattern sideCondition termLike) simplifyCondition :: SideCondition RewritingVariableName -> @@ -250,15 +249,14 @@ instance MonadSimplify m => MonadSimplify (RWST r () s m) -- TODO (thomas.tuegel): Factor out these types. --- | Simplify a pattern subject to conditions. -simplifyConditionalTerm :: +simplifyPatternScatter :: forall simplifier. (MonadLogic simplifier, MonadSimplify simplifier) => SideCondition RewritingVariableName -> - TermLike RewritingVariableName -> + Pattern RewritingVariableName -> simplifier (Pattern RewritingVariableName) -simplifyConditionalTerm sideCondition termLike = - simplifyTermLike sideCondition termLike >>= Logic.scatter +simplifyPatternScatter sideCondition patt = + simplifyPattern sideCondition patt >>= Logic.scatter -- * Predicate simplifiers diff --git a/kore/src/Kore/Simplify/SubstitutionSimplifier.hs b/kore/src/Kore/Simplify/SubstitutionSimplifier.hs index 44694ec975..98143b18fe 100644 --- a/kore/src/Kore/Simplify/SubstitutionSimplifier.hs +++ b/kore/src/Kore/Simplify/SubstitutionSimplifier.hs @@ -85,8 +85,8 @@ import Kore.Rewrite.RewritingVariable ( ) import Kore.Simplify.Simplify ( MonadSimplify, - simplifyConditionalTerm, - simplifyTermLike, + simplifyPattern, + simplifyPatternScatter, ) import qualified Kore.TopBottom as TopBottom import Kore.Unification.SubstitutionNormalization ( @@ -153,7 +153,8 @@ simplificationMakeAnd = makeAnd termLike1 termLike2 sideCondition = do simplified <- mkAnd termLike1 termLike2 - & simplifyConditionalTerm sideCondition + & Pattern.fromTermLike + & simplifyPatternScatter sideCondition TopBottom.guardAgainstBottom simplified return simplified @@ -351,7 +352,7 @@ simplifySubstitutionWorker sideCondition makeAnd' = \substitution -> do SomeVariableNameElement _ | isSimplified -> return subst | otherwise -> do - termLike' <- simplifyTermLike' termLike + termLike' <- simplifyTermLike termLike return $ Substitution.assign uVar termLike' where isSimplified = @@ -359,14 +360,14 @@ simplifySubstitutionWorker sideCondition makeAnd' = \substitution -> do sideConditionRepresentation termLike - simplifyTermLike' :: + simplifyTermLike :: TermLike RewritingVariableName -> Impl RewritingVariableName simplifier (TermLike RewritingVariableName) - simplifyTermLike' termLike = do - orPattern <- simplifyTermLike sideCondition termLike + simplifyTermLike termLike = do + orPattern <- simplifyPattern sideCondition (Pattern.fromTermLike termLike) case OrPattern.toPatterns orPattern of [] -> do addCondition Condition.bottom From a4264a498ac1682f1bcac8022b61af084d003ef5 Mon Sep 17 00:00:00 2001 From: github-actions Date: Tue, 27 Jul 2021 11:03:03 +0000 Subject: [PATCH 08/40] Format with fourmolu --- kore/src/Kore/Builtin/AssociativeCommutative.hs | 4 ++-- kore/src/Kore/ModelChecker/Simplification.hs | 8 ++++---- kore/src/Kore/Simplify/Data.hs | 6 +++--- kore/src/Kore/Simplify/Exists.hs | 2 +- kore/src/Kore/Simplify/Pattern.hs | 12 ++++++------ kore/src/Kore/Simplify/Rule.hs | 2 +- kore/src/Kore/Simplify/Simplify.hs | 1 - 7 files changed, 17 insertions(+), 18 deletions(-) diff --git a/kore/src/Kore/Builtin/AssociativeCommutative.hs b/kore/src/Kore/Builtin/AssociativeCommutative.hs index 6c5304cc58..38c74b6201 100644 --- a/kore/src/Kore/Builtin/AssociativeCommutative.hs +++ b/kore/src/Kore/Builtin/AssociativeCommutative.hs @@ -986,7 +986,7 @@ unifyEqualsNormalizedAc unifier (Pattern RewritingVariableName) simplify term = simplifyPatternScatter SideCondition.topTODO (Pattern.fromTermLike term) - & lowerLogicT + & lowerLogicT simplifyPair :: ( TermLike RewritingVariableName @@ -1035,7 +1035,7 @@ unifyEqualsNormalizedAc unifier (Pattern RewritingVariableName) simplifyTermLike' term = simplifyPatternScatter SideCondition.topTODO (Pattern.fromTermLike term) - & lowerLogicT + & lowerLogicT buildResultFromUnifiers :: forall normalized unifier variable. diff --git a/kore/src/Kore/ModelChecker/Simplification.hs b/kore/src/Kore/ModelChecker/Simplification.hs index e9df657981..a0a098fcd2 100644 --- a/kore/src/Kore/ModelChecker/Simplification.hs +++ b/kore/src/Kore/ModelChecker/Simplification.hs @@ -6,6 +6,9 @@ module Kore.ModelChecker.Simplification ( checkImplicationIsTop, ) where +import Control.Monad.Catch ( + MonadThrow, + ) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Kore.Attribute.Pattern.FreeVariables ( @@ -17,10 +20,6 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Pattern -import Logic (LogicT) -import Control.Monad.Catch ( - MonadThrow, - ) import qualified Kore.Internal.Predicate as Predicate import Kore.Internal.TermLike ( TermLike, @@ -47,6 +46,7 @@ import Kore.TopBottom ( ) import Kore.Unparser import Kore.Variables.Fresh +import Logic (LogicT) import Prelude.Kore import qualified Pretty diff --git a/kore/src/Kore/Simplify/Data.hs b/kore/src/Kore/Simplify/Data.hs index a35872ea64..81e737bca4 100644 --- a/kore/src/Kore/Simplify/Data.hs +++ b/kore/src/Kore/Simplify/Data.hs @@ -38,9 +38,6 @@ import qualified Kore.Attribute.Symbol as Attribute ( ) import qualified Kore.Builtin as Builtin import qualified Kore.Equation as Equation -import qualified Kore.Internal.Pattern as Pattern -import qualified Kore.Simplify.Pattern as Pattern -import Kore.Internal.Pattern (Pattern) import Kore.IndexedModule.IndexedModule ( VerifiedModule, ) @@ -51,6 +48,8 @@ import Kore.IndexedModule.MetadataTools ( import qualified Kore.IndexedModule.MetadataToolsBuilder as MetadataTools import qualified Kore.IndexedModule.OverloadGraph as OverloadGraph import qualified Kore.IndexedModule.SortGraph as SortGraph +import Kore.Internal.Pattern (Pattern) +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.TermLike ( TermLike, ) @@ -69,6 +68,7 @@ import Kore.Rewrite.RewritingVariable ( import qualified Kore.Simplify.Condition as Condition import Kore.Simplify.InjSimplifier import Kore.Simplify.OverloadSimplifier +import qualified Kore.Simplify.Pattern as Pattern import Kore.Simplify.Simplify import qualified Kore.Simplify.SubstitutionSimplifier as SubstitutionSimplifier import qualified Kore.Simplify.TermLike as TermLike diff --git a/kore/src/Kore/Simplify/Exists.hs b/kore/src/Kore/Simplify/Exists.hs index eba8bd8d1d..a73af44d0c 100644 --- a/kore/src/Kore/Simplify/Exists.hs +++ b/kore/src/Kore/Simplify/Exists.hs @@ -306,7 +306,7 @@ makeEvaluateBoundLeft sideCondition variable boundTerm normalized = } orPattern <- simplifyPattern sideCondition substituted - & lift + & lift Logic.scatter (toList orPattern) where someVariableName = inject (variableName variable) diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index 0f93babbc9..150e465d4c 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -12,12 +12,10 @@ module Kore.Simplify.Pattern ( import Control.Monad ( (>=>), ) -import qualified Kore.Internal.Conditional as Conditional import Control.Monad.Catch ( MonadThrow, ) -import qualified Logic -import Logic (LogicT) +import qualified Kore.Internal.Conditional as Conditional import Kore.Internal.OrPattern ( OrPattern, ) @@ -43,19 +41,21 @@ import Kore.Internal.Substitution ( toMap, ) import Kore.Internal.TermLike ( - pattern Exists_, TermLike, + pattern Exists_, ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) -import qualified Kore.Simplify.TermLike as TermLike import Kore.Simplify.Simplify ( MonadSimplify, simplifyCondition, simplifyPatternScatter, ) +import qualified Kore.Simplify.TermLike as TermLike import Kore.Substitute +import Logic (LogicT) +import qualified Logic import Prelude.Kore -- | Simplifies the 'Pattern' and removes the exists quantifiers at the top. @@ -136,7 +136,7 @@ makeEvaluate sideCondition pattern' = sideCondition simplifiedTerm <- TermLike.simplify termSideCondition term' - >>= Logic.scatter + >>= Logic.scatter let simplifiedPattern = Conditional.andCondition simplifiedTerm simplifiedCondition simplifyCondition sideCondition simplifiedPattern diff --git a/kore/src/Kore/Simplify/Rule.hs b/kore/src/Kore/Simplify/Rule.hs index f8b1d0839d..6b86a534fd 100644 --- a/kore/src/Kore/Simplify/Rule.hs +++ b/kore/src/Kore/Simplify/Rule.hs @@ -15,12 +15,12 @@ import Kore.Internal.OrPattern ( OrPattern, ) import qualified Kore.Internal.OrPattern as OrPattern -import qualified Kore.Internal.SideCondition as SideCondition import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( pattern PredicateTrue, ) import qualified Kore.Internal.Predicate as Predicate +import qualified Kore.Internal.SideCondition as SideCondition import qualified Kore.Internal.Substitution as Substitution import Kore.Internal.TermLike ( TermLike, diff --git a/kore/src/Kore/Simplify/Simplify.hs b/kore/src/Kore/Simplify/Simplify.hs index 812821e256..debc89b064 100644 --- a/kore/src/Kore/Simplify/Simplify.hs +++ b/kore/src/Kore/Simplify/Simplify.hs @@ -257,7 +257,6 @@ simplifyPatternScatter :: simplifier (Pattern RewritingVariableName) simplifyPatternScatter sideCondition patt = simplifyPattern sideCondition patt >>= Logic.scatter - -- * Predicate simplifiers {- | 'ConditionSimplifier' wraps a function that simplifies From 22bf8811609a856b8007f72a3b99bba62675d678 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Wed, 28 Jul 2021 13:47:29 +0300 Subject: [PATCH 09/40] MonadSimplify: simplifyPattern, simplifyTerm, simplifyCondition --- kore/src/Kore/ModelChecker/Simplification.hs | 5 ----- kore/src/Kore/Simplify/Data.hs | 6 +++--- kore/src/Kore/Simplify/Pattern.hs | 12 ++---------- kore/src/Kore/Simplify/Predicate.hs | 10 +++++----- kore/src/Kore/Simplify/Rule.hs | 1 - kore/src/Kore/Simplify/Simplify.hs | 12 ++++++++++++ kore/test/Test/Kore/Builtin/Builtin.hs | 3 ++- kore/test/Test/Kore/Reachability/MockAllPath.hs | 3 ++- kore/test/Test/Kore/Rewrite/Rule/Simplify.hs | 2 +- kore/test/Test/Kore/Simplify/TermLike.hs | 5 +++-- 10 files changed, 30 insertions(+), 29 deletions(-) diff --git a/kore/src/Kore/ModelChecker/Simplification.hs b/kore/src/Kore/ModelChecker/Simplification.hs index a0a098fcd2..3f43564cf9 100644 --- a/kore/src/Kore/ModelChecker/Simplification.hs +++ b/kore/src/Kore/ModelChecker/Simplification.hs @@ -6,9 +6,6 @@ module Kore.ModelChecker.Simplification ( checkImplicationIsTop, ) where -import Control.Monad.Catch ( - MonadThrow, - ) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Kore.Attribute.Pattern.FreeVariables ( @@ -46,13 +43,11 @@ import Kore.TopBottom ( ) import Kore.Unparser import Kore.Variables.Fresh -import Logic (LogicT) import Prelude.Kore import qualified Pretty checkImplicationIsTop :: MonadSimplify m => - MonadThrow (LogicT m) => Pattern RewritingVariableName -> TermLike RewritingVariableName -> m Bool diff --git a/kore/src/Kore/Simplify/Data.hs b/kore/src/Kore/Simplify/Data.hs index 81e737bca4..e1ce002719 100644 --- a/kore/src/Kore/Simplify/Data.hs +++ b/kore/src/Kore/Simplify/Data.hs @@ -50,9 +50,6 @@ import qualified Kore.IndexedModule.OverloadGraph as OverloadGraph import qualified Kore.IndexedModule.SortGraph as SortGraph import Kore.Internal.Pattern (Pattern) import qualified Kore.Internal.Pattern as Pattern -import Kore.Internal.TermLike ( - TermLike, - ) import qualified Kore.Rewrite.Axiom.EvaluationStrategy as Axiom.EvaluationStrategy import Kore.Rewrite.Axiom.Identifier ( matchAxiomIdentifier, @@ -144,6 +141,9 @@ instance traceProfSimplify patt (Pattern.makeEvaluate sideCondition patt) {-# INLINE simplifyPattern #-} + simplifyTerm = TermLike.simplify + {-# INLINE simplifyTerm #-} + simplifyCondition topCondition conditional = do ConditionSimplifier simplify <- asks simplifierCondition simplify topCondition conditional diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index 150e465d4c..8595692094 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -12,9 +12,6 @@ module Kore.Simplify.Pattern ( import Control.Monad ( (>=>), ) -import Control.Monad.Catch ( - MonadThrow, - ) import qualified Kore.Internal.Conditional as Conditional import Kore.Internal.OrPattern ( OrPattern, @@ -41,7 +38,6 @@ import Kore.Internal.Substitution ( toMap, ) import Kore.Internal.TermLike ( - TermLike, pattern Exists_, ) import Kore.Rewrite.RewritingVariable ( @@ -50,11 +46,9 @@ import Kore.Rewrite.RewritingVariable ( import Kore.Simplify.Simplify ( MonadSimplify, simplifyCondition, - simplifyPatternScatter, + simplifyTerm, ) -import qualified Kore.Simplify.TermLike as TermLike import Kore.Substitute -import Logic (LogicT) import qualified Logic import Prelude.Kore @@ -62,7 +56,6 @@ import Prelude.Kore simplifyTopConfiguration :: forall simplifier. MonadSimplify simplifier => - MonadThrow (LogicT simplifier) => Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) simplifyTopConfiguration = @@ -73,7 +66,6 @@ and removes the exists quantifiers at the top. -} simplifyTopConfigurationDefined :: MonadSimplify simplifier => - MonadThrow (LogicT simplifier) => Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) simplifyTopConfigurationDefined configuration = @@ -135,7 +127,7 @@ makeEvaluate sideCondition pattern' = simplifiedCondition sideCondition simplifiedTerm <- - TermLike.simplify termSideCondition term' + simplifyTerm termSideCondition term' >>= Logic.scatter let simplifiedPattern = Conditional.andCondition simplifiedTerm simplifiedCondition diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index 7b3b955beb..9e12a06496 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -113,7 +113,7 @@ simplify sideCondition original = replacePredicate = SideCondition.replacePredicate sideCondition - simplifyTerm = simplifyTermLike sideCondition + simplifyTerm' = simplifyTerm sideCondition repr = SideCondition.toRepresentation sideCondition @@ -135,9 +135,9 @@ simplify sideCondition original = ImpliesF impliesF -> simplifyImplies =<< traverse worker impliesF IffF iffF -> simplifyIff =<< traverse worker iffF CeilF ceilF -> - simplifyCeil sideCondition =<< traverse simplifyTerm ceilF + simplifyCeil sideCondition =<< traverse simplifyTerm' ceilF FloorF floorF -> - simplifyFloor sideCondition =<< traverse simplifyTerm floorF + simplifyFloor sideCondition =<< traverse simplifyTerm' floorF ExistsF existsF -> traverse worker (Exists.refreshExists avoid existsF) >>= simplifyExists sideCondition @@ -145,9 +145,9 @@ simplify sideCondition original = traverse worker (Forall.refreshForall avoid forallF) >>= simplifyForall sideCondition EqualsF equalsF -> - simplifyEquals sideCondition =<< traverse simplifyTerm equalsF + simplifyEquals sideCondition =<< traverse simplifyTerm' equalsF InF inF -> - simplifyIn sideCondition =<< traverse simplifyTerm inF + simplifyIn sideCondition =<< traverse simplifyTerm' inF where _ :< predicateF = Recursive.project predicate ~avoid = freeVariableNames sideCondition diff --git a/kore/src/Kore/Simplify/Rule.hs b/kore/src/Kore/Simplify/Rule.hs index 6b86a534fd..6db9a9855a 100644 --- a/kore/src/Kore/Simplify/Rule.hs +++ b/kore/src/Kore/Simplify/Rule.hs @@ -35,7 +35,6 @@ import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) import Kore.Rewrite.RulePattern -import qualified Kore.Simplify.Pattern as Pattern import Kore.Simplify.Simplify ( MonadSimplify, ) diff --git a/kore/src/Kore/Simplify/Simplify.hs b/kore/src/Kore/Simplify/Simplify.hs index debc89b064..6ba43933fb 100644 --- a/kore/src/Kore/Simplify/Simplify.hs +++ b/kore/src/Kore/Simplify/Simplify.hs @@ -156,6 +156,18 @@ class (MonadLog m, MonadSMT m) => MonadSimplify m where simplifyPattern sideCondition termLike = lift (simplifyPattern sideCondition termLike) + simplifyTerm :: + SideCondition RewritingVariableName -> + TermLike RewritingVariableName -> + m (OrPattern RewritingVariableName) + default simplifyTerm :: + (MonadTrans t, MonadSimplify n, m ~ t n) => + SideCondition RewritingVariableName -> + TermLike RewritingVariableName -> + m (OrPattern RewritingVariableName) + simplifyTerm sideCondition termLike = + lift (simplifyTerm sideCondition termLike) + simplifyCondition :: SideCondition RewritingVariableName -> Conditional RewritingVariableName term -> diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index afeed6ce49..7066bd89d1 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -26,6 +26,7 @@ import Control.Monad.Catch ( import Data.Map.Strict ( Map, ) +import Control.Monad ((>=>)) import qualified Data.Map.Strict as Map import Data.Text ( Text, @@ -238,7 +239,7 @@ simplify = . runNoSMT . runSimplifier testEnv . Logic.observeAllT - . simplifyConditionalTerm SideCondition.top + . (simplifyTerm SideCondition.top >=> Logic.scatter) evaluate :: (MonadSMT smt, MonadLog smt, MonadProf smt, MonadMask smt) => diff --git a/kore/test/Test/Kore/Reachability/MockAllPath.hs b/kore/test/Test/Kore/Reachability/MockAllPath.hs index f97a7a92bf..754b9529dc 100644 --- a/kore/test/Test/Kore/Reachability/MockAllPath.hs +++ b/kore/test/Test/Kore/Reachability/MockAllPath.hs @@ -415,7 +415,8 @@ instance MonadCatch AllPathIdentity where instance MonadSimplify AllPathIdentity where askMetadataTools = undefined - simplifyTermLike = undefined + simplifyPattern = undefined + simplifyTerm = undefined simplifyCondition = undefined askSimplifierAxioms = undefined localSimplifierAxioms = undefined diff --git a/kore/test/Test/Kore/Rewrite/Rule/Simplify.hs b/kore/test/Test/Kore/Rewrite/Rule/Simplify.hs index c10f2e2175..20d2a7018f 100644 --- a/kore/test/Test/Kore/Rewrite/Rule/Simplify.hs +++ b/kore/test/Test/Kore/Rewrite/Rule/Simplify.hs @@ -478,7 +478,7 @@ instance MFunctor TestSimplifierT where hoist f = TestSimplifierT . hoist f . runTestSimplifierT instance MonadSimplify m => MonadSimplify (TestSimplifierT m) where - simplifyTermLike sideCondition termLike = do + simplifyTerm sideCondition termLike = do TestEnv{replacements, input, requires} <- Reader.ask let rule = getOnePathClaim input leftTerm = diff --git a/kore/test/Test/Kore/Simplify/TermLike.hs b/kore/test/Test/Kore/Simplify/TermLike.hs index 34f705434c..3c0224e40d 100644 --- a/kore/test/Test/Kore/Simplify/TermLike.hs +++ b/kore/test/Test/Kore/Simplify/TermLike.hs @@ -125,8 +125,9 @@ instance MonadSimplify TestSimplifier where TestSimplifier (simplifyCondition sideCondition condition) - -- Throw an error if any term would be simplified. - simplifyTermLike = undefined + -- Throw an error if any pattern/term would be simplified. + simplifyPattern = undefined + simplifyTerm = undefined test_simplifyOnly :: [TestTree] test_simplifyOnly = From 97011d93e0ee12216de242013ced2a6628207853 Mon Sep 17 00:00:00 2001 From: github-actions Date: Wed, 28 Jul 2021 10:49:33 +0000 Subject: [PATCH 10/40] Format with fourmolu --- kore/test/Test/Kore/Builtin/Builtin.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index 7066bd89d1..4e1c563a52 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -20,13 +20,13 @@ module Test.Kore.Builtin.Builtin ( runSMTWithConfig, ) where +import Control.Monad ((>=>)) import Control.Monad.Catch ( MonadMask, ) import Data.Map.Strict ( Map, ) -import Control.Monad ((>=>)) import qualified Data.Map.Strict as Map import Data.Text ( Text, From 2cfc3f8892fa418ad98c4d1b64abdbdeb297e34f Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Wed, 28 Jul 2021 19:34:14 +0300 Subject: [PATCH 11/40] Explicit loop in simplifyPattern --- kore/src/Kore/Internal/OrPattern.hs | 7 ++++ kore/src/Kore/Rewrite/Function/Evaluator.hs | 1 + kore/src/Kore/Simplify/Pattern.hs | 43 +++++++++++++-------- kore/test/Test/Kore/Builtin/Builtin.hs | 4 +- 4 files changed, 38 insertions(+), 17 deletions(-) diff --git a/kore/src/Kore/Internal/OrPattern.hs b/kore/src/Kore/Internal/OrPattern.hs index 18f2e668f7..4175e4c1ba 100644 --- a/kore/src/Kore/Internal/OrPattern.hs +++ b/kore/src/Kore/Internal/OrPattern.hs @@ -5,6 +5,7 @@ License : BSD-3-Clause module Kore.Internal.OrPattern ( OrPattern, coerceSort, + markSimplified, isSimplified, hasSimplifiedChildren, hasSimplifiedChildrenIgnoreConditions, @@ -80,6 +81,12 @@ import Prelude.Kore -- | The disjunction of 'Pattern'. type OrPattern variable = MultiOr (Pattern variable) +markSimplified :: + InternalVariable variable => + OrPattern variable -> + OrPattern variable +markSimplified = MultiOr.map Pattern.markSimplified + isSimplified :: SideCondition.Representation -> OrPattern variable -> Bool isSimplified sideCondition = all (Pattern.isSimplified sideCondition) diff --git a/kore/src/Kore/Rewrite/Function/Evaluator.hs b/kore/src/Kore/Rewrite/Function/Evaluator.hs index 29f339a2c9..4f305a9bd8 100644 --- a/kore/src/Kore/Rewrite/Function/Evaluator.hs +++ b/kore/src/Kore/Rewrite/Function/Evaluator.hs @@ -334,6 +334,7 @@ reevaluateFunctions :: simplifier (OrPattern RewritingVariableName) reevaluateFunctions = simplifyPattern + -- | Ands the given condition-substitution to the given function evaluation. mergeWithConditionAndSubstitution :: MonadSimplify simplifier => diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index 8595692094..66cdec14fb 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -116,19 +116,30 @@ makeEvaluate :: SideCondition RewritingVariableName -> Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -makeEvaluate sideCondition pattern' = - OrPattern.observeAllT $ do - withSimplifiedCondition <- simplifyCondition sideCondition pattern' - let (term, simplifiedCondition) = - Conditional.splitTerm withSimplifiedCondition - term' = substitute (toMap $ substitution simplifiedCondition) term - termSideCondition = - SideCondition.addConditionWithReplacements - simplifiedCondition - sideCondition - simplifiedTerm <- - simplifyTerm termSideCondition term' - >>= Logic.scatter - let simplifiedPattern = - Conditional.andCondition simplifiedTerm simplifiedCondition - simplifyCondition sideCondition simplifiedPattern +makeEvaluate sideCondition = + loop . OrPattern.fromPattern + where + loop input = do + output <- + OrPattern.traverse worker input + & fmap OrPattern.flatten + if input == output + then pure output + else loop output + + worker pattern' = + OrPattern.observeAllT $ do + withSimplifiedCondition <- simplifyCondition sideCondition pattern' + let (term, simplifiedCondition) = + Conditional.splitTerm withSimplifiedCondition + term' = substitute (toMap $ substitution simplifiedCondition) term + termSideCondition = + SideCondition.addConditionWithReplacements + simplifiedCondition + sideCondition + simplifiedTerm <- + simplifyTerm termSideCondition term' + >>= Logic.scatter + let simplifiedPattern = + Conditional.andCondition simplifiedTerm simplifiedCondition + simplifyCondition sideCondition simplifiedPattern diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index 7066bd89d1..f4007fc1e5 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -80,6 +80,8 @@ import Kore.Simplify.OverloadSimplifier import Kore.Simplify.Simplify import qualified Kore.Simplify.SubstitutionSimplifier as SubstitutionSimplifier import qualified Kore.Simplify.TermLike as TermLike +import qualified Kore.Simplify.Pattern as Pattern +import qualified Kore.Internal.Pattern as Pattern import Kore.Syntax.Definition ( ModuleName, ParsedDefinition, @@ -247,7 +249,7 @@ evaluate :: smt (OrPattern RewritingVariableName) evaluate termLike = runSimplifier testEnv $ do - TermLike.simplify SideCondition.top termLike + Pattern.simplify (Pattern.fromTermLike termLike) evaluateT :: MonadTrans t => From 26b2a8bda95d65a13adfaf5a7be2d540ce415a5e Mon Sep 17 00:00:00 2001 From: github-actions Date: Wed, 28 Jul 2021 16:36:30 +0000 Subject: [PATCH 12/40] Format with fourmolu --- kore/src/Kore/Rewrite/Function/Evaluator.hs | 1 - kore/src/Kore/Simplify/Pattern.hs | 2 +- kore/test/Test/Kore/Builtin/Builtin.hs | 4 ++-- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/kore/src/Kore/Rewrite/Function/Evaluator.hs b/kore/src/Kore/Rewrite/Function/Evaluator.hs index 4f305a9bd8..29f339a2c9 100644 --- a/kore/src/Kore/Rewrite/Function/Evaluator.hs +++ b/kore/src/Kore/Rewrite/Function/Evaluator.hs @@ -334,7 +334,6 @@ reevaluateFunctions :: simplifier (OrPattern RewritingVariableName) reevaluateFunctions = simplifyPattern - -- | Ands the given condition-substitution to the given function evaluation. mergeWithConditionAndSubstitution :: MonadSimplify simplifier => diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index 66cdec14fb..b4467ed821 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -122,7 +122,7 @@ makeEvaluate sideCondition = loop input = do output <- OrPattern.traverse worker input - & fmap OrPattern.flatten + & fmap OrPattern.flatten if input == output then pure output else loop output diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index d968928dc2..d810bbbba8 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -55,6 +55,7 @@ import Kore.Internal.OrPattern ( import Kore.Internal.Pattern ( Pattern, ) +import qualified Kore.Internal.Pattern as Pattern import qualified Kore.Internal.SideCondition as SideCondition ( top, ) @@ -77,11 +78,10 @@ import qualified Kore.Simplify.Condition as Simplifier.Condition import Kore.Simplify.Data import Kore.Simplify.InjSimplifier import Kore.Simplify.OverloadSimplifier +import qualified Kore.Simplify.Pattern as Pattern import Kore.Simplify.Simplify import qualified Kore.Simplify.SubstitutionSimplifier as SubstitutionSimplifier import qualified Kore.Simplify.TermLike as TermLike -import qualified Kore.Simplify.Pattern as Pattern -import qualified Kore.Internal.Pattern as Pattern import Kore.Syntax.Definition ( ModuleName, ParsedDefinition, From 17bd41ef38eb92df11b3908cd4b7ce94d0cd8c52 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Thu, 29 Jul 2021 14:00:40 +0300 Subject: [PATCH 13/40] WIP: fix Simplified attribute issues --- kore/src/Kore/Internal/OrPattern.hs | 9 +++++++++ kore/src/Kore/Internal/Pattern.hs | 15 +++++++++++++++ kore/src/Kore/Simplify/Predicate.hs | 2 +- kore/src/Kore/Simplify/TermLike.hs | 2 +- 4 files changed, 26 insertions(+), 2 deletions(-) diff --git a/kore/src/Kore/Internal/OrPattern.hs b/kore/src/Kore/Internal/OrPattern.hs index 4175e4c1ba..854b903850 100644 --- a/kore/src/Kore/Internal/OrPattern.hs +++ b/kore/src/Kore/Internal/OrPattern.hs @@ -6,6 +6,7 @@ module Kore.Internal.OrPattern ( OrPattern, coerceSort, markSimplified, + markTermSimplifiedConditionally, isSimplified, hasSimplifiedChildren, hasSimplifiedChildrenIgnoreConditions, @@ -87,6 +88,14 @@ markSimplified :: OrPattern variable markSimplified = MultiOr.map Pattern.markSimplified +markTermSimplifiedConditionally :: + InternalVariable variable => + SideCondition.Representation -> + OrPattern variable -> + OrPattern variable +markTermSimplifiedConditionally repr = + MultiOr.map (Pattern.markTermSimplifiedConditionally repr) + isSimplified :: SideCondition.Representation -> OrPattern variable -> Bool isSimplified sideCondition = all (Pattern.isSimplified sideCondition) diff --git a/kore/src/Kore/Internal/Pattern.hs b/kore/src/Kore/Internal/Pattern.hs index 464c31d922..142496b141 100644 --- a/kore/src/Kore/Internal/Pattern.hs +++ b/kore/src/Kore/Internal/Pattern.hs @@ -29,6 +29,7 @@ module Kore.Internal.Pattern ( hasSimplifiedChildrenIgnoreConditions, forgetSimplified, markSimplified, + markTermSimplifiedConditionally, simplifiedAttribute, assign, requireDefined, @@ -172,6 +173,7 @@ forgetSimplified patt = `withCondition` Condition.forgetSimplified condition where (term, condition) = Conditional.splitTerm patt + markSimplified :: InternalVariable variable => Pattern variable -> Pattern variable markSimplified patt = @@ -179,9 +181,22 @@ markSimplified patt = `withCondition` Condition.markSimplified condition where (term, condition) = Conditional.splitTerm patt + +markTermSimplifiedConditionally :: + InternalVariable variable => + SideCondition.Representation -> + Pattern variable -> + Pattern variable +markTermSimplifiedConditionally repr patt = + TermLike.markSimplifiedConditional repr term + `withCondition` condition + where + (term, condition) = Conditional.splitTerm patt + simplifiedAttribute :: Pattern variable -> Attribute.Simplified simplifiedAttribute (splitTerm -> (t, p)) = TermLike.simplifiedAttribute t <> Condition.simplifiedAttribute p + freeElementVariables :: InternalVariable variable => Pattern variable -> diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index 9e12a06496..8d483dccfe 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -108,7 +108,7 @@ simplify sideCondition original = | otherwise = do output <- MultiAnd.traverseOrAnd worker input if input == output - then pure output + then pure output -- (MultiOr.map (MultiAnd.map Predicate.markSimplified) output) else loop (count + 1) output replacePredicate = SideCondition.replacePredicate sideCondition diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index af355efc72..be7cfeb1d3 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -140,7 +140,7 @@ simplify sideCondition = loop input = do output <- MultiOr.traverseOr (propagateConditions worker) input if input == output - then pure output + then pure output -- (OrPattern.markTermSimplifiedConditionally repr output) else loop output replaceTerm = SideCondition.replaceTerm sideCondition From b63e185597923c3f4528bd18cdbd2ad48915c701 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Fri, 30 Jul 2021 15:39:19 +0300 Subject: [PATCH 14/40] WIP: experiment, remove Simplified attribute --- kore/kore.cabal | 1 - kore/src/Kore/Attribute/Pattern/Simplified.hs | 378 ------------------ kore/src/Kore/Attribute/PredicatePattern.hs | 55 +-- .../Kore/Builtin/AssocComm/CeilSimplifier.hs | 12 - .../Kore/Builtin/AssociativeCommutative.hs | 29 +- kore/src/Kore/Builtin/Bool/Bool.hs | 5 +- .../src/Kore/Builtin/Endianness/Endianness.hs | 5 - kore/src/Kore/Builtin/Int/Int.hs | 2 +- .../Builtin/InternalBytes/InternalBytes.hs | 3 +- kore/src/Kore/Builtin/List.hs | 16 +- .../src/Kore/Builtin/Signedness/Signedness.hs | 5 - kore/src/Kore/Equation/Application.hs | 4 +- kore/src/Kore/Equation/Simplification.hs | 10 +- kore/src/Kore/Internal/Condition.hs | 56 --- kore/src/Kore/Internal/Conditional.hs | 47 --- kore/src/Kore/Internal/InternalBool.hs | 5 - kore/src/Kore/Internal/InternalInt.hs | 5 - kore/src/Kore/Internal/InternalList.hs | 5 - kore/src/Kore/Internal/InternalMap.hs | 5 - kore/src/Kore/Internal/InternalSet.hs | 5 - kore/src/Kore/Internal/InternalString.hs | 5 - kore/src/Kore/Internal/OrCondition.hs | 4 - kore/src/Kore/Internal/OrPattern.hs | 51 --- kore/src/Kore/Internal/Pattern.hs | 83 ---- kore/src/Kore/Internal/Predicate.hs | 205 +--------- kore/src/Kore/Internal/Substitution.hs | 60 --- kore/src/Kore/Internal/TermLike.hs | 168 -------- kore/src/Kore/Internal/TermLike/TermLike.hs | 126 +----- kore/src/Kore/Rewrite/AntiLeft.hs | 27 -- kore/src/Kore/Rewrite/ClaimPattern.hs | 10 - kore/src/Kore/Rewrite/Function/Evaluator.hs | 16 +- kore/src/Kore/Rewrite/Implication.hs | 10 - kore/src/Kore/Rewrite/RulePattern.hs | 9 - kore/src/Kore/Simplify/And.hs | 10 +- kore/src/Kore/Simplify/AndPredicates.hs | 7 +- kore/src/Kore/Simplify/AndTerms.hs | 1 - kore/src/Kore/Simplify/Application.hs | 1 - kore/src/Kore/Simplify/Ceil.hs | 1 - kore/src/Kore/Simplify/Condition.hs | 2 +- kore/src/Kore/Simplify/DomainValue.hs | 2 +- kore/src/Kore/Simplify/Equals.hs | 7 +- kore/src/Kore/Simplify/Exists.hs | 4 +- kore/src/Kore/Simplify/Floor.hs | 4 - kore/src/Kore/Simplify/Forall.hs | 11 +- kore/src/Kore/Simplify/Iff.hs | 29 +- kore/src/Kore/Simplify/Implies.hs | 26 +- kore/src/Kore/Simplify/Inhabitant.hs | 6 +- kore/src/Kore/Simplify/Inj.hs | 2 +- kore/src/Kore/Simplify/InternalList.hs | 2 +- kore/src/Kore/Simplify/InternalMap.hs | 2 +- kore/src/Kore/Simplify/InternalSet.hs | 2 +- kore/src/Kore/Simplify/Mu.hs | 9 +- kore/src/Kore/Simplify/Next.hs | 2 +- kore/src/Kore/Simplify/NoConfusion.hs | 2 +- kore/src/Kore/Simplify/Not.hs | 12 +- kore/src/Kore/Simplify/Nu.hs | 9 +- kore/src/Kore/Simplify/Pattern.hs | 23 +- kore/src/Kore/Simplify/Predicate.hs | 3 - kore/src/Kore/Simplify/Rule.hs | 9 +- .../Kore/Simplify/SubstitutionSimplifier.hs | 13 +- kore/src/Kore/Simplify/TermLike.hs | 22 +- kore/test/Test/Kore/Simplify/Integration.hs | 62 --- .../regression-wasm/test-memory.sh.out.golden | 2 +- .../test-simple-arithmetic.sh.out.golden | 2 +- 64 files changed, 133 insertions(+), 1583 deletions(-) delete mode 100644 kore/src/Kore/Attribute/Pattern/Simplified.hs diff --git a/kore/kore.cabal b/kore/kore.cabal index 2c0ba6b0b2..b6e409ca6e 100644 --- a/kore/kore.cabal +++ b/kore/kore.cabal @@ -207,7 +207,6 @@ library Kore.Attribute.Pattern.FreeVariables Kore.Attribute.Pattern.Function Kore.Attribute.Pattern.Functional - Kore.Attribute.Pattern.Simplified Kore.Attribute.PredicatePattern Kore.Attribute.Priority Kore.Attribute.ProductionID diff --git a/kore/src/Kore/Attribute/Pattern/Simplified.hs b/kore/src/Kore/Attribute/Pattern/Simplified.hs deleted file mode 100644 index 634784bb67..0000000000 --- a/kore/src/Kore/Attribute/Pattern/Simplified.hs +++ /dev/null @@ -1,378 +0,0 @@ -{-# LANGUAGE NoStrict #-} -{-# LANGUAGE NoStrictData #-} - -{- | -Copyright : (c) Runtime Verification, 2019-2021 -License : BSD-3-Clause --} -module Kore.Attribute.Pattern.Simplified ( - Simplified (..), - Condition (..), - pattern Simplified_, - Type (..), - isSimplified, - isSimplifiedAnyCondition, - isSimplifiedSomeCondition, - simplifiedTo, - notSimplified, - fullySimplified, - alwaysSimplified, - simplifiedConditionally, - simplifiableConditionally, - unparseTag, -) where - -import Data.Text ( - Text, - ) -import qualified GHC.Generics as GHC -import qualified Generics.SOP as SOP -import Kore.Attribute.Synthetic -import Kore.Debug -import Kore.Internal.Inj ( - Inj, - ) -import qualified Kore.Internal.Inj as Inj -import Kore.Internal.InternalBytes ( - InternalBytes, - ) -import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( - Representation, - ) -import Kore.Syntax ( - And, - Application, - Bottom, - Ceil, - Const, - DomainValue, - Equals, - Exists, - Floor, - Forall, - Iff, - Implies, - In, - Inhabitant, - Mu, - Next, - Not, - Nu, - Or, - Rewrites, - StringLiteral, - Top, - ) -import Kore.Syntax.Variable -import Prelude.Kore - --- | How well simplified is a pattern. -data Type - = -- | The entire pattern is simplified - Fully - | -- | The pattern's subterms are either fully simplified or partly - -- simplified. Normally all the leaves in a partly simplified - -- subterm tree are fully simplified. - Partly - deriving stock (Eq, Ord, Show) - deriving stock (GHC.Generic) - deriving anyclass (Hashable, NFData) - deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) - deriving anyclass (Debug) - -instance Semigroup Type where - Partly <> _ = Partly - _ <> Partly = Partly - Fully <> Fully = Fully - -instance Monoid Type where - mempty = Fully - --- | Under which condition is a pattern simplified. -data Condition - = -- | The term and all its subterms are simplified the same regardless - -- of the side condition. - Any - | -- | The term is in its current simplified state only when using the - -- given side condition. When the side condition changes, e.g. by - -- adding extra conditions, then we may be able to further simplify the - -- term. - Condition SideCondition.Representation - | -- | Parts of the term are simplified under different side conditions. - Unknown - deriving stock (Eq, Ord, Show) - deriving stock (GHC.Generic) - deriving anyclass (Hashable, NFData) - deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) - deriving anyclass (Debug) - -instance Diff Condition where - diffPrec = diffPrecIgnore - -instance Semigroup Condition where - Unknown <> _ = Unknown - _ <> Unknown = Unknown - Any <> c = c - c <> Any = c - c@(Condition c1) <> Condition c2 = - if c1 == c2 - then c - else Unknown - -instance Monoid Condition where - mempty = Any - -data SimplifiedData = SimplifiedData - { sType :: Type - , condition :: Condition - } - deriving stock (Eq, Ord, Show) - deriving stock (GHC.Generic) - deriving anyclass (Hashable, NFData) - deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) - deriving anyclass (Debug) - -instance Diff SimplifiedData where - diffPrec = diffPrecIgnore - -{- | A pattern is 'Simplified' if it has run through the simplifier. - -The simplifier runs until we do not know how to simplify a pattern any more. A -pattern 'isSimplified' if re-applying the simplifier would return the same -pattern. - -Most patterns are assumed un-simplified until marked otherwise, so the -simplified status is reset by any substitution under the pattern. --} -data Simplified - = Simplified SimplifiedData - | NotSimplified - deriving stock (Eq, Ord, Show) - deriving stock (GHC.Generic) - deriving anyclass (Hashable, NFData) - deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) - deriving anyclass (Debug) - -instance Diff Simplified where - diffPrec = diffPrecIgnore - -instance Semigroup Simplified where - NotSimplified <> _ = NotSimplified - _ <> NotSimplified = NotSimplified - (Simplified_ t1 c1) <> (Simplified_ t2 c2) = - Simplified_ (t1 <> t2) (c1 <> c2) - -instance Monoid Simplified where - mempty = Simplified_ mempty mempty - -pattern Simplified_ :: Type -> Condition -> Simplified -pattern Simplified_ sType condition = - (Simplified SimplifiedData{sType, condition}) - -{-# COMPLETE Simplified_, NotSimplified #-} - -{- | Computes the 'Simplified' attribute for a pattern given its default -attribute (usually a merge of the pattern's subterm simplification attributes) -and the desired one. - -As an example, let us assume that the default attribute is -@Simplified (Partly, Condition c)@ and that we would want the attribute to be -@Simplified (Fully, Any)@. - -Then let us notice that the term needs the condition @c@ (most likely because -one of its subterms is simplified only with it as a side condition), and that -the term and its subterms went through the simplifier (the 'Partly' tag), so -it's valid to mark it as fully simplified. The result will be -"Simplified (Fully, Condition c)". --} -simplifiedTo :: - HasCallStack => - -- | Default value - Simplified -> - -- | Desired state - Simplified -> - Simplified -NotSimplified `simplifiedTo` NotSimplified = NotSimplified -_ `simplifiedTo` NotSimplified = - error "Should not make sense to upgrade something else to NotSimplified." -NotSimplified `simplifiedTo` _ = - error "Cannot upgrade NotSimplified to something else." -Simplified_ _ _ `simplifiedTo` s@(Simplified_ Fully Unknown) = s -Simplified_ _ Unknown `simplifiedTo` Simplified_ Fully _ = - Simplified_ Fully Unknown -Simplified_ _ (Condition c1) `simplifiedTo` s@(Simplified_ Fully (Condition c2)) = - if c1 == c2 - then s - else Simplified_ Fully Unknown -Simplified_ _ Any `simplifiedTo` s@(Simplified_ Fully (Condition _)) = s -Simplified_ _ c@(Condition _) `simplifiedTo` Simplified_ Fully Any = - Simplified_ Fully c -Simplified_ _ Any `simplifiedTo` s@(Simplified_ Fully Any) = s -s1@(Simplified_ _ _) `simplifiedTo` s2@(Simplified_ Partly _) = s1 <> s2 - -{- | Is the pattern fully simplified under the given side condition? - -See also: 'isSimplifiedAnyCondition', 'isSimplifiedSomeCondition'. --} -isSimplified :: SideCondition.Representation -> Simplified -> Bool -isSimplified _ (Simplified_ Fully Any) = True -isSimplified currentCondition (Simplified_ Fully (Condition condition)) = - currentCondition == condition -isSimplified _ (Simplified_ Fully Unknown) = False -isSimplified _ (Simplified_ Partly _) = False -isSimplified _ NotSimplified = False - -{- | Is the pattern fully simplified under any side condition? - -See also: 'isSimplified', 'isSimplifiedSomeCondition'. --} -isSimplifiedAnyCondition :: Simplified -> Bool -isSimplifiedAnyCondition (Simplified_ Fully Any) = True -isSimplifiedAnyCondition (Simplified_ Fully (Condition _)) = False -isSimplifiedAnyCondition (Simplified_ Fully Unknown) = False -isSimplifiedAnyCondition (Simplified_ Partly _) = False -isSimplifiedAnyCondition NotSimplified = False - -{- | Is the pattern fully simplified under some side condition? - -See also: 'isSimplified', 'isSimplifiedAnyCondition'. --} -isSimplifiedSomeCondition :: Simplified -> Bool -isSimplifiedSomeCondition (Simplified_ Fully _) = True -isSimplifiedSomeCondition _ = False - -fullySimplified :: Simplified -fullySimplified = Simplified_ Fully Any - -simplifiedConditionally :: SideCondition.Representation -> Simplified -simplifiedConditionally c = Simplified_ Fully (Condition c) - -simplifiableConditionally :: SideCondition.Representation -> Simplified -simplifiableConditionally c = Simplified_ Partly (Condition c) - -alwaysSimplified :: a -> Simplified -alwaysSimplified = const fullySimplified -{-# INLINE alwaysSimplified #-} - -notSimplified :: Foldable a => a Simplified -> Simplified -notSimplified a - | null a = NotSimplified - | otherwise = fold a <> Simplified_ Partly Any -{-# INLINE notSimplified #-} - -{- | Provides a short and incomplete textual description of a 'Simplified' -object, suitable for use as an explanatory comment when unparsing patterns. - -There is no tag for "NotSimplified", since that's the default state. - -Otherwise, the tag starts with a prefix that should be unique among all -attributes that have tags in order to prevent confusion ("S"), followed -by short representations of the 'Type' and 'Condition'. --} -unparseTag :: Simplified -> Maybe Text -unparseTag (Simplified_ ty condition) = - Just $ "S" <> typeRepresentation ty <> conditionRepresentation condition - where - typeRepresentation Fully = "f" - typeRepresentation Partly = "p" - - conditionRepresentation Any = "a" - conditionRepresentation (Condition _) = "c" - conditionRepresentation Unknown = "u" -unparseTag NotSimplified = Nothing - -instance Synthetic Simplified (Bottom sort) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Top sort) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Const StringLiteral) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Const InternalBytes) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Const (SomeVariable variable)) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Exists sort variable) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Forall sort variable) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (And sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Or sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Not sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Application head) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Ceil sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Floor sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (DomainValue sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Equals sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (In sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Implies sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Iff sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Mu variable) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Nu variable) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Next sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified (Rewrites sort) where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified Inhabitant where - synthetic = notSimplified - {-# INLINE synthetic #-} - -instance Synthetic Simplified Inj where - synthetic = synthetic . Inj.toApplication - {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Attribute/PredicatePattern.hs b/kore/src/Kore/Attribute/PredicatePattern.hs index e1da464895..771da4cba4 100644 --- a/kore/src/Kore/Attribute/PredicatePattern.hs +++ b/kore/src/Kore/Attribute/PredicatePattern.hs @@ -6,12 +6,6 @@ License : BSD-3-Clause -} module Kore.Attribute.PredicatePattern ( PredicatePattern (PredicatePattern, freeVariables), - -- simplified is excluded on purpose - simplifiedAttribute, - isSimplified, - isSimplifiedAnyCondition, - isSimplifiedSomeCondition, - setSimplified, mapVariables, traverseVariables, deleteFreeVariable, @@ -30,28 +24,14 @@ import Kore.Attribute.Pattern.FreeVariables hiding ( import qualified Kore.Attribute.Pattern.FreeVariables as FreeVariables ( freeVariables, ) -import Kore.Attribute.Pattern.Simplified hiding ( - isSimplified, - isSimplifiedAnyCondition, - isSimplifiedSomeCondition, - ) -import qualified Kore.Attribute.Pattern.Simplified as Simplified ( - isSimplified, - isSimplifiedAnyCondition, - isSimplifiedSomeCondition, - ) import Kore.Attribute.Synthetic import Kore.Debug -import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( - Representation, - ) import Kore.Syntax.Variable import Prelude.Kore -- | @Pattern@ are the attributes of a pattern collected during verification. -data PredicatePattern variable = PredicatePattern - { freeVariables :: !(FreeVariables variable) - , simplified :: !Simplified +newtype PredicatePattern variable = PredicatePattern + { freeVariables :: FreeVariables variable } deriving stock (Eq, GHC.Generic, Show) @@ -71,45 +51,14 @@ instance (Debug variable, Diff variable) => Diff (PredicatePattern variable) instance ( Functor base , Synthetic (FreeVariables variable) base - , Synthetic Simplified base ) => Synthetic (PredicatePattern variable) base where synthetic base = PredicatePattern { freeVariables = synthetic (freeVariables <$> base) - , simplified = synthetic (simplified <$> base) } -simplifiedAttribute :: PredicatePattern variable -> Simplified -simplifiedAttribute PredicatePattern{simplified} = simplified - -{- Checks whether the pattern is simplified relative to the given side -condition. --} -isSimplified :: - SideCondition.Representation -> PredicatePattern variable -> Bool -isSimplified sideCondition = Simplified.isSimplified sideCondition . simplifiedAttribute - -{- Checks whether the pattern is simplified relative to some side condition. --} -isSimplifiedSomeCondition :: - PredicatePattern variable -> Bool -isSimplifiedSomeCondition = - Simplified.isSimplifiedSomeCondition . simplifiedAttribute - -{- Checks whether the pattern is simplified relative to any side condition. --} -isSimplifiedAnyCondition :: PredicatePattern variable -> Bool -isSimplifiedAnyCondition PredicatePattern{simplified} = - Simplified.isSimplifiedAnyCondition simplified - -setSimplified :: - Simplified -> - PredicatePattern variable -> - PredicatePattern variable -setSimplified simplified patt = patt{simplified} - {- | Use the provided mapping to replace all variables in a 'Pattern'. See also: 'traverseVariables' diff --git a/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs b/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs index 1c43c314b1..c76e7bf42b 100644 --- a/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs +++ b/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs @@ -96,10 +96,6 @@ newSetCeilSimplifier = mkInternalAc (fromElement element){opaque = [termLike]} & TermLike.mkInternalSet & makeCeilPredicate - -- TODO (thomas.tuegel): Do not mark this simplified. - -- Marking here may prevent user-defined axioms from applying. - -- At present, we wouldn't apply such an axiom, anyway. - & Predicate.markSimplifiedMaybeConditional Nothing runCeilSimplifier ( newBuiltinAssocCommCeilSimplifier TermLike.mkInternalSet @@ -123,10 +119,6 @@ newMapCeilSimplifier = mkInternalAc (fromElement element'){opaque = [termLike]} & TermLike.mkInternalMap & makeCeilPredicate - -- TODO (thomas.tuegel): Do not mark this simplified. - -- Marking here may prevent user-defined axioms from applying. - -- At present, we wouldn't apply such an axiom, anyway. - & Predicate.markSimplifiedMaybeConditional Nothing & makeForallPredicate variable where (variable, element') = @@ -316,10 +308,6 @@ definePairWiseElements mkBuiltin mkNotMember internalAc pairWiseElements = do } & mkBuiltin & makeCeilPredicate - -- TODO (thomas.tuegel): Do not mark this simplified. - -- Marking here may prevent user-defined axioms from applying. - -- At present, we wouldn't apply such an axiom, anyway. - & Predicate.markSimplifiedMaybeConditional Nothing & OrCondition.fromPredicate & MultiAnd.singleton diff --git a/kore/src/Kore/Builtin/AssociativeCommutative.hs b/kore/src/Kore/Builtin/AssociativeCommutative.hs index 38c74b6201..7e85ceac37 100644 --- a/kore/src/Kore/Builtin/AssociativeCommutative.hs +++ b/kore/src/Kore/Builtin/AssociativeCommutative.hs @@ -58,9 +58,6 @@ import qualified Data.Reflection as Reflection import Data.Text (Text) import qualified GHC.Generics as GHC import qualified Generics.SOP as SOP -import qualified Kore.Attribute.Pattern.Simplified as Attribute ( - Simplified, - ) import qualified Kore.Attribute.Symbol as Attribute ( Symbol, ) @@ -178,9 +175,6 @@ class TermLike variable -> Maybe (normalized Key (TermLike variable)) - simplifiedAttributeValue :: - Value normalized (TermLike variable) -> Attribute.Simplified - instance TermWrapper NormalizedMap where asInternalBuiltin tools builtinAcSort builtinAcChild = InternalAc @@ -235,8 +229,6 @@ instance TermWrapper NormalizedMap where , opaque = [patt] } - simplifiedAttributeValue = TermLike.simplifiedAttribute . getMapValue - instance TermWrapper NormalizedSet where asInternalBuiltin tools builtinAcSort builtinAcChild = InternalAc @@ -286,8 +278,6 @@ instance TermWrapper NormalizedSet where (Normalized . wrapAc) emptyNormalizedAc{opaque = [patt]} - simplifiedAttributeValue SetValue = mempty - {- | Wrapper for terms that keeps the "concrete" vs "with variable" distinction after converting @TermLike Concrete@ to @TermLike variable@. -} @@ -730,24 +720,7 @@ unifyEqualsNormalized renormalized <- normalize1 normalizedTerm let unifierTerm :: TermLike RewritingVariableName - unifierTerm = markSimplified $ asInternal tools sort1 renormalized - - markSimplified = - TermLike.setSimplified - ( foldMap TermLike.simplifiedAttribute opaque - <> foldMap TermLike.simplifiedAttribute abstractKeys - <> foldMap simplifiedAttributeValue abstractValues - <> foldMap simplifiedAttributeValue concreteValues - ) - where - unwrapped = unwrapAc renormalized - NormalizedAc{opaque} = unwrapped - (abstractKeys, abstractValues) = - (unzip . map unwrapElement) - (elementsWithVariables unwrapped) - (_, concreteValues) = - (unzip . HashMap.toList) - (concreteElements unwrapped) + unifierTerm = asInternal tools sort1 renormalized return (unifierTerm `Pattern.withCondition` unifierCondition) where diff --git a/kore/src/Kore/Builtin/Bool/Bool.hs b/kore/src/Kore/Builtin/Bool/Bool.hs index 86d5274239..4769cff551 100644 --- a/kore/src/Kore/Builtin/Bool/Bool.hs +++ b/kore/src/Kore/Builtin/Bool/Bool.hs @@ -39,9 +39,6 @@ import Kore.Internal.TermLike ( TermLike, mkInternalBool, ) -import qualified Kore.Internal.TermLike as TermLike ( - markSimplified, - ) import Prelude.Kore -- | Builtin name of the @Bool@ sort. @@ -63,7 +60,7 @@ asInternal :: Bool -> TermLike variable asInternal builtinBoolSort builtinBoolValue = - TermLike.markSimplified . mkInternalBool $ + mkInternalBool $ asBuiltin builtinBoolSort builtinBoolValue asBuiltin :: diff --git a/kore/src/Kore/Builtin/Endianness/Endianness.hs b/kore/src/Kore/Builtin/Endianness/Endianness.hs index 63a5b312cd..b40a582515 100644 --- a/kore/src/Kore/Builtin/Endianness/Endianness.hs +++ b/kore/src/Kore/Builtin/Endianness/Endianness.hs @@ -20,7 +20,6 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Internal.Symbol import Kore.Sort @@ -72,10 +71,6 @@ instance Synthetic Defined (Const Endianness) where synthetic = const (Defined True) {-# INLINE synthetic #-} -instance Synthetic Simplified (Const Endianness) where - synthetic = const fullySimplified - {-# INLINE synthetic #-} - instance Synthetic ConstructorLike (Const Endianness) where synthetic = -- Endianness symbols are constructors diff --git a/kore/src/Kore/Builtin/Int/Int.hs b/kore/src/Kore/Builtin/Int/Int.hs index 8a28485967..e76c190005 100644 --- a/kore/src/Kore/Builtin/Int/Int.hs +++ b/kore/src/Kore/Builtin/Int/Int.hs @@ -72,7 +72,7 @@ asInternal :: Integer -> TermLike variable asInternal builtinIntSort builtinIntValue = - TermLike.fromConcrete . TermLike.markSimplified . mkInternalInt $ + TermLike.fromConcrete . mkInternalInt $ asBuiltin builtinIntSort builtinIntValue asBuiltin :: diff --git a/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs b/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs index 39bddce699..2431a6ef2f 100644 --- a/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs +++ b/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs @@ -51,7 +51,6 @@ import Kore.Internal.TermLike ( mkInternalBytes, ) import qualified Kore.Internal.TermLike as TermLike ( - markSimplified, pattern App_, pattern StringLiteral_, ) @@ -76,7 +75,7 @@ asInternal :: ByteString -> TermLike variable asInternal bytesSort bytesValue = - TermLike.markSimplified $ mkInternalBytes bytesSort bytesValue + mkInternalBytes bytesSort bytesValue internalize :: InternalVariable variable => diff --git a/kore/src/Kore/Builtin/List.hs b/kore/src/Kore/Builtin/List.hs index deada77daf..b9e7401c34 100644 --- a/kore/src/Kore/Builtin/List.hs +++ b/kore/src/Kore/Builtin/List.hs @@ -98,7 +98,6 @@ import Kore.Internal.TermLike ( import qualified Kore.Internal.TermLike as TermLike ( Symbol (..), isFunctionPattern, - markSimplified, ) import Kore.Log.DebugUnifyBottom ( debugUnifyBottom, @@ -478,9 +477,8 @@ unifyEquals unified <- sequence $ Seq.zipWith simplifyChild list1 list2 let propagatedUnified = propagateConditions unified result = - TermLike.markSimplified - . asInternal tools internalListSort - <$> propagatedUnified + asInternal tools internalListSort + <$> propagatedUnified return result where InternalList{internalListSort} = builtin1 @@ -507,7 +505,7 @@ unifyEquals internal2 suffixUnified <- simplifyChild frame2 listSuffix1 let result = - TermLike.markSimplified (mkInternalList internal1) + mkInternalList internal1 <$ prefixUnified <* suffixUnified return result @@ -583,7 +581,7 @@ unifyEquals frame1 suffix2Frame2 let result = - TermLike.markSimplified initial + initial <$ prefixUnified <* suffixUnified return result @@ -592,7 +590,7 @@ unifyEquals unifyEqualsConcrete internal1 internal2 suffixUnified <- simplifyChild frame1 frame2 let result = - TermLike.markSimplified initial + initial <$ prefixUnified <* suffixUnified return result @@ -630,13 +628,13 @@ unifyEquals internal1 internal2{internalListChild = suffix2} let result = - TermLike.markSimplified initial <$ prefixUnified <* suffixUnified + initial <$ prefixUnified <* suffixUnified return result | length1 == length2 = do prefixUnified <- simplifyChild frame1 frame2 suffixUnified <- unifyEqualsConcrete internal1 internal2 let result = - TermLike.markSimplified initial + initial <$ prefixUnified <* suffixUnified return result diff --git a/kore/src/Kore/Builtin/Signedness/Signedness.hs b/kore/src/Kore/Builtin/Signedness/Signedness.hs index 9c8680f1aa..5c3a402c80 100644 --- a/kore/src/Kore/Builtin/Signedness/Signedness.hs +++ b/kore/src/Kore/Builtin/Signedness/Signedness.hs @@ -20,7 +20,6 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Internal.Symbol import Kore.Sort @@ -63,10 +62,6 @@ instance Synthetic Defined (Const Signedness) where synthetic = const (Defined True) {-# INLINE synthetic #-} -instance Synthetic Simplified (Const Signedness) where - synthetic = const fullySimplified - {-# INLINE synthetic #-} - instance Synthetic ConstructorLike (Const Signedness) where synthetic = -- Signedness symbols are constructors diff --git a/kore/src/Kore/Equation/Application.hs b/kore/src/Kore/Equation/Application.hs index 9f29b482a1..94fef5edee 100644 --- a/kore/src/Kore/Equation/Application.hs +++ b/kore/src/Kore/Equation/Application.hs @@ -399,9 +399,7 @@ checkRequires sideCondition predicate requires = -- Pair a configuration with sideCondition for evaluation by the solver. withSideCondition = (,) sideCondition - withoutAxioms = - fmap Condition.forgetSimplified - . Simplifier.localSimplifierAxioms (const mempty) + withoutAxioms = Simplifier.localSimplifierAxioms (const mempty) withAxioms = id refreshVariables :: diff --git a/kore/src/Kore/Equation/Simplification.hs b/kore/src/Kore/Equation/Simplification.hs index 622ba404df..221a87e786 100644 --- a/kore/src/Kore/Equation/Simplification.hs +++ b/kore/src/Kore/Equation/Simplification.hs @@ -84,12 +84,12 @@ simplifyEquation equation@(Equation _ _ _ _ _ _ _) = ensures' = substitute subst ensures return Equation - { left = TermLike.forgetSimplified left' - , requires = Predicate.forgetSimplified requires' + { left = left' + , requires = requires' , argument = Nothing - , antiLeft = Predicate.forgetSimplified <$> antiLeft' - , right = TermLike.forgetSimplified right' - , ensures = Predicate.forgetSimplified ensures' + , antiLeft = antiLeft' + , right = right' + , ensures = ensures' , attributes = attributes } & Logic.observeAllT diff --git a/kore/src/Kore/Internal/Condition.hs b/kore/src/Kore/Internal/Condition.hs index 04223f0aff..7da7f20659 100644 --- a/kore/src/Kore/Internal/Condition.hs +++ b/kore/src/Kore/Internal/Condition.hs @@ -4,13 +4,6 @@ License : BSD-3-Clause -} module Kore.Internal.Condition ( Condition, - isSimplified, - simplifiedAttribute, - forgetSimplified, - markSimplified, - Conditional.markPredicateSimplified, - Conditional.markPredicateSimplifiedConditional, - Conditional.setPredicateSimplified, eraseConditionalTerm, top, bottom, @@ -36,9 +29,6 @@ import Kore.Attribute.Pattern.FreeVariables ( freeVariables, isFreeVariable, ) -import qualified Kore.Attribute.Pattern.Simplified as Attribute ( - Simplified, - ) import Kore.Internal.Conditional ( Condition, Conditional (..), @@ -48,52 +38,14 @@ import Kore.Internal.Predicate ( Predicate, ) import qualified Kore.Internal.Predicate as Predicate -import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( - Representation, - ) import Kore.Internal.Substitution ( Normalization (..), ) import qualified Kore.Internal.Substitution as Substitution -import qualified Kore.Internal.TermLike as TermLike ( - simplifiedAttribute, - ) import Kore.Internal.Variable import Kore.Syntax import Prelude.Kore -isSimplified :: SideCondition.Representation -> Condition variable -> Bool -isSimplified sideCondition Conditional{term = (), predicate, substitution} = - Predicate.isSimplified sideCondition predicate - && Substitution.isSimplified sideCondition substitution - -simplifiedAttribute :: Condition variable -> Attribute.Simplified -simplifiedAttribute Conditional{term = (), predicate, substitution} = - Predicate.simplifiedAttribute predicate - <> Substitution.simplifiedAttribute substitution - -forgetSimplified :: - InternalVariable variable => - Condition variable -> - Condition variable -forgetSimplified Conditional{term = (), predicate, substitution} = - Conditional - { term = () - , predicate = Predicate.forgetSimplified predicate - , substitution = Substitution.forgetSimplified substitution - } - -markSimplified :: - InternalVariable variable => - Condition variable -> - Condition variable -markSimplified Conditional{term = (), predicate, substitution} = - Conditional - { term = () - , predicate = Predicate.markSimplified predicate - , substitution = Substitution.markSimplified substitution - } - -- | Erase the @Conditional@ 'term' to yield a 'Condition'. eraseConditionalTerm :: Conditional variable child -> @@ -171,16 +123,8 @@ fromNormalizationSimplified where predicate' = Conditional.fromPredicate - . markSimplifiedIfChildrenSimplified denormalized . Substitution.toPredicate $ Substitution.wrap denormalized substitution' = Conditional.fromSubstitution $ Substitution.unsafeWrapFromAssignments normalized - markSimplifiedIfChildrenSimplified childrenList result = - Predicate.setSimplified childrenSimplified result - where - childrenSimplified = - foldMap - (TermLike.simplifiedAttribute . Substitution.assignedTerm) - childrenList diff --git a/kore/src/Kore/Internal/Conditional.hs b/kore/src/Kore/Internal/Conditional.hs index 2a25e55fa5..50ced781c3 100644 --- a/kore/src/Kore/Internal/Conditional.hs +++ b/kore/src/Kore/Internal/Conditional.hs @@ -20,9 +20,6 @@ module Kore.Internal.Conditional ( Kore.Internal.Conditional.mapVariables, isNormalized, assertNormalized, - markPredicateSimplified, - markPredicateSimplifiedConditional, - setPredicateSimplified, ) where import Data.Map.Strict ( @@ -33,9 +30,6 @@ import qualified Generics.SOP as SOP import Kore.Attribute.Pattern.FreeVariables ( HasFreeVariables (..), ) -import qualified Kore.Attribute.Pattern.Simplified as Attribute ( - Simplified, - ) import Kore.Debug import Kore.Internal.MultiAnd ( MultiAnd, @@ -512,44 +506,3 @@ assertNormalized Conditional{predicate, substitution} a = & assert (Predicate.isFreeOf predicate variables) where variables = Substitution.variables substitution - -{- | Marks the condition's predicate as being simplified. - -Since the substitution is usually simplified, this usually marks the entire -condition as simplified. Note however, that the way in which the condition -is simplified is a combination of the predicate and substitution -simplifications. As an example, if the predicate is fully simplified, -while the substitution is simplified only for a certain side condition, -the entire condition is simplified only for that side condition. --} -markPredicateSimplified :: - (HasCallStack, InternalVariable variable) => - Conditional variable term -> - Conditional variable term -markPredicateSimplified conditional@Conditional{predicate} = - conditional{predicate = Predicate.markSimplified predicate} - -markPredicateSimplifiedConditional :: - (HasCallStack, InternalVariable variable) => - SideCondition.Representation -> - Conditional variable term -> - Conditional variable term -markPredicateSimplifiedConditional - sideCondition - conditional@Conditional{predicate} = - conditional - { predicate = - Predicate.markSimplifiedConditional sideCondition predicate - } - -{- | Sets the simplified attribute for a condition's predicate. - -See 'markPredicateSimplified' for details. --} -setPredicateSimplified :: - (InternalVariable variable) => - Attribute.Simplified -> - Conditional variable term -> - Conditional variable term -setPredicateSimplified simplified conditional@Conditional{predicate} = - conditional{predicate = Predicate.setSimplified simplified predicate} diff --git a/kore/src/Kore/Internal/InternalBool.hs b/kore/src/Kore/Internal/InternalBool.hs index 2a00b4745d..937d059544 100644 --- a/kore/src/Kore/Internal/InternalBool.hs +++ b/kore/src/Kore/Internal/InternalBool.hs @@ -14,7 +14,6 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Sort @@ -75,7 +74,3 @@ instance Synthetic Function (Const InternalBool) where instance Synthetic Functional (Const InternalBool) where synthetic = alwaysFunctional {-# INLINE synthetic #-} - -instance Synthetic Simplified (Const InternalBool) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/InternalInt.hs b/kore/src/Kore/Internal/InternalInt.hs index 71bf967eeb..ca7f03aa71 100644 --- a/kore/src/Kore/Internal/InternalInt.hs +++ b/kore/src/Kore/Internal/InternalInt.hs @@ -14,7 +14,6 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Sort @@ -62,7 +61,3 @@ instance Synthetic Function (Const InternalInt) where instance Synthetic Functional (Const InternalInt) where synthetic = alwaysFunctional {-# INLINE synthetic #-} - -instance Synthetic Simplified (Const InternalInt) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/InternalList.hs b/kore/src/Kore/Internal/InternalList.hs index b0dd72c084..e5d2c6950a 100644 --- a/kore/src/Kore/Internal/InternalList.hs +++ b/kore/src/Kore/Internal/InternalList.hs @@ -18,7 +18,6 @@ import Kore.Attribute.Pattern.FreeVariables ( ) import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Internal.Symbol ( @@ -108,7 +107,3 @@ instance Synthetic Function InternalList where instance Synthetic Functional InternalList where synthetic = fold {-# INLINE synthetic #-} - -instance Synthetic Simplified InternalList where - synthetic = notSimplified - {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/InternalMap.hs b/kore/src/Kore/Internal/InternalMap.hs index 47c88bf473..27a654851c 100644 --- a/kore/src/Kore/Internal/InternalMap.hs +++ b/kore/src/Kore/Internal/InternalMap.hs @@ -24,7 +24,6 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Internal.NormalizedAc @@ -124,10 +123,6 @@ instance Synthetic Sort (InternalMap key) where synthetic = builtinAcSort {-# INLINE synthetic #-} -instance Synthetic Simplified (InternalMap key) where - synthetic = notSimplified - {-# INLINE synthetic #-} - instance HasConstructorLike (Value NormalizedMap ConstructorLike) where extractConstructorLike (MapValue result) = result diff --git a/kore/src/Kore/Internal/InternalSet.hs b/kore/src/Kore/Internal/InternalSet.hs index def12d6815..f5f3bcea2e 100644 --- a/kore/src/Kore/Internal/InternalSet.hs +++ b/kore/src/Kore/Internal/InternalSet.hs @@ -25,7 +25,6 @@ import Kore.Attribute.Pattern.FreeVariables hiding ( ) import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Internal.NormalizedAc @@ -133,10 +132,6 @@ instance Synthetic Functional (InternalAc key NormalizedSet) where normalizedAcFunctional builtinSetChild {-# INLINE synthetic #-} -instance Synthetic Simplified (InternalAc key NormalizedSet) where - synthetic = notSimplified - {-# INLINE synthetic #-} - instance HasConstructorLike (Value NormalizedSet ConstructorLike) where extractConstructorLike SetValue = ConstructorLike . Just $ ConstructorLikeHead diff --git a/kore/src/Kore/Internal/InternalString.hs b/kore/src/Kore/Internal/InternalString.hs index 606eb4ebb7..1fffc478e7 100644 --- a/kore/src/Kore/Internal/InternalString.hs +++ b/kore/src/Kore/Internal/InternalString.hs @@ -17,7 +17,6 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional -import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Sort @@ -71,7 +70,3 @@ instance Synthetic Function (Const InternalString) where instance Synthetic Functional (Const InternalString) where synthetic = alwaysFunctional {-# INLINE synthetic #-} - -instance Synthetic Simplified (Const InternalString) where - synthetic = alwaysSimplified - {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/OrCondition.hs b/kore/src/Kore/Internal/OrCondition.hs index 4dc2151368..4eb8b5fcea 100644 --- a/kore/src/Kore/Internal/OrCondition.hs +++ b/kore/src/Kore/Internal/OrCondition.hs @@ -4,7 +4,6 @@ License : BSD-3-Clause -} module Kore.Internal.OrCondition ( OrCondition, - isSimplified, toConditions, fromConditions, fromCondition, @@ -45,9 +44,6 @@ import Prelude.Kore -- | The disjunction of 'Condition'. type OrCondition variable = MultiOr (Condition variable) -isSimplified :: SideCondition.Representation -> OrCondition variable -> Bool -isSimplified sideCondition = all (Condition.isSimplified sideCondition) - -- | A "disjunction" of one 'Condition'. fromCondition :: Condition variable -> OrCondition variable fromCondition = from diff --git a/kore/src/Kore/Internal/OrPattern.hs b/kore/src/Kore/Internal/OrPattern.hs index 854b903850..eb7cc6bce3 100644 --- a/kore/src/Kore/Internal/OrPattern.hs +++ b/kore/src/Kore/Internal/OrPattern.hs @@ -5,12 +5,6 @@ License : BSD-3-Clause module Kore.Internal.OrPattern ( OrPattern, coerceSort, - markSimplified, - markTermSimplifiedConditionally, - isSimplified, - hasSimplifiedChildren, - hasSimplifiedChildrenIgnoreConditions, - forgetSimplified, fromPatterns, toPatterns, fromPattern, @@ -82,51 +76,6 @@ import Prelude.Kore -- | The disjunction of 'Pattern'. type OrPattern variable = MultiOr (Pattern variable) -markSimplified :: - InternalVariable variable => - OrPattern variable -> - OrPattern variable -markSimplified = MultiOr.map Pattern.markSimplified - -markTermSimplifiedConditionally :: - InternalVariable variable => - SideCondition.Representation -> - OrPattern variable -> - OrPattern variable -markTermSimplifiedConditionally repr = - MultiOr.map (Pattern.markTermSimplifiedConditionally repr) - -isSimplified :: SideCondition.Representation -> OrPattern variable -> Bool -isSimplified sideCondition = all (Pattern.isSimplified sideCondition) - -{- | Checks whether all patterns in the disjunction have simplified children. - -See also: 'Pattern.hasSimplifiedChildren' --} -hasSimplifiedChildren :: - InternalVariable variable => - SideCondition.Representation -> - OrPattern variable -> - Bool -hasSimplifiedChildren sideCondition = - all (Pattern.hasSimplifiedChildren sideCondition) - -{- | Checks whether all patterns in the disjunction have simplified children, -ignoring the conditions used to simplify them. - -See also: 'Pattern.hasSimplifiedChildrenIgnoreConditions' --} -hasSimplifiedChildrenIgnoreConditions :: - InternalVariable variable => - OrPattern variable -> - Bool -hasSimplifiedChildrenIgnoreConditions = - all Pattern.hasSimplifiedChildrenIgnoreConditions - -forgetSimplified :: - InternalVariable variable => OrPattern variable -> OrPattern variable -forgetSimplified = fromPatterns . map Pattern.forgetSimplified . toPatterns - -- | A "disjunction" of one 'Pattern.Pattern'. fromPattern :: Pattern variable -> OrPattern variable fromPattern = from diff --git a/kore/src/Kore/Internal/Pattern.hs b/kore/src/Kore/Internal/Pattern.hs index 142496b141..752377fdd0 100644 --- a/kore/src/Kore/Internal/Pattern.hs +++ b/kore/src/Kore/Internal/Pattern.hs @@ -24,13 +24,6 @@ module Kore.Internal.Pattern ( topOf, fromTermLike, Kore.Internal.Pattern.freeElementVariables, - isSimplified, - hasSimplifiedChildren, - hasSimplifiedChildrenIgnoreConditions, - forgetSimplified, - markSimplified, - markTermSimplifiedConditionally, - simplifiedAttribute, assign, requireDefined, fromMultiAnd, @@ -49,9 +42,6 @@ import Kore.Attribute.Pattern.FreeVariables ( freeVariables, getFreeElementVariables, ) -import qualified Kore.Attribute.Pattern.Simplified as Attribute ( - Simplified, - ) import Kore.Internal.Condition ( Condition, ) @@ -123,79 +113,6 @@ fromPredicateSorted :: Predicate variable -> Pattern variable fromPredicateSorted sort = fromCondition sort . Condition.fromPredicate -isSimplified :: SideCondition.Representation -> Pattern variable -> Bool -isSimplified sideCondition (splitTerm -> (t, p)) = - TermLike.isSimplified sideCondition t - && Condition.isSimplified sideCondition p - -{- | Checks whether the conjunction a 'Pattern' has simplified children. -A 'Pattern' is a conjunction at the top level: -@ -\\and{S}('term', \\and{S}('predicate', 'substitution')) -@ -where 'predicate' itself is generally a conjunction of many clauses. The -children of the 'Pattern' are considered simplified if the 'term' and -'substitution' are simplified and the individual clauses of the 'predicate' are -simplified. --} -hasSimplifiedChildren :: - Ord variable => - SideCondition.Representation -> - Pattern variable -> - Bool -hasSimplifiedChildren sideCondition patt = - TermLike.isSimplified sideCondition term - && all (Predicate.isSimplified sideCondition) clauses - && Substitution.isSimplified sideCondition substitution - where - Conditional{term, predicate, substitution} = patt - clauses = Predicate.toMultiAnd predicate - -{- | Similar to 'hasSimplifiedChildren', only that it ignores the conditions -used to simplify the children. --} -hasSimplifiedChildrenIgnoreConditions :: - Ord variable => - Pattern variable -> - Bool -hasSimplifiedChildrenIgnoreConditions patt = - TermLike.isSimplifiedSomeCondition term - && all Predicate.isSimplifiedSomeCondition clauses - && Substitution.isSimplifiedSomeCondition substitution - where - Conditional{term, predicate, substitution} = patt - clauses = Predicate.toMultiAnd predicate - -forgetSimplified :: - InternalVariable variable => Pattern variable -> Pattern variable -forgetSimplified patt = - TermLike.forgetSimplified term - `withCondition` Condition.forgetSimplified condition - where - (term, condition) = Conditional.splitTerm patt - -markSimplified :: - InternalVariable variable => Pattern variable -> Pattern variable -markSimplified patt = - TermLike.markSimplified term - `withCondition` Condition.markSimplified condition - where - (term, condition) = Conditional.splitTerm patt - -markTermSimplifiedConditionally :: - InternalVariable variable => - SideCondition.Representation -> - Pattern variable -> - Pattern variable -markTermSimplifiedConditionally repr patt = - TermLike.markSimplifiedConditional repr term - `withCondition` condition - where - (term, condition) = Conditional.splitTerm patt - -simplifiedAttribute :: Pattern variable -> Attribute.Simplified -simplifiedAttribute (splitTerm -> (t, p)) = - TermLike.simplifiedAttribute t <> Condition.simplifiedAttribute p freeElementVariables :: InternalVariable variable => diff --git a/kore/src/Kore/Internal/Predicate.hs b/kore/src/Kore/Internal/Predicate.hs index 79d911dee6..cd6008ed32 100644 --- a/kore/src/Kore/Internal/Predicate.hs +++ b/kore/src/Kore/Internal/Predicate.hs @@ -31,19 +31,11 @@ module Kore.Internal.Predicate ( getMultiOrPredicate, NotPredicate, isPredicate, - simplifiedAttribute, - isSimplified, - isSimplifiedSomeCondition, isFreeOf, freeElementVariables, hasFreeVariable, mapVariables, depth, - markSimplified, - markSimplifiedConditional, - markSimplifiedMaybeConditional, - setSimplified, - forgetSimplified, wrapPredicate, containsSymbolWithIdPred, refreshExists, @@ -93,7 +85,6 @@ import qualified Kore.Attribute.Pattern.FreeVariables as Attribute.FreeVariables toNames, toSet, ) -import qualified Kore.Attribute.Pattern.Simplified as Attribute import Kore.Attribute.PredicatePattern ( PredicatePattern, ) @@ -190,22 +181,6 @@ instance Ord variable => Synthetic (Attribute.FreeVariables variable) (Predicate OrF or' -> synthetic or' TopF top -> synthetic top -instance Synthetic Attribute.Simplified (PredicateF variable) where - synthetic = \case - AndF and' -> synthetic and' - BottomF bottom -> synthetic bottom - CeilF ceil -> synthetic (TermLike.simplifiedAttribute <$> ceil) - EqualsF equals -> synthetic (TermLike.simplifiedAttribute <$> equals) - ExistsF exists -> synthetic exists - FloorF floor' -> synthetic (TermLike.simplifiedAttribute <$> floor') - ForallF forall' -> synthetic forall' - IffF iff -> synthetic iff - ImpliesF implies -> synthetic implies - InF in' -> synthetic (TermLike.simplifiedAttribute <$> in') - NotF not' -> synthetic not' - OrF or' -> synthetic or' - TopF top -> synthetic top - instance From (Ceil () (TermLike variable)) (PredicateF variable child) where from = CeilF {-# INLINE from #-} @@ -574,22 +549,20 @@ fromPredicate :: fromPredicate sort = Recursive.fold worker where worker (pat :< predF) = - TermLike.setSimplified - (PredicatePattern.simplifiedAttribute pat) - $ case predF of - AndF (And () t1 t2) -> TermLike.mkAnd t1 t2 - BottomF _ -> TermLike.mkBottom sort - CeilF (Ceil () () t) -> TermLike.mkCeil sort t - EqualsF (Equals () () t1 t2) -> TermLike.mkEquals sort t1 t2 - ExistsF (Exists () v t) -> TermLike.mkExists v t - FloorF (Floor () () t) -> TermLike.mkFloor sort t - ForallF (Forall () v t) -> TermLike.mkForall v t - IffF (Iff () t1 t2) -> TermLike.mkIff t1 t2 - ImpliesF (Implies () t1 t2) -> TermLike.mkImplies t1 t2 - InF (In () () t1 t2) -> TermLike.mkIn sort t1 t2 - NotF (Not () t) -> TermLike.mkNot t - OrF (Or () t1 t2) -> TermLike.mkOr t1 t2 - TopF _ -> TermLike.mkTop sort + case predF of + AndF (And () t1 t2) -> TermLike.mkAnd t1 t2 + BottomF _ -> TermLike.mkBottom sort + CeilF (Ceil () () t) -> TermLike.mkCeil sort t + EqualsF (Equals () () t1 t2) -> TermLike.mkEquals sort t1 t2 + ExistsF (Exists () v t) -> TermLike.mkExists v t + FloorF (Floor () () t) -> TermLike.mkFloor sort t + ForallF (Forall () v t) -> TermLike.mkForall v t + IffF (Iff () t1 t2) -> TermLike.mkIff t1 t2 + ImpliesF (Implies () t1 t2) -> TermLike.mkImplies t1 t2 + InF (In () () t1 t2) -> TermLike.mkIn sort t1 t2 + NotF (Not () t) -> TermLike.mkNot t + OrF (Or () t1 t2) -> TermLike.mkOr t1 t2 + TopF _ -> TermLike.mkTop sort fromPredicate_ :: InternalVariable variable => @@ -991,7 +964,6 @@ makePredicate t = fst <$> makePredicateWorker t childChanged :: HasChanged childChanged = foldMap dropPredicate termWithChanged - oldSimplified = TermLike.attributeSimplifiedAttribute att (predicate, topChanged) <- case patE of TermLike.TopF _ -> return makeTruePredicate' TermLike.BottomF _ -> return makeFalsePredicate' @@ -1018,7 +990,7 @@ makePredicate t = fst <$> makePredicateWorker t return $ case topChanged <> childChanged of Changed -> (predicate, Changed) NotChanged -> - (setSimplified oldSimplified predicate, NotChanged) + (predicate, NotChanged) makePredicateTopDown :: TermLike variable -> @@ -1045,9 +1017,7 @@ makePredicate t = fst <$> makePredicateWorker t setSmp (p, NotChanged) = Left $ pure - (setSimplified oldSimplified p, NotChanged) - - oldSimplified = TermLike.attributeSimplifiedAttribute att + (p, NotChanged) isPredicate :: InternalVariable variable => TermLike variable -> Bool isPredicate = Either.isRight . makePredicate @@ -1058,149 +1028,6 @@ extractAttributes (Recursive.project -> attr :< _) = attr instance Attribute.HasFreeVariables (Predicate variable) variable where freeVariables = Attribute.freeVariables . extractAttributes -simplifiedAttribute :: Predicate variable -> Attribute.Simplified -simplifiedAttribute = PredicatePattern.simplifiedAttribute . extractAttributes - -{- | Is the 'Predicate' fully simplified under the given side condition? - -See also: 'isSimplifiedSomeCondition'. --} -isSimplified :: SideCondition.Representation -> Predicate variable -> Bool -isSimplified condition = PredicatePattern.isSimplified condition . extractAttributes - -{- | Is the 'Predicate' fully simplified under some side condition? - -See also: 'isSimplified'. --} -isSimplifiedSomeCondition :: Predicate variable -> Bool -isSimplifiedSomeCondition = - PredicatePattern.isSimplifiedSomeCondition . extractAttributes - -cannotSimplifyNotSimplifiedError :: - (HasCallStack, InternalVariable variable) => - PredicateF variable (Predicate variable) -> - a -cannotSimplifyNotSimplifiedError predF = - error - ( "Unexpectedly marking term with NotSimplified children as simplified:\n" - ++ show predF - ++ "\n" - ++ unparseToString term - ) - where - term = fromPredicate_ (synthesize predF) - -simplifiedFromChildren :: - HasCallStack => - PredicateF variable (Predicate variable) -> - Attribute.Simplified -simplifiedFromChildren predF = - case mergedSimplified of - Attribute.NotSimplified -> Attribute.NotSimplified - _ -> mergedSimplified `Attribute.simplifiedTo` Attribute.fullySimplified - where - mergedSimplified = case predF of - CeilF ceil' -> foldMap TermLike.simplifiedAttribute ceil' - FloorF floor' -> foldMap TermLike.simplifiedAttribute floor' - EqualsF equals' -> foldMap TermLike.simplifiedAttribute equals' - InF in' -> foldMap TermLike.simplifiedAttribute in' - _ -> foldMap simplifiedAttribute predF - -checkedSimplifiedFromChildren :: - (HasCallStack, InternalVariable variable) => - PredicateF variable (Predicate variable) -> - Attribute.Simplified -checkedSimplifiedFromChildren predF = - case simplifiedFromChildren predF of - Attribute.NotSimplified -> cannotSimplifyNotSimplifiedError predF - simplified -> simplified - -markSimplified :: - (HasCallStack, InternalVariable variable) => - Predicate variable -> - Predicate variable -markSimplified (Recursive.project -> attrs :< predF) = - Recursive.embed - ( PredicatePattern.setSimplified - (checkedSimplifiedFromChildren predF) - attrs - :< predF - ) - -markSimplifiedConditional :: - (HasCallStack, InternalVariable variable) => - SideCondition.Representation -> - Predicate variable -> - Predicate variable -markSimplifiedConditional - condition - (Recursive.project -> attrs :< predF) = - Recursive.embed - ( PredicatePattern.setSimplified - ( checkedSimplifiedFromChildren predF - <> Attribute.simplifiedConditionally condition - ) - attrs - :< predF - ) - -markSimplifiedMaybeConditional :: - (HasCallStack, InternalVariable variable) => - Maybe SideCondition.Representation -> - Predicate variable -> - Predicate variable -markSimplifiedMaybeConditional Nothing = markSimplified -markSimplifiedMaybeConditional (Just condition) = - markSimplifiedConditional condition - -setSimplified :: - (HasCallStack, InternalVariable variable) => - Attribute.Simplified -> - Predicate variable -> - Predicate variable -setSimplified - simplified - (Recursive.project -> attrs :< predF) = - Recursive.embed - ( PredicatePattern.setSimplified mergedSimplified attrs - :< predF - ) - where - childSimplified = simplifiedFromChildren predF - mergedSimplified = case (childSimplified, simplified) of - (Attribute.NotSimplified, Attribute.NotSimplified) -> - Attribute.NotSimplified - (Attribute.NotSimplified, _) -> - cannotSimplifyNotSimplifiedError predF - (_, Attribute.NotSimplified) -> - Attribute.NotSimplified - _ -> childSimplified <> simplified - -forgetSimplified :: - InternalVariable variable => - Predicate variable -> - Predicate variable -forgetSimplified = Recursive.fold worker - where - worker (_ :< predF) = case predF of - CeilF ceil' -> - synthesize $ - CeilF - (TermLike.forgetSimplified <$> ceil') - FloorF floor' -> - synthesize $ - FloorF - (TermLike.forgetSimplified <$> floor') - EqualsF equals' -> - synthesize $ - EqualsF - (TermLike.forgetSimplified <$> equals') - InF in' -> - synthesize $ - InF - (TermLike.forgetSimplified <$> in') - _ -> synthesize predF - mapVariables :: forall variable1 variable2. InternalVariable variable1 => diff --git a/kore/src/Kore/Internal/Substitution.hs b/kore/src/Kore/Internal/Substitution.hs index 705e297ab5..3e2cd53200 100644 --- a/kore/src/Kore/Internal/Substitution.hs +++ b/kore/src/Kore/Internal/Substitution.hs @@ -30,11 +30,6 @@ module Kore.Internal.Substitution ( mapTerms, mapAssignmentVariables, isNormalized, - isSimplified, - isSimplifiedSomeCondition, - forgetSimplified, - markSimplified, - simplifiedAttribute, null, variables, unsafeWrap, @@ -67,9 +62,6 @@ import ErrorContext import qualified GHC.Generics as GHC import qualified Generics.SOP as SOP import Kore.Attribute.Pattern.FreeVariables as FreeVariables -import qualified Kore.Attribute.Pattern.Simplified as Attribute ( - Simplified (..), - ) import Kore.Debug import Kore.Internal.Predicate ( Predicate, @@ -559,58 +551,6 @@ mapTerms mapper (Substitution s) = mapTerms mapper (NormalizedSubstitution s) = NormalizedSubstitution (fmap mapper s) -{- | Is the 'Substitution' fully simplified under the given side condition? - -See also: 'isSimplifiedSomeCondition'. --} -isSimplified :: SideCondition.Representation -> Substitution variable -> Bool -isSimplified _ (Substitution _) = False -isSimplified sideCondition (NormalizedSubstitution normalized) = - all (TermLike.isSimplified sideCondition) normalized - -{- | Is the 'Substitution' fully simplified under some side condition? - -See also: 'isSimplified'. --} -isSimplifiedSomeCondition :: Substitution variable -> Bool -isSimplifiedSomeCondition (Substitution _) = False -isSimplifiedSomeCondition (NormalizedSubstitution normalized) = - all TermLike.isSimplifiedSomeCondition normalized - -{- | Forget the 'simplifiedAttribute' associated with the 'Substitution'. - -@ -isSimplified (forgetSimplified _) == False -@ --} -forgetSimplified :: - InternalVariable variable => - Substitution variable -> - Substitution variable -forgetSimplified = - wrap - . fmap (mapAssignedTerm TermLike.forgetSimplified) - . unwrap - -{- | Mark a 'Substitution' as fully simplified at the current level. - -See 'Kore.Internal.TermLike.markSimplified'. --} -markSimplified :: - InternalVariable variable => - Substitution variable -> - Substitution variable -markSimplified = - wrap - . fmap (mapAssignedTerm TermLike.markSimplified) - . unwrap - -simplifiedAttribute :: - Substitution variable -> Attribute.Simplified -simplifiedAttribute (Substitution _) = Attribute.NotSimplified -simplifiedAttribute (NormalizedSubstitution normalized) = - foldMap TermLike.simplifiedAttribute normalized - -- | Returns true iff the substitution is normalized. isNormalized :: Substitution variable -> Bool isNormalized (Substitution _) = False diff --git a/kore/src/Kore/Internal/TermLike.hs b/kore/src/Kore/Internal/TermLike.hs index fcecd64f91..6cdb9988dc 100644 --- a/kore/src/Kore/Internal/TermLike.hs +++ b/kore/src/Kore/Internal/TermLike.hs @@ -9,18 +9,8 @@ module Kore.Internal.TermLike ( TermAttributes (..), TermLike (..), extractAttributes, - isSimplified, - isSimplifiedSomeCondition, Attribute.isConstructorLike, assertConstructorLikeKeys, - markSimplified, - markSimplifiedConditional, - markSimplifiedMaybeConditional, - setSimplified, - setAttributeSimplified, - forgetSimplified, - simplifiedAttribute, - attributeSimplifiedAttribute, isFunctionPattern, isFunctionalPattern, hasConstructorLikeTop, @@ -225,7 +215,6 @@ import qualified Kore.Attribute.Pattern.FreeVariables as Attribute.FreeVariables ) import qualified Kore.Attribute.Pattern.Function as Attribute import qualified Kore.Attribute.Pattern.Functional as Attribute -import qualified Kore.Attribute.Pattern.Simplified as Attribute import Kore.Attribute.Synthetic import Kore.Builtin.Endianness.Endianness ( Endianness, @@ -408,45 +397,6 @@ fromConcrete :: TermLike variable fromConcrete = mapVariables (pure $ from @Concrete) -{- | Is the 'TermLike' fully simplified under the given side condition? - -See also: 'isSimplifiedAnyCondition', 'isSimplifiedSomeCondition'. --} -isSimplified :: SideCondition.Representation -> TermLike variable -> Bool -isSimplified sideCondition = - isAttributeSimplified sideCondition . extractAttributes - -{- | Is the 'TermLike' fully simplified under any side condition? - -See also: 'isSimplified', 'isSimplifiedSomeCondition'. --} -isSimplifiedAnyCondition :: TermLike variable -> Bool -isSimplifiedAnyCondition = - isAttributeSimplifiedAnyCondition . extractAttributes - -{- | Is the 'TermLike' fully simplified under some side condition? - -See also: 'isSimplified', 'isSimplifiedAnyCondition'. --} -isSimplifiedSomeCondition :: TermLike variable -> Bool -isSimplifiedSomeCondition = - isAttributeSimplifiedSomeCondition . extractAttributes - -{- | Forget the 'simplifiedAttribute' associated with the 'TermLike'. - -@ -isSimplified (forgetSimplified _) == False -@ --} -forgetSimplified :: - InternalVariable variable => - TermLike variable -> - TermLike variable -forgetSimplified = resynthesize - -simplifiedAttribute :: TermLike variable -> Attribute.Simplified -simplifiedAttribute = attributeSimplifiedAttribute . extractAttributes - assertConstructorLikeKeys :: HasCallStack => InternalVariable variable => @@ -466,126 +416,8 @@ assertConstructorLikeKeys keys a , Pretty.indent 2 "Non-constructor-like patterns:" ] <> fmap (Pretty.indent 4 . unparse) simplifiableKeys - | any (not . isSimplifiedAnyCondition) keys = - let simplifiableKeys = - filter (not . isSimplifiedAnyCondition) $ Prelude.Kore.toList keys - in (error . show . Pretty.vsep) $ - [ "Internal error: expected fully simplified patterns,\ - \ an internal invariant has been violated.\ - \ Please report this error." - , Pretty.indent 2 "Unsimplified patterns:" - ] - <> fmap (Pretty.indent 4 . unparse) simplifiableKeys | otherwise = a -{- | Mark a 'TermLike' as fully simplified at the current level. - -The pattern is fully simplified if we do not know how to simplify it any -further. The simplifier reserves the right to skip any pattern which is marked, -so do not mark any pattern unless you are certain it cannot be further -simplified. - -Note that fully simplified at the current level may not mean that the pattern -is fully simplified (e.g. if a child is simplified conditionally). --} -markSimplified :: - (HasCallStack, InternalVariable variable) => - TermLike variable -> - TermLike variable -markSimplified (Recursive.project -> attrs :< termLikeF) = - Recursive.embed - ( setAttributeSimplified - (checkedSimplifiedFromChildren termLikeF) - attrs - :< termLikeF - ) - -markSimplifiedMaybeConditional :: - (HasCallStack, InternalVariable variable) => - Maybe SideCondition.Representation -> - TermLike variable -> - TermLike variable -markSimplifiedMaybeConditional Nothing = markSimplified -markSimplifiedMaybeConditional (Just condition) = - markSimplifiedConditional condition - -cannotSimplifyNotSimplifiedError :: - (HasCallStack, InternalVariable variable) => - TermLikeF variable (TermLike variable) -> - a -cannotSimplifyNotSimplifiedError termLikeF = - error - ( "Unexpectedly marking term with NotSimplified children as \ - \simplified:\n" - ++ show termLikeF - ++ "\n" - ++ Unparser.unparseToString termLikeF - ) - -setSimplified :: - (HasCallStack, InternalVariable variable) => - Attribute.Simplified -> - TermLike variable -> - TermLike variable -setSimplified - simplified - (Recursive.project -> attrs :< termLikeF) = - Recursive.embed - ( setAttributeSimplified mergedSimplified attrs - :< termLikeF - ) - where - childSimplified = simplifiedFromChildren termLikeF - mergedSimplified = case (childSimplified, simplified) of - (Attribute.NotSimplified, Attribute.NotSimplified) -> - Attribute.NotSimplified - (Attribute.NotSimplified, _) -> - cannotSimplifyNotSimplifiedError termLikeF - (_, Attribute.NotSimplified) -> - Attribute.NotSimplified - _ -> childSimplified <> simplified - -{- |Marks a term as being simplified as long as the side condition stays -unchanged. --} -markSimplifiedConditional :: - (HasCallStack, InternalVariable variable) => - SideCondition.Representation -> - TermLike variable -> - TermLike variable -markSimplifiedConditional - condition - (Recursive.project -> attrs :< termLikeF) = - Recursive.embed - ( setAttributeSimplified - ( checkedSimplifiedFromChildren termLikeF - <> Attribute.simplifiedConditionally condition - ) - attrs - :< termLikeF - ) - -simplifiedFromChildren :: - HasCallStack => - TermLikeF variable (TermLike variable) -> - Attribute.Simplified -simplifiedFromChildren termLikeF = - case mergedSimplified of - Attribute.NotSimplified -> Attribute.NotSimplified - _ -> mergedSimplified `Attribute.simplifiedTo` Attribute.fullySimplified - where - mergedSimplified = - foldMap (attributeSimplifiedAttribute . extractAttributes) termLikeF - -checkedSimplifiedFromChildren :: - (HasCallStack, InternalVariable variable) => - TermLikeF variable (TermLike variable) -> - Attribute.Simplified -checkedSimplifiedFromChildren termLikeF = - case simplifiedFromChildren termLikeF of - Attribute.NotSimplified -> cannotSimplifyNotSimplifiedError termLikeF - simplified -> simplified - -- | Get the 'Sort' of a 'TermLike' from the 'Attribute.Pattern' annotation. termLikeSort :: TermLike variable -> Sort termLikeSort = termSort . extractAttributes diff --git a/kore/src/Kore/Internal/TermLike/TermLike.hs b/kore/src/Kore/Internal/TermLike/TermLike.hs index 2d49a82a76..f3c1f14a99 100644 --- a/kore/src/Kore/Internal/TermLike/TermLike.hs +++ b/kore/src/Kore/Internal/TermLike/TermLike.hs @@ -17,11 +17,6 @@ module Kore.Internal.TermLike.TermLike ( traverseVariablesF, updateCallStack, depth, - isAttributeSimplified, - isAttributeSimplifiedAnyCondition, - isAttributeSimplifiedSomeCondition, - attributeSimplifiedAttribute, - setAttributeSimplified, mapAttributeVariables, deleteFreeVariable, ) where @@ -33,6 +28,9 @@ import Control.Lens ( Lens', ) import qualified Control.Lens as Lens +import Data.Text ( + Text + ) import qualified Control.Monad as Monad import qualified Control.Monad.Reader as Reader import Data.Functor.Const ( @@ -72,8 +70,6 @@ import qualified Kore.Attribute.Pattern.FreeVariables as Attribute.FreeVariables import qualified Kore.Attribute.Pattern.FreeVariables as FreeVariables import qualified Kore.Attribute.Pattern.Function as Attribute import qualified Kore.Attribute.Pattern.Functional as Attribute -import qualified Kore.Attribute.Pattern.Simplified as Attribute -import qualified Kore.Attribute.Pattern.Simplified as Attribute.Simplified import Kore.Attribute.Synthetic import Kore.Builtin.Endianness.Endianness ( Endianness, @@ -375,43 +371,6 @@ instance Synthetic Attribute.Defined (TermLikeF variable) where SignednessF signedness -> synthetic signedness InjF inj -> synthetic inj -instance Synthetic Attribute.Simplified (TermLikeF variable) where - synthetic = - \case - AndF and' -> synthetic and' - ApplySymbolF application -> synthetic application - ApplyAliasF application -> synthetic application - BottomF bottom -> synthetic bottom - CeilF ceil -> synthetic ceil - DomainValueF domainValue -> synthetic domainValue - EqualsF equals -> synthetic equals - ExistsF exists -> synthetic exists - FloorF floor' -> synthetic floor' - ForallF forall' -> synthetic forall' - IffF iff -> synthetic iff - ImpliesF implies -> synthetic implies - InF in' -> synthetic in' - MuF mu -> synthetic mu - NextF next -> synthetic next - NotF not' -> synthetic not' - NuF nu -> synthetic nu - OrF or' -> synthetic or' - RewritesF rewrites -> synthetic rewrites - TopF top -> synthetic top - InhabitantF inhabitant -> synthetic inhabitant - StringLiteralF stringLiteral -> synthetic stringLiteral - InternalBoolF internalBool -> synthetic internalBool - InternalBytesF internalBytes -> synthetic internalBytes - InternalIntF internalInt -> synthetic internalInt - InternalStringF internalString -> synthetic internalString - InternalListF internalList -> synthetic internalList - InternalMapF internalMap -> synthetic internalMap - InternalSetF internalSet -> synthetic internalSet - VariableF variable -> synthetic variable - EndiannessF endianness -> synthetic endianness - SignednessF signedness -> synthetic signedness - InjF inj -> synthetic inj - instance Synthetic Attribute.ConstructorLike (TermLikeF variable) where synthetic = \case @@ -471,7 +430,6 @@ data TermAttributes variable = TermAttributes , termFunction :: !Attribute.Function , termDefined :: !Attribute.Defined , termCreated :: !Attribute.Created - , termSimplified :: !Attribute.Simplified , termConstructorLike :: !Attribute.ConstructorLike } deriving stock (Eq, Show) @@ -490,7 +448,6 @@ instance , Synthetic Attribute.Functional base , Synthetic Attribute.Function base , Synthetic Attribute.Defined base - , Synthetic Attribute.Simplified base , Synthetic Attribute.ConstructorLike base ) => Synthetic (TermAttributes variable) base @@ -503,10 +460,6 @@ instance , termFunction = synthetic (termFunction <$> base) , termDefined = synthetic (termDefined <$> base) , termCreated = synthetic (termCreated <$> base) - , termSimplified = - if Attribute.isConstructorLike constructorLikeAttr - then Attribute.fullySimplified - else synthetic (termSimplified <$> base) , termConstructorLike = constructorLikeAttr } where @@ -521,66 +474,12 @@ instance Attribute.HasConstructorLike (TermAttributes variable) where instance (Ord variable) => From KeyAttributes (TermAttributes variable) where from = fromKeyAttributes -attributeSimplifiedAttribute :: - HasCallStack => - TermAttributes variable -> - Attribute.Simplified -attributeSimplifiedAttribute patt@TermAttributes{termSimplified} = - assertSimplifiedConsistency patt termSimplified - constructorLikeAttribute :: TermAttributes variable -> Attribute.ConstructorLike constructorLikeAttribute TermAttributes{termConstructorLike} = termConstructorLike -{- Checks whether the pattern is simplified relative to the given side -condition. --} -isAttributeSimplified :: - HasCallStack => - SideCondition.Representation -> - TermAttributes variable -> - Bool -isAttributeSimplified sideCondition patt@TermAttributes{termSimplified} = - assertSimplifiedConsistency patt $ - Attribute.isSimplified sideCondition termSimplified - -{- Checks whether the pattern is simplified relative to some side condition. --} -isAttributeSimplifiedSomeCondition :: - HasCallStack => - TermAttributes variable -> - Bool -isAttributeSimplifiedSomeCondition patt@TermAttributes{termSimplified} = - assertSimplifiedConsistency patt $ - Attribute.isSimplifiedSomeCondition termSimplified - -{- Checks whether the pattern is simplified relative to any side condition. --} -isAttributeSimplifiedAnyCondition :: - HasCallStack => - TermAttributes variable -> - Bool -isAttributeSimplifiedAnyCondition patt@TermAttributes{termSimplified} = - assertSimplifiedConsistency patt $ - Attribute.isSimplifiedAnyCondition termSimplified - -assertSimplifiedConsistency :: HasCallStack => TermAttributes variable -> a -> a -assertSimplifiedConsistency - TermAttributes{termConstructorLike, termSimplified} - | Attribute.isConstructorLike termConstructorLike - , not (Attribute.isSimplifiedAnyCondition termSimplified) = - error "Inconsistent attributes, constructorLike implies fully simplified." - | otherwise = id - -setAttributeSimplified :: - Attribute.Simplified -> - TermAttributes variable -> - TermAttributes variable -setAttributeSimplified termSimplified attrs = - attrs{termSimplified} - -- TODO: should we remove this? it isn't used anywhere {- | Use the provided mapping to replace all variables in a 'TermAttributes'. @@ -702,18 +601,18 @@ instance (Unparse variable, Ord variable) => Unparse (TermLike variable) where TermAttributes{termCreated} = attrs attributeRepresentation = case attrs of - (TermAttributes _ _ _ _ _ _ _ _) -> + (TermAttributes _ _ _ _ _ _ _) -> Pretty.surround (Pretty.hsep $ map Pretty.pretty representation) "/* " " */" where + representation :: [Text] representation = addFunctionalRepresentation $ addFunctionRepresentation $ addDefinedRepresentation $ - addSimplifiedRepresentation $ - addConstructorLikeRepresentation [] + addConstructorLikeRepresentation [] addFunctionalRepresentation | Attribute.isFunctional $ termFunctional attrs = ("Fl" :) | otherwise = id @@ -723,14 +622,6 @@ instance (Unparse variable, Ord variable) => Unparse (TermLike variable) where addDefinedRepresentation | Attribute.isDefined $ termDefined attrs = ("D" :) | otherwise = id - addSimplifiedRepresentation = - case simplifiedTag of - Just result -> (result :) - Nothing -> id - where - simplifiedTag = - Attribute.Simplified.unparseTag - (attributeSimplifiedAttribute attrs) addConstructorLikeRepresentation = case constructorLike of Just Attribute.ConstructorLikeHead -> ("Cl" :) @@ -939,19 +830,17 @@ fromKeyAttributes attrs = , termFunctional = Attribute.Functional True , termFunction = Attribute.Function True , termDefined = Attribute.Defined True - , termSimplified = Attribute.fullySimplified , termConstructorLike = Attribute.ConstructorLike (Just Attribute.ConstructorLikeHead) , termCreated = Attribute.Created Nothing } toKeyAttributes :: TermAttributes variable -> Maybe KeyAttributes -toKeyAttributes attrs@(TermAttributes _ _ _ _ _ _ _ _) +toKeyAttributes attrs@(TermAttributes _ _ _ _ _ _ _) | Attribute.nullFreeVariables termFreeVariables , Attribute.isFunctional termFunctional , Attribute.isFunction termFunction , Attribute.isDefined termDefined - , Attribute.isSimplifiedAnyCondition termSimplified , Attribute.isConstructorLike termConstructorLike = Just $ KeyAttributes termSort | otherwise = Nothing @@ -963,7 +852,6 @@ toKeyAttributes attrs@(TermAttributes _ _ _ _ _ _ _ _) , termFunction , termDefined , termConstructorLike - , termSimplified } = attrs -- | Ensure that a 'TermLike' is a concrete, constructor-like term. diff --git a/kore/src/Kore/Rewrite/AntiLeft.hs b/kore/src/Kore/Rewrite/AntiLeft.hs index a09ba5f108..819bcdfb8b 100644 --- a/kore/src/Kore/Rewrite/AntiLeft.hs +++ b/kore/src/Kore/Rewrite/AntiLeft.hs @@ -5,7 +5,6 @@ License : BSD-3-Clause module Kore.Rewrite.AntiLeft ( AntiLeft (..), antiLeftPredicate, - forgetSimplified, mapVariables, parse, toTermLike, @@ -230,32 +229,6 @@ mapVariablesLeft adj antiLeft@(AntiLeftLhs _ _ _) = where AntiLeftLhs{existentials, predicate, term} = antiLeft -forgetSimplified :: - InternalVariable variable => - AntiLeft variable -> - AntiLeft variable -forgetSimplified antiLeft@(AntiLeft _ _ _) = - AntiLeft - { aliasTerm = TermLike.forgetSimplified aliasTerm - , maybeInner = forgetSimplified <$> maybeInner - , leftHands = map forgetSimplifiedLeft leftHands - } - where - AntiLeft{aliasTerm, maybeInner, leftHands} = antiLeft - -forgetSimplifiedLeft :: - InternalVariable variable => - AntiLeftLhs variable -> - AntiLeftLhs variable -forgetSimplifiedLeft antiLeftLhs@(AntiLeftLhs _ _ _) = - AntiLeftLhs - { existentials - , predicate = Predicate.forgetSimplified predicate - , term = TermLike.forgetSimplified term - } - where - AntiLeftLhs{existentials, predicate, term} = antiLeftLhs - toTermLike :: AntiLeft variable -> TermLike variable toTermLike AntiLeft{aliasTerm} = aliasTerm diff --git a/kore/src/Kore/Rewrite/ClaimPattern.hs b/kore/src/Kore/Rewrite/ClaimPattern.hs index d031cb5d69..bfe9b746bc 100644 --- a/kore/src/Kore/Rewrite/ClaimPattern.hs +++ b/kore/src/Kore/Rewrite/ClaimPattern.hs @@ -12,7 +12,6 @@ module Kore.Rewrite.ClaimPattern ( applySubstitution, termToExistentials, mkGoal, - forgetSimplified, parseRightHandSide, claimPatternToTerm, ) where @@ -315,15 +314,6 @@ termToExistentials (TermLike.Exists_ _ v term) = fmap (v :) (termToExistentials term) termToExistentials term = (term, []) -forgetSimplified :: ClaimPattern -> ClaimPattern -forgetSimplified claimPattern'@(ClaimPattern _ _ _ _) = - claimPattern' - { left = Pattern.forgetSimplified left - , right = OrPattern.forgetSimplified right - } - where - ClaimPattern{left, right} = claimPattern' - {- | Ensure that the 'ClaimPattern''s bound variables are fresh. The 'existentials' should not appear free on the left-hand side so that we can diff --git a/kore/src/Kore/Rewrite/Function/Evaluator.hs b/kore/src/Kore/Rewrite/Function/Evaluator.hs index 29f339a2c9..750af151cd 100644 --- a/kore/src/Kore/Rewrite/Function/Evaluator.hs +++ b/kore/src/Kore/Rewrite/Function/Evaluator.hs @@ -22,7 +22,6 @@ import Control.Error ( import Control.Monad.Catch ( MonadThrow, ) -import qualified Kore.Attribute.Pattern.Simplified as Attribute.Simplified import Kore.Attribute.Synthetic import qualified Kore.Internal.MultiOr as MultiOr ( flatten, @@ -117,22 +116,9 @@ evaluateApplication return $ OrPattern.fromPattern $ Pattern.withCondition - (markSimplifiedIfChildren maybeSideCondition termLike) + termLike childrenCondition - markSimplifiedIfChildren :: - Maybe SideCondition.Representation -> - TermLike RewritingVariableName -> - TermLike RewritingVariableName - markSimplifiedIfChildren Nothing = - TermLike.setSimplified - (foldMap TermLike.simplifiedAttribute application) - markSimplifiedIfChildren (Just condition) = - TermLike.setSimplified - ( foldMap TermLike.simplifiedAttribute application - <> Attribute.Simplified.simplifiedConditionally condition - ) - canMemoize | Symbol.isMemo symbol , ( isTop childrenCondition diff --git a/kore/src/Kore/Rewrite/Implication.hs b/kore/src/Kore/Rewrite/Implication.hs index 2b1cd4d96f..55a94ee78a 100644 --- a/kore/src/Kore/Rewrite/Implication.hs +++ b/kore/src/Kore/Rewrite/Implication.hs @@ -13,7 +13,6 @@ module Kore.Rewrite.Implication ( applySubstitution, termToExistentials, resetConfigVariables, - forgetSimplified, parseRightHandSide, implicationToTerm, ) where @@ -313,15 +312,6 @@ termToExistentials (TermLike.Exists_ _ v term) = fmap (v :) (termToExistentials term) termToExistentials term = (term, []) -forgetSimplified :: Implication modality -> Implication modality -forgetSimplified implication'@(Implication _ _ _ _ _) = - implication' - { left = Pattern.forgetSimplified left - , right = OrPattern.forgetSimplified right - } - where - Implication{left, right} = implication' - {- | Ensure that the 'Implication''s bound variables are fresh. The 'existentials' should not appear free on the left-hand side so that we can diff --git a/kore/src/Kore/Rewrite/RulePattern.hs b/kore/src/Kore/Rewrite/RulePattern.hs index 0e6f049c0b..db56297782 100644 --- a/kore/src/Kore/Rewrite/RulePattern.hs +++ b/kore/src/Kore/Rewrite/RulePattern.hs @@ -16,7 +16,6 @@ module Kore.Rewrite.RulePattern ( topExistsToImplicitForall, isFreeOf, lhsEqualsRhs, - rhsForgetSimplified, rhsToTerm, lhsToTerm, rhsToPattern, @@ -406,14 +405,6 @@ renameExistentials subst RHS{existentials, right, ensures} = let name = SomeVariableNameElement . variableName $ var in maybe var expectElementVariable $ Map.lookup name subst -rhsForgetSimplified :: InternalVariable variable => RHS variable -> RHS variable -rhsForgetSimplified RHS{existentials, right, ensures} = - RHS - { existentials - , right = TermLike.forgetSimplified right - , ensures = Predicate.forgetSimplified ensures - } - {- | Applies a substitution to a rule and checks that it was fully applied, i.e. there is no substitution variable left in the rule. -} diff --git a/kore/src/Kore/Simplify/And.hs b/kore/src/Kore/Simplify/And.hs index 00fa6a5e8b..423593aff1 100644 --- a/kore/src/Kore/Simplify/And.hs +++ b/kore/src/Kore/Simplify/And.hs @@ -159,10 +159,7 @@ makeEvaluateNonBool notSimplifier sideCondition patterns = do term = applyAndIdempotenceAndFindContradictions (Conditional.term unified) - let predicate = - Predicate.fromMultiAnd predicates - & Predicate.setSimplified simplified - simplified = foldMap Predicate.simplifiedAttribute predicates + let predicate = Predicate.fromMultiAnd predicates in Pattern.withCondition term (from substitution <> from predicate) & return @@ -176,10 +173,7 @@ applyAndIdempotenceAndFindContradictions patt = where (terms, negatedTerms) = splitIntoTermsAndNegations patt noContradictions = Set.disjoint (Set.map mkNot terms) negatedTerms - mkAndSimplified a b = - TermLike.setSimplified - (TermLike.simplifiedAttribute a <> TermLike.simplifiedAttribute b) - (mkAnd a b) + mkAndSimplified a b = mkAnd a b splitIntoTermsAndNegations :: TermLike RewritingVariableName -> diff --git a/kore/src/Kore/Simplify/AndPredicates.hs b/kore/src/Kore/Simplify/AndPredicates.hs index 824670238f..b9ddf4331d 100644 --- a/kore/src/Kore/Simplify/AndPredicates.hs +++ b/kore/src/Kore/Simplify/AndPredicates.hs @@ -45,9 +45,4 @@ simplifyEvaluatedMultiPredicate sideCondition predicates = andConditions element where andConditions predicates' = - fmap markSimplified $ - Substitution.normalize sideCondition (fold predicates') - where - markSimplified = - Condition.setPredicateSimplified - (foldMap Condition.simplifiedAttribute predicates') + Substitution.normalize sideCondition (fold predicates') diff --git a/kore/src/Kore/Simplify/AndTerms.hs b/kore/src/Kore/Simplify/AndTerms.hs index e9a9a9026f..da0fc42ad3 100644 --- a/kore/src/Kore/Simplify/AndTerms.hs +++ b/kore/src/Kore/Simplify/AndTerms.hs @@ -875,7 +875,6 @@ functionAnd first second | isFunctionPattern first , isFunctionPattern second = makeEqualsPredicate first' second' - & Predicate.markSimplified -- Ceil predicate not needed since first being -- bottom will make the entire term bottom. However, -- one must be careful to not just drop the term. diff --git a/kore/src/Kore/Simplify/Application.hs b/kore/src/Kore/Simplify/Application.hs index 7e2ab845e4..1bf162bd3f 100644 --- a/kore/src/Kore/Simplify/Application.hs +++ b/kore/src/Kore/Simplify/Application.hs @@ -130,7 +130,6 @@ evaluateApplicationFunction let applicationPattern = synthesize . ApplySymbolF <$> expandedApp in applicationPattern - & Pattern.markSimplified & OrPattern.fromPattern & return | otherwise = diff --git a/kore/src/Kore/Simplify/Ceil.hs b/kore/src/Kore/Simplify/Ceil.hs index 047a9f8ece..0ddb0c6b41 100644 --- a/kore/src/Kore/Simplify/Ceil.hs +++ b/kore/src/Kore/Simplify/Ceil.hs @@ -392,7 +392,6 @@ makeSimplifiedCeil unsimplified = OrCondition.fromPredicate - . Predicate.markSimplifiedMaybeConditional maybeCurrentCondition . makeCeilPredicate $ termLike diff --git a/kore/src/Kore/Simplify/Condition.hs b/kore/src/Kore/Simplify/Condition.hs index 3f86d4ecac..2748fcc7d2 100644 --- a/kore/src/Kore/Simplify/Condition.hs +++ b/kore/src/Kore/Simplify/Condition.hs @@ -146,7 +146,7 @@ simplifyPredicates sideCondition original = do (toList predicates) let simplified = foldMap mkCondition simplifiedPredicates if original == simplifiedPredicates - then return (Condition.markSimplified simplified) + then return simplified else simplifyPredicates sideCondition simplifiedPredicates {- | Simplify a conjunction of predicates by simplifying each one diff --git a/kore/src/Kore/Simplify/DomainValue.hs b/kore/src/Kore/Simplify/DomainValue.hs index c4ab9ad06d..a52a52f4a7 100644 --- a/kore/src/Kore/Simplify/DomainValue.hs +++ b/kore/src/Kore/Simplify/DomainValue.hs @@ -40,7 +40,7 @@ simplify :: OrPattern RewritingVariableName simplify builtin@DomainValue{domainValueSort} = OrPattern.coerceSort domainValueSort - . MultiOr.map (fmap (markSimplified . mkDomainValue)) + . MultiOr.map (fmap mkDomainValue) $ simplifyDomainValue builtin simplifyDomainValue :: diff --git a/kore/src/Kore/Simplify/Equals.hs b/kore/src/Kore/Simplify/Equals.hs index e02f5984cd..366d1b6dfe 100644 --- a/kore/src/Kore/Simplify/Equals.hs +++ b/kore/src/Kore/Simplify/Equals.hs @@ -330,8 +330,7 @@ makeEvaluateTermsAssumesNoBottom firstTerm secondTerm = do Conditional { term = mkTop_ , predicate = - Predicate.markSimplified $ - makeEqualsPredicate firstTerm secondTerm + makeEqualsPredicate firstTerm secondTerm , substitution = mempty } @@ -371,8 +370,7 @@ makeEvaluateTermsToPredicate first second sideCondition Nothing -> return $ OrCondition.fromCondition . Condition.fromPredicate $ - Predicate.markSimplified $ - makeEqualsPredicate first second + makeEqualsPredicate first second Just predicatedOr -> do firstCeilOr <- makeEvaluateTermCeil sideCondition first secondCeilOr <- makeEvaluateTermCeil sideCondition second @@ -449,7 +447,6 @@ termEqualsAnd p1 p2 = . sequence equalsPattern = makeEqualsPredicate first second - & Predicate.markSimplified & Condition.fromPredicate -- Although the term will eventually be discarded, the sub-term -- unifier should return it in case the caller needs to diff --git a/kore/src/Kore/Simplify/Exists.hs b/kore/src/Kore/Simplify/Exists.hs index a73af44d0c..7c4b3f237c 100644 --- a/kore/src/Kore/Simplify/Exists.hs +++ b/kore/src/Kore/Simplify/Exists.hs @@ -409,10 +409,10 @@ quantifyPattern variable original@Conditional{term, predicate, substitution} , "variable=" ++ unparseToString variable , "patt=" ++ unparseToString original ] - | quantifyTerm = TermLike.markSimplified . mkExists variable <$> original + | quantifyTerm = mkExists variable <$> original | quantifyPredicate = Conditional.withCondition term $ - Condition.fromPredicate . Predicate.markSimplified + Condition.fromPredicate -- TODO (thomas.tuegel): This may not be fully simplified: we have not used -- the And simplifier on the predicate. $ diff --git a/kore/src/Kore/Simplify/Floor.hs b/kore/src/Kore/Simplify/Floor.hs index 4eb4b909b5..6ca1151638 100644 --- a/kore/src/Kore/Simplify/Floor.hs +++ b/kore/src/Kore/Simplify/Floor.hs @@ -21,9 +21,6 @@ import Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( makeFloorPredicate, ) -import qualified Kore.Internal.Predicate as Predicate ( - markSimplified, - ) import Kore.Internal.TermLike import Kore.Rewrite.RewritingVariable ( RewritingVariableName, @@ -95,5 +92,4 @@ makeEvaluateNonBoolFloor patt = (term, condition) = Pattern.splitTerm patt floorCondition = makeFloorPredicate term - & Predicate.markSimplified & Condition.fromPredicate diff --git a/kore/src/Kore/Simplify/Forall.hs b/kore/src/Kore/Simplify/Forall.hs index ac62004a76..20552f8902 100644 --- a/kore/src/Kore/Simplify/Forall.hs +++ b/kore/src/Kore/Simplify/Forall.hs @@ -15,7 +15,6 @@ module Kore.Simplify.Forall ( import qualified Kore.Internal.Condition as Condition ( fromPredicate, hasFreeVariable, - markPredicateSimplified, toPredicate, ) import qualified Kore.Internal.Conditional as Conditional ( @@ -50,7 +49,6 @@ import Kore.Internal.TermLike ( ) import qualified Kore.Internal.TermLike as TermLike ( hasFreeVariable, - markSimplified, ) import qualified Kore.Internal.TermLike as TermLike.DoNotUse import Kore.Rewrite.RewritingVariable ( @@ -119,19 +117,18 @@ makeEvaluate variable patt | Pattern.isBottom patt = Pattern.bottom | not variableInTerm && not variableInCondition = patt | predicateIsBoolean = - TermLike.markSimplified (mkForall variable term) + mkForall variable term `Conditional.withCondition` predicate | termIsBoolean = term - `Conditional.withCondition` Condition.markPredicateSimplified + `Conditional.withCondition` ( Condition.fromPredicate (makeForallPredicate variable (Condition.toPredicate predicate)) ) | otherwise = Pattern.fromTermLike $ - TermLike.markSimplified $ - mkForall variable $ - Pattern.toTermLike patt + mkForall variable $ + Pattern.toTermLike patt where (term, predicate) = Pattern.splitTerm patt someVariable = mkSomeVariable variable diff --git a/kore/src/Kore/Simplify/Iff.hs b/kore/src/Kore/Simplify/Iff.hs index 3abf99a946..0179e2f319 100644 --- a/kore/src/Kore/Simplify/Iff.hs +++ b/kore/src/Kore/Simplify/Iff.hs @@ -25,9 +25,6 @@ import Kore.Internal.SideCondition ( ) import qualified Kore.Internal.Substitution as Substitution import Kore.Internal.TermLike -import qualified Kore.Internal.TermLike as TermLike ( - markSimplified, - ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) @@ -140,22 +137,20 @@ makeEvaluateNonBoolIff [ Conditional { term = firstTerm , predicate = - Predicate.markSimplified $ - Predicate.makeIffPredicate - ( Predicate.makeAndPredicate - firstPredicate - (Substitution.toPredicate firstSubstitution) - ) - ( Predicate.makeAndPredicate - secondPredicate - (Substitution.toPredicate secondSubstitution) - ) + Predicate.makeIffPredicate + ( Predicate.makeAndPredicate + firstPredicate + (Substitution.toPredicate firstSubstitution) + ) + ( Predicate.makeAndPredicate + secondPredicate + (Substitution.toPredicate secondSubstitution) + ) , substitution = mempty } ] | otherwise = OrPattern.fromTermLike $ - TermLike.markSimplified $ - mkIff - (Pattern.toTermLike patt1) - (Pattern.toTermLike patt2) + mkIff + (Pattern.toTermLike patt1) + (Pattern.toTermLike patt2) diff --git a/kore/src/Kore/Simplify/Implies.hs b/kore/src/Kore/Simplify/Implies.hs index ba85588df2..a58044cb43 100644 --- a/kore/src/Kore/Simplify/Implies.hs +++ b/kore/src/Kore/Simplify/Implies.hs @@ -174,16 +174,15 @@ makeEvaluateImpliesNonBool [ Conditional { term = firstTerm , predicate = - Predicate.markSimplified $ - Predicate.makeImpliesPredicate - ( Predicate.makeAndPredicate - firstPredicate - (Substitution.toPredicate firstSubstitution) - ) - ( Predicate.makeAndPredicate - secondPredicate - (Substitution.toPredicate secondSubstitution) - ) + Predicate.makeImpliesPredicate + ( Predicate.makeAndPredicate + firstPredicate + (Substitution.toPredicate firstSubstitution) + ) + ( Predicate.makeAndPredicate + secondPredicate + (Substitution.toPredicate secondSubstitution) + ) , substitution = mempty } ] @@ -192,10 +191,9 @@ makeEvaluateImpliesNonBool OrPattern.fromPatterns [ Conditional { term = - TermLike.markSimplified $ - mkImplies - (Pattern.toTermLike pattern1) - (Pattern.toTermLike pattern2) + mkImplies + (Pattern.toTermLike pattern1) + (Pattern.toTermLike pattern2) , predicate = Predicate.makeTruePredicate , substitution = mempty } diff --git a/kore/src/Kore/Simplify/Inhabitant.hs b/kore/src/Kore/Simplify/Inhabitant.hs index 24b62b7cbe..9a5ba27d34 100644 --- a/kore/src/Kore/Simplify/Inhabitant.hs +++ b/kore/src/Kore/Simplify/Inhabitant.hs @@ -12,9 +12,6 @@ import Kore.Internal.OrPattern ( ) import qualified Kore.Internal.OrPattern as OrPattern import Kore.Internal.TermLike -import qualified Kore.Internal.TermLike as TermLike ( - markSimplified, - ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) @@ -28,5 +25,4 @@ simplify :: OrPattern RewritingVariableName simplify Inhabitant{inhSort} = OrPattern.fromTermLike $ - TermLike.markSimplified $ - mkInhabitant inhSort + mkInhabitant inhSort diff --git a/kore/src/Kore/Simplify/Inj.hs b/kore/src/Kore/Simplify/Inj.hs index 275579c820..d2edba856f 100644 --- a/kore/src/Kore/Simplify/Inj.hs +++ b/kore/src/Kore/Simplify/Inj.hs @@ -44,7 +44,7 @@ simplify injOrPattern = do -- evaluateInj does not mark its result simplified because it -- exists outside the simplifier; for example, it might be -- called during unification or matching. - (TermLike.markSimplified . evaluateInj) + evaluateInj composed return evaluated diff --git a/kore/src/Kore/Simplify/InternalList.hs b/kore/src/Kore/Simplify/InternalList.hs index 72b451dff9..52594a3104 100644 --- a/kore/src/Kore/Simplify/InternalList.hs +++ b/kore/src/Kore/Simplify/InternalList.hs @@ -27,5 +27,5 @@ simplify = traverse (Logic.scatter >>> Compose) >>> fmap mkInternalList >>> getCompose - >>> fmap (Pattern.syncSort >>> fmap markSimplified) + >>> fmap (Pattern.syncSort) >>> MultiOr.observeAll diff --git a/kore/src/Kore/Simplify/InternalMap.hs b/kore/src/Kore/Simplify/InternalMap.hs index 26df572b31..5cfdaf736e 100644 --- a/kore/src/Kore/Simplify/InternalMap.hs +++ b/kore/src/Kore/Simplify/InternalMap.hs @@ -29,7 +29,7 @@ simplify :: OrPattern RewritingVariableName simplify = traverse (Logic.scatter >>> Compose) - >>> fmap (normalizeInternalMap >>> markSimplified) + >>> fmap normalizeInternalMap >>> getCompose >>> fmap Pattern.syncSort >>> MultiOr.observeAll diff --git a/kore/src/Kore/Simplify/InternalSet.hs b/kore/src/Kore/Simplify/InternalSet.hs index cd16cdc586..af8c1d638c 100644 --- a/kore/src/Kore/Simplify/InternalSet.hs +++ b/kore/src/Kore/Simplify/InternalSet.hs @@ -29,7 +29,7 @@ simplify :: OrPattern RewritingVariableName simplify = traverse (Logic.scatter >>> Compose) - >>> fmap (normalizeInternalSet >>> markSimplified) + >>> fmap normalizeInternalSet >>> getCompose >>> fmap Pattern.syncSort >>> MultiOr.observeAll diff --git a/kore/src/Kore/Simplify/Mu.hs b/kore/src/Kore/Simplify/Mu.hs index 4577801c95..5c46a7fb14 100644 --- a/kore/src/Kore/Simplify/Mu.hs +++ b/kore/src/Kore/Simplify/Mu.hs @@ -16,7 +16,6 @@ import Kore.Internal.Pattern ( ) import qualified Kore.Internal.Pattern as Pattern ( fromTermLike, - simplifiedAttribute, toTermLike, ) import Kore.Internal.TermLike ( @@ -24,9 +23,6 @@ import Kore.Internal.TermLike ( SetVariable, mkMu, ) -import qualified Kore.Internal.TermLike as TermLike ( - setSimplified, - ) import qualified Kore.Internal.TermLike as TermLike.DoNotUse import Kore.Rewrite.RewritingVariable ( RewritingVariableName, @@ -52,6 +48,5 @@ makeEvaluate :: Pattern RewritingVariableName makeEvaluate variable patt = Pattern.fromTermLike $ - TermLike.setSimplified (Pattern.simplifiedAttribute patt) $ - mkMu variable $ - Pattern.toTermLike patt + mkMu variable $ + Pattern.toTermLike patt diff --git a/kore/src/Kore/Simplify/Next.hs b/kore/src/Kore/Simplify/Next.hs index 6e84e0893c..251a0e92db 100644 --- a/kore/src/Kore/Simplify/Next.hs +++ b/kore/src/Kore/Simplify/Next.hs @@ -39,4 +39,4 @@ simplify Next{nextChild = child} = simplifyEvaluated child simplifyEvaluated :: OrPattern RewritingVariableName -> OrPattern RewritingVariableName -simplifyEvaluated = MultiOr.map (Pattern.markSimplified . fmap mkNext) +simplifyEvaluated = MultiOr.map (fmap mkNext) diff --git a/kore/src/Kore/Simplify/NoConfusion.hs b/kore/src/Kore/Simplify/NoConfusion.hs index 79bdd336b0..818e85fd92 100644 --- a/kore/src/Kore/Simplify/NoConfusion.hs +++ b/kore/src/Kore/Simplify/NoConfusion.hs @@ -92,7 +92,7 @@ equalInjectiveHeadsAndEquals -- which allow evaluating the symbol. It is possible this pattern -- is not actually fully simplified! term = - (markSimplified . mkApplySymbol firstHead) + (mkApplySymbol firstHead) (Pattern.term <$> children) return (Pattern.withCondition term merged) where diff --git a/kore/src/Kore/Simplify/Not.hs b/kore/src/Kore/Simplify/Not.hs index ba197c4cfb..32f27c4939 100644 --- a/kore/src/Kore/Simplify/Not.hs +++ b/kore/src/Kore/Simplify/Not.hs @@ -53,9 +53,6 @@ import Kore.Internal.SideCondition ( ) import qualified Kore.Internal.Substitution as Substitution import Kore.Internal.TermLike -import qualified Kore.Internal.TermLike as TermLike ( - markSimplified, - ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) @@ -175,10 +172,9 @@ makeEvaluatePredicate Conditional { term = () , predicate = - Predicate.markSimplified $ - makeNotPredicate $ - makeAndPredicate predicate $ - Substitution.toPredicate substitution + makeNotPredicate $ + makeAndPredicate predicate $ + Substitution.toPredicate substitution , substitution = mempty } @@ -200,7 +196,7 @@ makeTermNot (And_ _ term1 term2) = makeTermNot term | isBottom term = MultiOr.singleton mkTop_ | isTop term = MultiOr.singleton mkBottom_ - | otherwise = MultiOr.singleton $ TermLike.markSimplified $ mkNot term + | otherwise = MultiOr.singleton $ mkNot term -- | Distribute 'Not' over 'MultiOr' using de Morgan's identity. distributeNot :: diff --git a/kore/src/Kore/Simplify/Nu.hs b/kore/src/Kore/Simplify/Nu.hs index 7f33985bb0..579a965318 100644 --- a/kore/src/Kore/Simplify/Nu.hs +++ b/kore/src/Kore/Simplify/Nu.hs @@ -16,7 +16,6 @@ import Kore.Internal.Pattern ( ) import qualified Kore.Internal.Pattern as Pattern ( fromTermLike, - simplifiedAttribute, toTermLike, ) import Kore.Internal.TermLike ( @@ -24,9 +23,6 @@ import Kore.Internal.TermLike ( SetVariable, mkNu, ) -import qualified Kore.Internal.TermLike as TermLike ( - setSimplified, - ) import qualified Kore.Internal.TermLike as TermLike.DoNotUse import Kore.Rewrite.RewritingVariable ( RewritingVariableName, @@ -51,6 +47,5 @@ makeEvaluate :: Pattern RewritingVariableName makeEvaluate variable patt = Pattern.fromTermLike $ - TermLike.setSimplified (Pattern.simplifiedAttribute patt) $ - mkNu variable $ - Pattern.toTermLike patt + mkNu variable $ + Pattern.toTermLike patt diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index b4467ed821..7069785173 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -117,15 +117,22 @@ makeEvaluate :: Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) makeEvaluate sideCondition = - loop . OrPattern.fromPattern + loop 0 . OrPattern.fromPattern where - loop input = do - output <- - OrPattern.traverse worker input - & fmap OrPattern.flatten - if input == output - then pure output - else loop output + limit :: Int + limit = 4 + + loop count input + | count >= limit = + trace "\nexceeded pattern simplifier limit\n" + $ pure input + | otherwise = do + output <- + OrPattern.traverse worker input + & fmap OrPattern.flatten + if input == output + then pure output + else loop (count + 1) output worker pattern' = OrPattern.observeAllT $ do diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index 8d483dccfe..effbf64fcb 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -123,8 +123,6 @@ simplify sideCondition original = worker predicate | Just predicate' <- replacePredicate predicate = worker predicate' - | Predicate.isSimplified repr predicate = - pure (mkSingleton predicate) | otherwise = case predicateF of AndF andF -> normalizeAnd =<< traverse worker andF @@ -315,7 +313,6 @@ normalizeNotAnd Not{notSort, notChild = predicates} = -- \not(\and(_, ...)) Predicate.fromMultiAnd predicates & fromNot - & Predicate.markSimplified & mkSingleton & pure bottom = normalizeBottom Bottom{bottomSort = notSort} diff --git a/kore/src/Kore/Simplify/Rule.hs b/kore/src/Kore/Simplify/Rule.hs index 6db9a9855a..e9ced83439 100644 --- a/kore/src/Kore/Simplify/Rule.hs +++ b/kore/src/Kore/Simplify/Rule.hs @@ -86,10 +86,10 @@ simplifyRulePattern rule = do RulePattern{attributes} = rule return RulePattern - { left = TermLike.forgetSimplified left' - , antiLeft = AntiLeft.forgetSimplified <$> antiLeft' - , requires = Predicate.forgetSimplified requires' - , rhs = rhsForgetSimplified rhs' + { left = left' + , antiLeft = antiLeft' + , requires = requires' + , rhs = rhs' , attributes = attributes } _ -> @@ -120,7 +120,6 @@ simplifyClaimPattern claim = do let subst = Substitution.toMap substitution left' = Pattern.withCondition term (Pattern.withoutTerm left) in return - . ClaimPattern.forgetSimplified . substitute subst $ claim { ClaimPattern.left = left' diff --git a/kore/src/Kore/Simplify/SubstitutionSimplifier.hs b/kore/src/Kore/Simplify/SubstitutionSimplifier.hs index 98143b18fe..7edffef7d8 100644 --- a/kore/src/Kore/Simplify/SubstitutionSimplifier.hs +++ b/kore/src/Kore/Simplify/SubstitutionSimplifier.hs @@ -349,16 +349,9 @@ simplifySubstitutionWorker sideCondition makeAnd' = \substitution -> do simplifySingleSubstitution subst@(Assignment uVar termLike) = case variableName uVar of SomeVariableNameSet _ -> return subst - SomeVariableNameElement _ - | isSimplified -> return subst - | otherwise -> do - termLike' <- simplifyTermLike termLike - return $ Substitution.assign uVar termLike' - where - isSimplified = - TermLike.isSimplified - sideConditionRepresentation - termLike + SomeVariableNameElement _ -> do + termLike' <- simplifyTermLike termLike + return $ Substitution.assign uVar termLike' simplifyTermLike :: TermLike RewritingVariableName -> diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index be7cfeb1d3..27f7290cd5 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -132,16 +132,24 @@ simplify :: TermLike RewritingVariableName -> simplifier (OrPattern RewritingVariableName) simplify sideCondition = - loop . OrPattern.fromTermLike + loop 0 . OrPattern.fromTermLike where + limit :: Int + limit = 4 + loop :: + Int -> OrPattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) - loop input = do - output <- MultiOr.traverseOr (propagateConditions worker) input - if input == output - then pure output -- (OrPattern.markTermSimplifiedConditionally repr output) - else loop output + loop count input + | count >= limit = + trace "\nexceeded term simplifier limit\n" + $ pure input + | otherwise = do + output <- MultiOr.traverseOr (propagateConditions worker) input + if input == output + then pure output -- (OrPattern.markTermSimplifiedConditionally repr output) + else loop (count + 1) output replaceTerm = SideCondition.replaceTerm sideCondition @@ -159,8 +167,6 @@ simplify sideCondition = worker termLike | Just termLike' <- replaceTerm termLike = worker termLike' - | TermLike.isSimplified repr termLike = - pure (OrPattern.fromTermLike termLike) | otherwise = case termLikeF of -- Not implemented: diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index 07a0f9fd49..ff1bfb56c5 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -629,30 +629,6 @@ test_simplificationIntegration = assertBool "Expected simplified term" (TermLike.isSimplified sideRepresentation term) assertBool (unlines ["Expected simplified condition:", message]) (Condition.isSimplified sideRepresentation condition) assertBool message (Pattern.isSimplified sideRepresentation pattern') - , testCase "Equals-in simplification" $ do - let gt = - mkSetVariable (testId "gt") Mock.stringSort - & mapSetVariable (pure mkConfigVariable) - g = - mkSetVariable (testId "g") Mock.testSort1 - & mapSetVariable (pure mkConfigVariable) - actual <- - evaluate - Conditional - { term = - mkNu - gt - ( mkEquals_ - ( mkIn_ - mkTop_ - (mkNu g (mkOr Mock.aSort1 (mkSetVar g))) - ) - mkTop_ - ) - , predicate = makeTruePredicate - , substitution = mempty - } - assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "And-list simplification" $ do actual <- evaluate @@ -665,44 +641,6 @@ test_simplificationIntegration = , substitution = mempty } assertBool "" (OrPattern.isSimplified sideRepresentation actual) - , testCase "Distributed equals simplification" $ do - let k = - mkSetVariable (testId "k") Mock.stringSort - & mapSetVariable (pure mkConfigVariable) - actual <- - evaluate - Conditional - { term = - mkMu - k - ( mkEquals_ - (Mock.functionalConstr21 Mock.cf Mock.cf) - (Mock.functionalConstr21 Mock.ch Mock.cg) - ) - , predicate = makeTruePredicate - , substitution = mempty - } - assertBool "" (OrPattern.isSimplified sideRepresentation actual) - , testCase "nu-floor-in-or simplification" $ do - let q = - mkSetVariable (testId "q") Mock.otherSort - & mapSetVariable (pure mkConfigVariable) - actual <- - evaluate - Conditional - { term = - mkNu - q - ( mkFloor_ - ( mkIn_ - (Mock.g Mock.ch) - (mkOr Mock.cf Mock.cg) - ) - ) - , predicate = makeTruePredicate - , substitution = mempty - } - assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "equals-predicate with sort change simplification" $ do actual <- evaluate diff --git a/test/regression-wasm/test-memory.sh.out.golden b/test/regression-wasm/test-memory.sh.out.golden index 8c23413ce9..7f1e941fe0 100644 --- a/test/regression-wasm/test-memory.sh.out.golden +++ b/test/regression-wasm/test-memory.sh.out.golden @@ -1 +1 @@ -/* D Sfa */ \top{R}() \ No newline at end of file +/* D */ \top{R}() \ No newline at end of file diff --git a/test/regression-wasm/test-simple-arithmetic.sh.out.golden b/test/regression-wasm/test-simple-arithmetic.sh.out.golden index 8c23413ce9..7f1e941fe0 100644 --- a/test/regression-wasm/test-simple-arithmetic.sh.out.golden +++ b/test/regression-wasm/test-simple-arithmetic.sh.out.golden @@ -1 +1 @@ -/* D Sfa */ \top{R}() \ No newline at end of file +/* D */ \top{R}() \ No newline at end of file From 1aeef34f7e84ad23d73b658b47d5a8ffce745fea Mon Sep 17 00:00:00 2001 From: github-actions Date: Fri, 30 Jul 2021 12:41:26 +0000 Subject: [PATCH 15/40] Format with fourmolu --- kore/src/Kore/Builtin/List.hs | 2 +- kore/src/Kore/Internal/Pattern.hs | 1 - kore/src/Kore/Internal/TermLike/TermLike.hs | 6 +++--- kore/src/Kore/Simplify/Forall.hs | 7 +++---- kore/src/Kore/Simplify/Pattern.hs | 4 ++-- kore/src/Kore/Simplify/TermLike.hs | 4 ++-- 6 files changed, 11 insertions(+), 13 deletions(-) diff --git a/kore/src/Kore/Builtin/List.hs b/kore/src/Kore/Builtin/List.hs index b9e7401c34..8048cfe383 100644 --- a/kore/src/Kore/Builtin/List.hs +++ b/kore/src/Kore/Builtin/List.hs @@ -478,7 +478,7 @@ unifyEquals let propagatedUnified = propagateConditions unified result = asInternal tools internalListSort - <$> propagatedUnified + <$> propagatedUnified return result where InternalList{internalListSort} = builtin1 diff --git a/kore/src/Kore/Internal/Pattern.hs b/kore/src/Kore/Internal/Pattern.hs index 752377fdd0..8653b43716 100644 --- a/kore/src/Kore/Internal/Pattern.hs +++ b/kore/src/Kore/Internal/Pattern.hs @@ -113,7 +113,6 @@ fromPredicateSorted :: Predicate variable -> Pattern variable fromPredicateSorted sort = fromCondition sort . Condition.fromPredicate - freeElementVariables :: InternalVariable variable => Pattern variable -> diff --git a/kore/src/Kore/Internal/TermLike/TermLike.hs b/kore/src/Kore/Internal/TermLike/TermLike.hs index f3c1f14a99..9caca4772e 100644 --- a/kore/src/Kore/Internal/TermLike/TermLike.hs +++ b/kore/src/Kore/Internal/TermLike/TermLike.hs @@ -28,9 +28,6 @@ import Control.Lens ( Lens', ) import qualified Control.Lens as Lens -import Data.Text ( - Text - ) import qualified Control.Monad as Monad import qualified Control.Monad.Reader as Reader import Data.Functor.Const ( @@ -55,6 +52,9 @@ import Data.Set ( Set, ) import qualified Data.Set as Set +import Data.Text ( + Text, + ) import qualified GHC.Generics as GHC import qualified GHC.Stack as GHC import qualified Generics.SOP as SOP diff --git a/kore/src/Kore/Simplify/Forall.hs b/kore/src/Kore/Simplify/Forall.hs index 20552f8902..b02e8986cb 100644 --- a/kore/src/Kore/Simplify/Forall.hs +++ b/kore/src/Kore/Simplify/Forall.hs @@ -121,10 +121,9 @@ makeEvaluate variable patt `Conditional.withCondition` predicate | termIsBoolean = term - `Conditional.withCondition` - ( Condition.fromPredicate - (makeForallPredicate variable (Condition.toPredicate predicate)) - ) + `Conditional.withCondition` ( Condition.fromPredicate + (makeForallPredicate variable (Condition.toPredicate predicate)) + ) | otherwise = Pattern.fromTermLike $ mkForall variable $ diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index 7069785173..eec9aaf007 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -124,8 +124,8 @@ makeEvaluate sideCondition = loop count input | count >= limit = - trace "\nexceeded pattern simplifier limit\n" - $ pure input + trace "\nexceeded pattern simplifier limit\n" $ + pure input | otherwise = do output <- OrPattern.traverse worker input diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index 27f7290cd5..deaa9cee0e 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -143,8 +143,8 @@ simplify sideCondition = simplifier (OrPattern RewritingVariableName) loop count input | count >= limit = - trace "\nexceeded term simplifier limit\n" - $ pure input + trace "\nexceeded term simplifier limit\n" $ + pure input | otherwise = do output <- MultiOr.traverseOr (propagateConditions worker) input if input == output From 3009f267fc742e909d0c3c474a754d2456e89fc1 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Fri, 6 Aug 2021 16:47:12 +0300 Subject: [PATCH 16/40] Revert "WIP: fix Simplified attribute issues" This reverts commit 17bd41ef38eb92df11b3908cd4b7ce94d0cd8c52. --- kore/kore.cabal | 1 + kore/src/Kore/Attribute/Pattern/Simplified.hs | 378 ++++++++++++++++++ kore/src/Kore/Attribute/PredicatePattern.hs | 55 ++- .../Kore/Builtin/AssocComm/CeilSimplifier.hs | 12 + .../Kore/Builtin/AssociativeCommutative.hs | 29 +- kore/src/Kore/Builtin/Bool/Bool.hs | 5 +- .../src/Kore/Builtin/Endianness/Endianness.hs | 5 + kore/src/Kore/Builtin/Int/Int.hs | 2 +- .../Builtin/InternalBytes/InternalBytes.hs | 3 +- kore/src/Kore/Builtin/List.hs | 14 +- .../src/Kore/Builtin/Signedness/Signedness.hs | 5 + kore/src/Kore/Equation/Application.hs | 4 +- kore/src/Kore/Equation/Simplification.hs | 10 +- kore/src/Kore/Internal/Condition.hs | 56 +++ kore/src/Kore/Internal/Conditional.hs | 47 +++ kore/src/Kore/Internal/InternalBool.hs | 5 + kore/src/Kore/Internal/InternalInt.hs | 5 + kore/src/Kore/Internal/InternalList.hs | 5 + kore/src/Kore/Internal/InternalMap.hs | 5 + kore/src/Kore/Internal/InternalSet.hs | 5 + kore/src/Kore/Internal/InternalString.hs | 5 + kore/src/Kore/Internal/OrCondition.hs | 4 + kore/src/Kore/Internal/OrPattern.hs | 42 ++ kore/src/Kore/Internal/Pattern.hs | 69 ++++ kore/src/Kore/Internal/Predicate.hs | 205 +++++++++- kore/src/Kore/Internal/Substitution.hs | 60 +++ kore/src/Kore/Internal/TermLike.hs | 168 ++++++++ kore/src/Kore/Internal/TermLike/TermLike.hs | 126 +++++- kore/src/Kore/Rewrite/AntiLeft.hs | 27 ++ kore/src/Kore/Rewrite/ClaimPattern.hs | 10 + kore/src/Kore/Rewrite/Function/Evaluator.hs | 16 +- kore/src/Kore/Rewrite/Implication.hs | 10 + kore/src/Kore/Rewrite/RulePattern.hs | 9 + kore/src/Kore/Simplify/And.hs | 10 +- kore/src/Kore/Simplify/AndPredicates.hs | 7 +- kore/src/Kore/Simplify/AndTerms.hs | 1 + kore/src/Kore/Simplify/Application.hs | 1 + kore/src/Kore/Simplify/Ceil.hs | 1 + kore/src/Kore/Simplify/Condition.hs | 2 +- kore/src/Kore/Simplify/DomainValue.hs | 2 +- kore/src/Kore/Simplify/Equals.hs | 7 +- kore/src/Kore/Simplify/Exists.hs | 4 +- kore/src/Kore/Simplify/Floor.hs | 4 + kore/src/Kore/Simplify/Forall.hs | 16 +- kore/src/Kore/Simplify/Iff.hs | 29 +- kore/src/Kore/Simplify/Implies.hs | 26 +- kore/src/Kore/Simplify/Inhabitant.hs | 6 +- kore/src/Kore/Simplify/Inj.hs | 2 +- kore/src/Kore/Simplify/InternalList.hs | 2 +- kore/src/Kore/Simplify/InternalMap.hs | 2 +- kore/src/Kore/Simplify/InternalSet.hs | 2 +- kore/src/Kore/Simplify/Mu.hs | 9 +- kore/src/Kore/Simplify/Next.hs | 2 +- kore/src/Kore/Simplify/NoConfusion.hs | 2 +- kore/src/Kore/Simplify/Not.hs | 12 +- kore/src/Kore/Simplify/Nu.hs | 9 +- kore/src/Kore/Simplify/Pattern.hs | 23 +- kore/src/Kore/Simplify/Predicate.hs | 5 +- kore/src/Kore/Simplify/Rule.hs | 9 +- .../Kore/Simplify/SubstitutionSimplifier.hs | 13 +- kore/src/Kore/Simplify/TermLike.hs | 22 +- kore/test/Test/Kore/Simplify/Integration.hs | 62 +++ .../regression-wasm/test-memory.sh.out.golden | 2 +- .../test-simple-arithmetic.sh.out.golden | 2 +- 64 files changed, 1563 insertions(+), 135 deletions(-) create mode 100644 kore/src/Kore/Attribute/Pattern/Simplified.hs diff --git a/kore/kore.cabal b/kore/kore.cabal index b6e409ca6e..2c0ba6b0b2 100644 --- a/kore/kore.cabal +++ b/kore/kore.cabal @@ -207,6 +207,7 @@ library Kore.Attribute.Pattern.FreeVariables Kore.Attribute.Pattern.Function Kore.Attribute.Pattern.Functional + Kore.Attribute.Pattern.Simplified Kore.Attribute.PredicatePattern Kore.Attribute.Priority Kore.Attribute.ProductionID diff --git a/kore/src/Kore/Attribute/Pattern/Simplified.hs b/kore/src/Kore/Attribute/Pattern/Simplified.hs new file mode 100644 index 0000000000..634784bb67 --- /dev/null +++ b/kore/src/Kore/Attribute/Pattern/Simplified.hs @@ -0,0 +1,378 @@ +{-# LANGUAGE NoStrict #-} +{-# LANGUAGE NoStrictData #-} + +{- | +Copyright : (c) Runtime Verification, 2019-2021 +License : BSD-3-Clause +-} +module Kore.Attribute.Pattern.Simplified ( + Simplified (..), + Condition (..), + pattern Simplified_, + Type (..), + isSimplified, + isSimplifiedAnyCondition, + isSimplifiedSomeCondition, + simplifiedTo, + notSimplified, + fullySimplified, + alwaysSimplified, + simplifiedConditionally, + simplifiableConditionally, + unparseTag, +) where + +import Data.Text ( + Text, + ) +import qualified GHC.Generics as GHC +import qualified Generics.SOP as SOP +import Kore.Attribute.Synthetic +import Kore.Debug +import Kore.Internal.Inj ( + Inj, + ) +import qualified Kore.Internal.Inj as Inj +import Kore.Internal.InternalBytes ( + InternalBytes, + ) +import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( + Representation, + ) +import Kore.Syntax ( + And, + Application, + Bottom, + Ceil, + Const, + DomainValue, + Equals, + Exists, + Floor, + Forall, + Iff, + Implies, + In, + Inhabitant, + Mu, + Next, + Not, + Nu, + Or, + Rewrites, + StringLiteral, + Top, + ) +import Kore.Syntax.Variable +import Prelude.Kore + +-- | How well simplified is a pattern. +data Type + = -- | The entire pattern is simplified + Fully + | -- | The pattern's subterms are either fully simplified or partly + -- simplified. Normally all the leaves in a partly simplified + -- subterm tree are fully simplified. + Partly + deriving stock (Eq, Ord, Show) + deriving stock (GHC.Generic) + deriving anyclass (Hashable, NFData) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) + deriving anyclass (Debug) + +instance Semigroup Type where + Partly <> _ = Partly + _ <> Partly = Partly + Fully <> Fully = Fully + +instance Monoid Type where + mempty = Fully + +-- | Under which condition is a pattern simplified. +data Condition + = -- | The term and all its subterms are simplified the same regardless + -- of the side condition. + Any + | -- | The term is in its current simplified state only when using the + -- given side condition. When the side condition changes, e.g. by + -- adding extra conditions, then we may be able to further simplify the + -- term. + Condition SideCondition.Representation + | -- | Parts of the term are simplified under different side conditions. + Unknown + deriving stock (Eq, Ord, Show) + deriving stock (GHC.Generic) + deriving anyclass (Hashable, NFData) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) + deriving anyclass (Debug) + +instance Diff Condition where + diffPrec = diffPrecIgnore + +instance Semigroup Condition where + Unknown <> _ = Unknown + _ <> Unknown = Unknown + Any <> c = c + c <> Any = c + c@(Condition c1) <> Condition c2 = + if c1 == c2 + then c + else Unknown + +instance Monoid Condition where + mempty = Any + +data SimplifiedData = SimplifiedData + { sType :: Type + , condition :: Condition + } + deriving stock (Eq, Ord, Show) + deriving stock (GHC.Generic) + deriving anyclass (Hashable, NFData) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) + deriving anyclass (Debug) + +instance Diff SimplifiedData where + diffPrec = diffPrecIgnore + +{- | A pattern is 'Simplified' if it has run through the simplifier. + +The simplifier runs until we do not know how to simplify a pattern any more. A +pattern 'isSimplified' if re-applying the simplifier would return the same +pattern. + +Most patterns are assumed un-simplified until marked otherwise, so the +simplified status is reset by any substitution under the pattern. +-} +data Simplified + = Simplified SimplifiedData + | NotSimplified + deriving stock (Eq, Ord, Show) + deriving stock (GHC.Generic) + deriving anyclass (Hashable, NFData) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) + deriving anyclass (Debug) + +instance Diff Simplified where + diffPrec = diffPrecIgnore + +instance Semigroup Simplified where + NotSimplified <> _ = NotSimplified + _ <> NotSimplified = NotSimplified + (Simplified_ t1 c1) <> (Simplified_ t2 c2) = + Simplified_ (t1 <> t2) (c1 <> c2) + +instance Monoid Simplified where + mempty = Simplified_ mempty mempty + +pattern Simplified_ :: Type -> Condition -> Simplified +pattern Simplified_ sType condition = + (Simplified SimplifiedData{sType, condition}) + +{-# COMPLETE Simplified_, NotSimplified #-} + +{- | Computes the 'Simplified' attribute for a pattern given its default +attribute (usually a merge of the pattern's subterm simplification attributes) +and the desired one. + +As an example, let us assume that the default attribute is +@Simplified (Partly, Condition c)@ and that we would want the attribute to be +@Simplified (Fully, Any)@. + +Then let us notice that the term needs the condition @c@ (most likely because +one of its subterms is simplified only with it as a side condition), and that +the term and its subterms went through the simplifier (the 'Partly' tag), so +it's valid to mark it as fully simplified. The result will be +"Simplified (Fully, Condition c)". +-} +simplifiedTo :: + HasCallStack => + -- | Default value + Simplified -> + -- | Desired state + Simplified -> + Simplified +NotSimplified `simplifiedTo` NotSimplified = NotSimplified +_ `simplifiedTo` NotSimplified = + error "Should not make sense to upgrade something else to NotSimplified." +NotSimplified `simplifiedTo` _ = + error "Cannot upgrade NotSimplified to something else." +Simplified_ _ _ `simplifiedTo` s@(Simplified_ Fully Unknown) = s +Simplified_ _ Unknown `simplifiedTo` Simplified_ Fully _ = + Simplified_ Fully Unknown +Simplified_ _ (Condition c1) `simplifiedTo` s@(Simplified_ Fully (Condition c2)) = + if c1 == c2 + then s + else Simplified_ Fully Unknown +Simplified_ _ Any `simplifiedTo` s@(Simplified_ Fully (Condition _)) = s +Simplified_ _ c@(Condition _) `simplifiedTo` Simplified_ Fully Any = + Simplified_ Fully c +Simplified_ _ Any `simplifiedTo` s@(Simplified_ Fully Any) = s +s1@(Simplified_ _ _) `simplifiedTo` s2@(Simplified_ Partly _) = s1 <> s2 + +{- | Is the pattern fully simplified under the given side condition? + +See also: 'isSimplifiedAnyCondition', 'isSimplifiedSomeCondition'. +-} +isSimplified :: SideCondition.Representation -> Simplified -> Bool +isSimplified _ (Simplified_ Fully Any) = True +isSimplified currentCondition (Simplified_ Fully (Condition condition)) = + currentCondition == condition +isSimplified _ (Simplified_ Fully Unknown) = False +isSimplified _ (Simplified_ Partly _) = False +isSimplified _ NotSimplified = False + +{- | Is the pattern fully simplified under any side condition? + +See also: 'isSimplified', 'isSimplifiedSomeCondition'. +-} +isSimplifiedAnyCondition :: Simplified -> Bool +isSimplifiedAnyCondition (Simplified_ Fully Any) = True +isSimplifiedAnyCondition (Simplified_ Fully (Condition _)) = False +isSimplifiedAnyCondition (Simplified_ Fully Unknown) = False +isSimplifiedAnyCondition (Simplified_ Partly _) = False +isSimplifiedAnyCondition NotSimplified = False + +{- | Is the pattern fully simplified under some side condition? + +See also: 'isSimplified', 'isSimplifiedAnyCondition'. +-} +isSimplifiedSomeCondition :: Simplified -> Bool +isSimplifiedSomeCondition (Simplified_ Fully _) = True +isSimplifiedSomeCondition _ = False + +fullySimplified :: Simplified +fullySimplified = Simplified_ Fully Any + +simplifiedConditionally :: SideCondition.Representation -> Simplified +simplifiedConditionally c = Simplified_ Fully (Condition c) + +simplifiableConditionally :: SideCondition.Representation -> Simplified +simplifiableConditionally c = Simplified_ Partly (Condition c) + +alwaysSimplified :: a -> Simplified +alwaysSimplified = const fullySimplified +{-# INLINE alwaysSimplified #-} + +notSimplified :: Foldable a => a Simplified -> Simplified +notSimplified a + | null a = NotSimplified + | otherwise = fold a <> Simplified_ Partly Any +{-# INLINE notSimplified #-} + +{- | Provides a short and incomplete textual description of a 'Simplified' +object, suitable for use as an explanatory comment when unparsing patterns. + +There is no tag for "NotSimplified", since that's the default state. + +Otherwise, the tag starts with a prefix that should be unique among all +attributes that have tags in order to prevent confusion ("S"), followed +by short representations of the 'Type' and 'Condition'. +-} +unparseTag :: Simplified -> Maybe Text +unparseTag (Simplified_ ty condition) = + Just $ "S" <> typeRepresentation ty <> conditionRepresentation condition + where + typeRepresentation Fully = "f" + typeRepresentation Partly = "p" + + conditionRepresentation Any = "a" + conditionRepresentation (Condition _) = "c" + conditionRepresentation Unknown = "u" +unparseTag NotSimplified = Nothing + +instance Synthetic Simplified (Bottom sort) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Top sort) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Const StringLiteral) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Const InternalBytes) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Const (SomeVariable variable)) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Exists sort variable) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Forall sort variable) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (And sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Or sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Not sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Application head) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Ceil sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Floor sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (DomainValue sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Equals sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (In sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Implies sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Iff sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Mu variable) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Nu variable) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Next sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified (Rewrites sort) where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified Inhabitant where + synthetic = notSimplified + {-# INLINE synthetic #-} + +instance Synthetic Simplified Inj where + synthetic = synthetic . Inj.toApplication + {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Attribute/PredicatePattern.hs b/kore/src/Kore/Attribute/PredicatePattern.hs index 771da4cba4..e1da464895 100644 --- a/kore/src/Kore/Attribute/PredicatePattern.hs +++ b/kore/src/Kore/Attribute/PredicatePattern.hs @@ -6,6 +6,12 @@ License : BSD-3-Clause -} module Kore.Attribute.PredicatePattern ( PredicatePattern (PredicatePattern, freeVariables), + -- simplified is excluded on purpose + simplifiedAttribute, + isSimplified, + isSimplifiedAnyCondition, + isSimplifiedSomeCondition, + setSimplified, mapVariables, traverseVariables, deleteFreeVariable, @@ -24,14 +30,28 @@ import Kore.Attribute.Pattern.FreeVariables hiding ( import qualified Kore.Attribute.Pattern.FreeVariables as FreeVariables ( freeVariables, ) +import Kore.Attribute.Pattern.Simplified hiding ( + isSimplified, + isSimplifiedAnyCondition, + isSimplifiedSomeCondition, + ) +import qualified Kore.Attribute.Pattern.Simplified as Simplified ( + isSimplified, + isSimplifiedAnyCondition, + isSimplifiedSomeCondition, + ) import Kore.Attribute.Synthetic import Kore.Debug +import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( + Representation, + ) import Kore.Syntax.Variable import Prelude.Kore -- | @Pattern@ are the attributes of a pattern collected during verification. -newtype PredicatePattern variable = PredicatePattern - { freeVariables :: FreeVariables variable +data PredicatePattern variable = PredicatePattern + { freeVariables :: !(FreeVariables variable) + , simplified :: !Simplified } deriving stock (Eq, GHC.Generic, Show) @@ -51,14 +71,45 @@ instance (Debug variable, Diff variable) => Diff (PredicatePattern variable) instance ( Functor base , Synthetic (FreeVariables variable) base + , Synthetic Simplified base ) => Synthetic (PredicatePattern variable) base where synthetic base = PredicatePattern { freeVariables = synthetic (freeVariables <$> base) + , simplified = synthetic (simplified <$> base) } +simplifiedAttribute :: PredicatePattern variable -> Simplified +simplifiedAttribute PredicatePattern{simplified} = simplified + +{- Checks whether the pattern is simplified relative to the given side +condition. +-} +isSimplified :: + SideCondition.Representation -> PredicatePattern variable -> Bool +isSimplified sideCondition = Simplified.isSimplified sideCondition . simplifiedAttribute + +{- Checks whether the pattern is simplified relative to some side condition. +-} +isSimplifiedSomeCondition :: + PredicatePattern variable -> Bool +isSimplifiedSomeCondition = + Simplified.isSimplifiedSomeCondition . simplifiedAttribute + +{- Checks whether the pattern is simplified relative to any side condition. +-} +isSimplifiedAnyCondition :: PredicatePattern variable -> Bool +isSimplifiedAnyCondition PredicatePattern{simplified} = + Simplified.isSimplifiedAnyCondition simplified + +setSimplified :: + Simplified -> + PredicatePattern variable -> + PredicatePattern variable +setSimplified simplified patt = patt{simplified} + {- | Use the provided mapping to replace all variables in a 'Pattern'. See also: 'traverseVariables' diff --git a/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs b/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs index c76e7bf42b..1c43c314b1 100644 --- a/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs +++ b/kore/src/Kore/Builtin/AssocComm/CeilSimplifier.hs @@ -96,6 +96,10 @@ newSetCeilSimplifier = mkInternalAc (fromElement element){opaque = [termLike]} & TermLike.mkInternalSet & makeCeilPredicate + -- TODO (thomas.tuegel): Do not mark this simplified. + -- Marking here may prevent user-defined axioms from applying. + -- At present, we wouldn't apply such an axiom, anyway. + & Predicate.markSimplifiedMaybeConditional Nothing runCeilSimplifier ( newBuiltinAssocCommCeilSimplifier TermLike.mkInternalSet @@ -119,6 +123,10 @@ newMapCeilSimplifier = mkInternalAc (fromElement element'){opaque = [termLike]} & TermLike.mkInternalMap & makeCeilPredicate + -- TODO (thomas.tuegel): Do not mark this simplified. + -- Marking here may prevent user-defined axioms from applying. + -- At present, we wouldn't apply such an axiom, anyway. + & Predicate.markSimplifiedMaybeConditional Nothing & makeForallPredicate variable where (variable, element') = @@ -308,6 +316,10 @@ definePairWiseElements mkBuiltin mkNotMember internalAc pairWiseElements = do } & mkBuiltin & makeCeilPredicate + -- TODO (thomas.tuegel): Do not mark this simplified. + -- Marking here may prevent user-defined axioms from applying. + -- At present, we wouldn't apply such an axiom, anyway. + & Predicate.markSimplifiedMaybeConditional Nothing & OrCondition.fromPredicate & MultiAnd.singleton diff --git a/kore/src/Kore/Builtin/AssociativeCommutative.hs b/kore/src/Kore/Builtin/AssociativeCommutative.hs index 7e85ceac37..38c74b6201 100644 --- a/kore/src/Kore/Builtin/AssociativeCommutative.hs +++ b/kore/src/Kore/Builtin/AssociativeCommutative.hs @@ -58,6 +58,9 @@ import qualified Data.Reflection as Reflection import Data.Text (Text) import qualified GHC.Generics as GHC import qualified Generics.SOP as SOP +import qualified Kore.Attribute.Pattern.Simplified as Attribute ( + Simplified, + ) import qualified Kore.Attribute.Symbol as Attribute ( Symbol, ) @@ -175,6 +178,9 @@ class TermLike variable -> Maybe (normalized Key (TermLike variable)) + simplifiedAttributeValue :: + Value normalized (TermLike variable) -> Attribute.Simplified + instance TermWrapper NormalizedMap where asInternalBuiltin tools builtinAcSort builtinAcChild = InternalAc @@ -229,6 +235,8 @@ instance TermWrapper NormalizedMap where , opaque = [patt] } + simplifiedAttributeValue = TermLike.simplifiedAttribute . getMapValue + instance TermWrapper NormalizedSet where asInternalBuiltin tools builtinAcSort builtinAcChild = InternalAc @@ -278,6 +286,8 @@ instance TermWrapper NormalizedSet where (Normalized . wrapAc) emptyNormalizedAc{opaque = [patt]} + simplifiedAttributeValue SetValue = mempty + {- | Wrapper for terms that keeps the "concrete" vs "with variable" distinction after converting @TermLike Concrete@ to @TermLike variable@. -} @@ -720,7 +730,24 @@ unifyEqualsNormalized renormalized <- normalize1 normalizedTerm let unifierTerm :: TermLike RewritingVariableName - unifierTerm = asInternal tools sort1 renormalized + unifierTerm = markSimplified $ asInternal tools sort1 renormalized + + markSimplified = + TermLike.setSimplified + ( foldMap TermLike.simplifiedAttribute opaque + <> foldMap TermLike.simplifiedAttribute abstractKeys + <> foldMap simplifiedAttributeValue abstractValues + <> foldMap simplifiedAttributeValue concreteValues + ) + where + unwrapped = unwrapAc renormalized + NormalizedAc{opaque} = unwrapped + (abstractKeys, abstractValues) = + (unzip . map unwrapElement) + (elementsWithVariables unwrapped) + (_, concreteValues) = + (unzip . HashMap.toList) + (concreteElements unwrapped) return (unifierTerm `Pattern.withCondition` unifierCondition) where diff --git a/kore/src/Kore/Builtin/Bool/Bool.hs b/kore/src/Kore/Builtin/Bool/Bool.hs index 4769cff551..86d5274239 100644 --- a/kore/src/Kore/Builtin/Bool/Bool.hs +++ b/kore/src/Kore/Builtin/Bool/Bool.hs @@ -39,6 +39,9 @@ import Kore.Internal.TermLike ( TermLike, mkInternalBool, ) +import qualified Kore.Internal.TermLike as TermLike ( + markSimplified, + ) import Prelude.Kore -- | Builtin name of the @Bool@ sort. @@ -60,7 +63,7 @@ asInternal :: Bool -> TermLike variable asInternal builtinBoolSort builtinBoolValue = - mkInternalBool $ + TermLike.markSimplified . mkInternalBool $ asBuiltin builtinBoolSort builtinBoolValue asBuiltin :: diff --git a/kore/src/Kore/Builtin/Endianness/Endianness.hs b/kore/src/Kore/Builtin/Endianness/Endianness.hs index b40a582515..63a5b312cd 100644 --- a/kore/src/Kore/Builtin/Endianness/Endianness.hs +++ b/kore/src/Kore/Builtin/Endianness/Endianness.hs @@ -20,6 +20,7 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Internal.Symbol import Kore.Sort @@ -71,6 +72,10 @@ instance Synthetic Defined (Const Endianness) where synthetic = const (Defined True) {-# INLINE synthetic #-} +instance Synthetic Simplified (Const Endianness) where + synthetic = const fullySimplified + {-# INLINE synthetic #-} + instance Synthetic ConstructorLike (Const Endianness) where synthetic = -- Endianness symbols are constructors diff --git a/kore/src/Kore/Builtin/Int/Int.hs b/kore/src/Kore/Builtin/Int/Int.hs index e76c190005..8a28485967 100644 --- a/kore/src/Kore/Builtin/Int/Int.hs +++ b/kore/src/Kore/Builtin/Int/Int.hs @@ -72,7 +72,7 @@ asInternal :: Integer -> TermLike variable asInternal builtinIntSort builtinIntValue = - TermLike.fromConcrete . mkInternalInt $ + TermLike.fromConcrete . TermLike.markSimplified . mkInternalInt $ asBuiltin builtinIntSort builtinIntValue asBuiltin :: diff --git a/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs b/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs index 2431a6ef2f..39bddce699 100644 --- a/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs +++ b/kore/src/Kore/Builtin/InternalBytes/InternalBytes.hs @@ -51,6 +51,7 @@ import Kore.Internal.TermLike ( mkInternalBytes, ) import qualified Kore.Internal.TermLike as TermLike ( + markSimplified, pattern App_, pattern StringLiteral_, ) @@ -75,7 +76,7 @@ asInternal :: ByteString -> TermLike variable asInternal bytesSort bytesValue = - mkInternalBytes bytesSort bytesValue + TermLike.markSimplified $ mkInternalBytes bytesSort bytesValue internalize :: InternalVariable variable => diff --git a/kore/src/Kore/Builtin/List.hs b/kore/src/Kore/Builtin/List.hs index 8048cfe383..deada77daf 100644 --- a/kore/src/Kore/Builtin/List.hs +++ b/kore/src/Kore/Builtin/List.hs @@ -98,6 +98,7 @@ import Kore.Internal.TermLike ( import qualified Kore.Internal.TermLike as TermLike ( Symbol (..), isFunctionPattern, + markSimplified, ) import Kore.Log.DebugUnifyBottom ( debugUnifyBottom, @@ -477,7 +478,8 @@ unifyEquals unified <- sequence $ Seq.zipWith simplifyChild list1 list2 let propagatedUnified = propagateConditions unified result = - asInternal tools internalListSort + TermLike.markSimplified + . asInternal tools internalListSort <$> propagatedUnified return result where @@ -505,7 +507,7 @@ unifyEquals internal2 suffixUnified <- simplifyChild frame2 listSuffix1 let result = - mkInternalList internal1 + TermLike.markSimplified (mkInternalList internal1) <$ prefixUnified <* suffixUnified return result @@ -581,7 +583,7 @@ unifyEquals frame1 suffix2Frame2 let result = - initial + TermLike.markSimplified initial <$ prefixUnified <* suffixUnified return result @@ -590,7 +592,7 @@ unifyEquals unifyEqualsConcrete internal1 internal2 suffixUnified <- simplifyChild frame1 frame2 let result = - initial + TermLike.markSimplified initial <$ prefixUnified <* suffixUnified return result @@ -628,13 +630,13 @@ unifyEquals internal1 internal2{internalListChild = suffix2} let result = - initial <$ prefixUnified <* suffixUnified + TermLike.markSimplified initial <$ prefixUnified <* suffixUnified return result | length1 == length2 = do prefixUnified <- simplifyChild frame1 frame2 suffixUnified <- unifyEqualsConcrete internal1 internal2 let result = - initial + TermLike.markSimplified initial <$ prefixUnified <* suffixUnified return result diff --git a/kore/src/Kore/Builtin/Signedness/Signedness.hs b/kore/src/Kore/Builtin/Signedness/Signedness.hs index 5c3a402c80..9c8680f1aa 100644 --- a/kore/src/Kore/Builtin/Signedness/Signedness.hs +++ b/kore/src/Kore/Builtin/Signedness/Signedness.hs @@ -20,6 +20,7 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Internal.Symbol import Kore.Sort @@ -62,6 +63,10 @@ instance Synthetic Defined (Const Signedness) where synthetic = const (Defined True) {-# INLINE synthetic #-} +instance Synthetic Simplified (Const Signedness) where + synthetic = const fullySimplified + {-# INLINE synthetic #-} + instance Synthetic ConstructorLike (Const Signedness) where synthetic = -- Signedness symbols are constructors diff --git a/kore/src/Kore/Equation/Application.hs b/kore/src/Kore/Equation/Application.hs index 94fef5edee..9f29b482a1 100644 --- a/kore/src/Kore/Equation/Application.hs +++ b/kore/src/Kore/Equation/Application.hs @@ -399,7 +399,9 @@ checkRequires sideCondition predicate requires = -- Pair a configuration with sideCondition for evaluation by the solver. withSideCondition = (,) sideCondition - withoutAxioms = Simplifier.localSimplifierAxioms (const mempty) + withoutAxioms = + fmap Condition.forgetSimplified + . Simplifier.localSimplifierAxioms (const mempty) withAxioms = id refreshVariables :: diff --git a/kore/src/Kore/Equation/Simplification.hs b/kore/src/Kore/Equation/Simplification.hs index 221a87e786..622ba404df 100644 --- a/kore/src/Kore/Equation/Simplification.hs +++ b/kore/src/Kore/Equation/Simplification.hs @@ -84,12 +84,12 @@ simplifyEquation equation@(Equation _ _ _ _ _ _ _) = ensures' = substitute subst ensures return Equation - { left = left' - , requires = requires' + { left = TermLike.forgetSimplified left' + , requires = Predicate.forgetSimplified requires' , argument = Nothing - , antiLeft = antiLeft' - , right = right' - , ensures = ensures' + , antiLeft = Predicate.forgetSimplified <$> antiLeft' + , right = TermLike.forgetSimplified right' + , ensures = Predicate.forgetSimplified ensures' , attributes = attributes } & Logic.observeAllT diff --git a/kore/src/Kore/Internal/Condition.hs b/kore/src/Kore/Internal/Condition.hs index 7da7f20659..04223f0aff 100644 --- a/kore/src/Kore/Internal/Condition.hs +++ b/kore/src/Kore/Internal/Condition.hs @@ -4,6 +4,13 @@ License : BSD-3-Clause -} module Kore.Internal.Condition ( Condition, + isSimplified, + simplifiedAttribute, + forgetSimplified, + markSimplified, + Conditional.markPredicateSimplified, + Conditional.markPredicateSimplifiedConditional, + Conditional.setPredicateSimplified, eraseConditionalTerm, top, bottom, @@ -29,6 +36,9 @@ import Kore.Attribute.Pattern.FreeVariables ( freeVariables, isFreeVariable, ) +import qualified Kore.Attribute.Pattern.Simplified as Attribute ( + Simplified, + ) import Kore.Internal.Conditional ( Condition, Conditional (..), @@ -38,14 +48,52 @@ import Kore.Internal.Predicate ( Predicate, ) import qualified Kore.Internal.Predicate as Predicate +import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( + Representation, + ) import Kore.Internal.Substitution ( Normalization (..), ) import qualified Kore.Internal.Substitution as Substitution +import qualified Kore.Internal.TermLike as TermLike ( + simplifiedAttribute, + ) import Kore.Internal.Variable import Kore.Syntax import Prelude.Kore +isSimplified :: SideCondition.Representation -> Condition variable -> Bool +isSimplified sideCondition Conditional{term = (), predicate, substitution} = + Predicate.isSimplified sideCondition predicate + && Substitution.isSimplified sideCondition substitution + +simplifiedAttribute :: Condition variable -> Attribute.Simplified +simplifiedAttribute Conditional{term = (), predicate, substitution} = + Predicate.simplifiedAttribute predicate + <> Substitution.simplifiedAttribute substitution + +forgetSimplified :: + InternalVariable variable => + Condition variable -> + Condition variable +forgetSimplified Conditional{term = (), predicate, substitution} = + Conditional + { term = () + , predicate = Predicate.forgetSimplified predicate + , substitution = Substitution.forgetSimplified substitution + } + +markSimplified :: + InternalVariable variable => + Condition variable -> + Condition variable +markSimplified Conditional{term = (), predicate, substitution} = + Conditional + { term = () + , predicate = Predicate.markSimplified predicate + , substitution = Substitution.markSimplified substitution + } + -- | Erase the @Conditional@ 'term' to yield a 'Condition'. eraseConditionalTerm :: Conditional variable child -> @@ -123,8 +171,16 @@ fromNormalizationSimplified where predicate' = Conditional.fromPredicate + . markSimplifiedIfChildrenSimplified denormalized . Substitution.toPredicate $ Substitution.wrap denormalized substitution' = Conditional.fromSubstitution $ Substitution.unsafeWrapFromAssignments normalized + markSimplifiedIfChildrenSimplified childrenList result = + Predicate.setSimplified childrenSimplified result + where + childrenSimplified = + foldMap + (TermLike.simplifiedAttribute . Substitution.assignedTerm) + childrenList diff --git a/kore/src/Kore/Internal/Conditional.hs b/kore/src/Kore/Internal/Conditional.hs index 50ced781c3..2a25e55fa5 100644 --- a/kore/src/Kore/Internal/Conditional.hs +++ b/kore/src/Kore/Internal/Conditional.hs @@ -20,6 +20,9 @@ module Kore.Internal.Conditional ( Kore.Internal.Conditional.mapVariables, isNormalized, assertNormalized, + markPredicateSimplified, + markPredicateSimplifiedConditional, + setPredicateSimplified, ) where import Data.Map.Strict ( @@ -30,6 +33,9 @@ import qualified Generics.SOP as SOP import Kore.Attribute.Pattern.FreeVariables ( HasFreeVariables (..), ) +import qualified Kore.Attribute.Pattern.Simplified as Attribute ( + Simplified, + ) import Kore.Debug import Kore.Internal.MultiAnd ( MultiAnd, @@ -506,3 +512,44 @@ assertNormalized Conditional{predicate, substitution} a = & assert (Predicate.isFreeOf predicate variables) where variables = Substitution.variables substitution + +{- | Marks the condition's predicate as being simplified. + +Since the substitution is usually simplified, this usually marks the entire +condition as simplified. Note however, that the way in which the condition +is simplified is a combination of the predicate and substitution +simplifications. As an example, if the predicate is fully simplified, +while the substitution is simplified only for a certain side condition, +the entire condition is simplified only for that side condition. +-} +markPredicateSimplified :: + (HasCallStack, InternalVariable variable) => + Conditional variable term -> + Conditional variable term +markPredicateSimplified conditional@Conditional{predicate} = + conditional{predicate = Predicate.markSimplified predicate} + +markPredicateSimplifiedConditional :: + (HasCallStack, InternalVariable variable) => + SideCondition.Representation -> + Conditional variable term -> + Conditional variable term +markPredicateSimplifiedConditional + sideCondition + conditional@Conditional{predicate} = + conditional + { predicate = + Predicate.markSimplifiedConditional sideCondition predicate + } + +{- | Sets the simplified attribute for a condition's predicate. + +See 'markPredicateSimplified' for details. +-} +setPredicateSimplified :: + (InternalVariable variable) => + Attribute.Simplified -> + Conditional variable term -> + Conditional variable term +setPredicateSimplified simplified conditional@Conditional{predicate} = + conditional{predicate = Predicate.setSimplified simplified predicate} diff --git a/kore/src/Kore/Internal/InternalBool.hs b/kore/src/Kore/Internal/InternalBool.hs index 937d059544..2a00b4745d 100644 --- a/kore/src/Kore/Internal/InternalBool.hs +++ b/kore/src/Kore/Internal/InternalBool.hs @@ -14,6 +14,7 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Sort @@ -74,3 +75,7 @@ instance Synthetic Function (Const InternalBool) where instance Synthetic Functional (Const InternalBool) where synthetic = alwaysFunctional {-# INLINE synthetic #-} + +instance Synthetic Simplified (Const InternalBool) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/InternalInt.hs b/kore/src/Kore/Internal/InternalInt.hs index ca7f03aa71..71bf967eeb 100644 --- a/kore/src/Kore/Internal/InternalInt.hs +++ b/kore/src/Kore/Internal/InternalInt.hs @@ -14,6 +14,7 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Sort @@ -61,3 +62,7 @@ instance Synthetic Function (Const InternalInt) where instance Synthetic Functional (Const InternalInt) where synthetic = alwaysFunctional {-# INLINE synthetic #-} + +instance Synthetic Simplified (Const InternalInt) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/InternalList.hs b/kore/src/Kore/Internal/InternalList.hs index e5d2c6950a..b0dd72c084 100644 --- a/kore/src/Kore/Internal/InternalList.hs +++ b/kore/src/Kore/Internal/InternalList.hs @@ -18,6 +18,7 @@ import Kore.Attribute.Pattern.FreeVariables ( ) import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Internal.Symbol ( @@ -107,3 +108,7 @@ instance Synthetic Function InternalList where instance Synthetic Functional InternalList where synthetic = fold {-# INLINE synthetic #-} + +instance Synthetic Simplified InternalList where + synthetic = notSimplified + {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/InternalMap.hs b/kore/src/Kore/Internal/InternalMap.hs index 27a654851c..47c88bf473 100644 --- a/kore/src/Kore/Internal/InternalMap.hs +++ b/kore/src/Kore/Internal/InternalMap.hs @@ -24,6 +24,7 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Internal.NormalizedAc @@ -123,6 +124,10 @@ instance Synthetic Sort (InternalMap key) where synthetic = builtinAcSort {-# INLINE synthetic #-} +instance Synthetic Simplified (InternalMap key) where + synthetic = notSimplified + {-# INLINE synthetic #-} + instance HasConstructorLike (Value NormalizedMap ConstructorLike) where extractConstructorLike (MapValue result) = result diff --git a/kore/src/Kore/Internal/InternalSet.hs b/kore/src/Kore/Internal/InternalSet.hs index f5f3bcea2e..def12d6815 100644 --- a/kore/src/Kore/Internal/InternalSet.hs +++ b/kore/src/Kore/Internal/InternalSet.hs @@ -25,6 +25,7 @@ import Kore.Attribute.Pattern.FreeVariables hiding ( ) import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Internal.NormalizedAc @@ -132,6 +133,10 @@ instance Synthetic Functional (InternalAc key NormalizedSet) where normalizedAcFunctional builtinSetChild {-# INLINE synthetic #-} +instance Synthetic Simplified (InternalAc key NormalizedSet) where + synthetic = notSimplified + {-# INLINE synthetic #-} + instance HasConstructorLike (Value NormalizedSet ConstructorLike) where extractConstructorLike SetValue = ConstructorLike . Just $ ConstructorLikeHead diff --git a/kore/src/Kore/Internal/InternalString.hs b/kore/src/Kore/Internal/InternalString.hs index 1fffc478e7..606eb4ebb7 100644 --- a/kore/src/Kore/Internal/InternalString.hs +++ b/kore/src/Kore/Internal/InternalString.hs @@ -17,6 +17,7 @@ import Kore.Attribute.Pattern.Defined import Kore.Attribute.Pattern.FreeVariables import Kore.Attribute.Pattern.Function import Kore.Attribute.Pattern.Functional +import Kore.Attribute.Pattern.Simplified import Kore.Attribute.Synthetic import Kore.Debug import Kore.Sort @@ -70,3 +71,7 @@ instance Synthetic Function (Const InternalString) where instance Synthetic Functional (Const InternalString) where synthetic = alwaysFunctional {-# INLINE synthetic #-} + +instance Synthetic Simplified (Const InternalString) where + synthetic = alwaysSimplified + {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Internal/OrCondition.hs b/kore/src/Kore/Internal/OrCondition.hs index 4eb8b5fcea..4dc2151368 100644 --- a/kore/src/Kore/Internal/OrCondition.hs +++ b/kore/src/Kore/Internal/OrCondition.hs @@ -4,6 +4,7 @@ License : BSD-3-Clause -} module Kore.Internal.OrCondition ( OrCondition, + isSimplified, toConditions, fromConditions, fromCondition, @@ -44,6 +45,9 @@ import Prelude.Kore -- | The disjunction of 'Condition'. type OrCondition variable = MultiOr (Condition variable) +isSimplified :: SideCondition.Representation -> OrCondition variable -> Bool +isSimplified sideCondition = all (Condition.isSimplified sideCondition) + -- | A "disjunction" of one 'Condition'. fromCondition :: Condition variable -> OrCondition variable fromCondition = from diff --git a/kore/src/Kore/Internal/OrPattern.hs b/kore/src/Kore/Internal/OrPattern.hs index eb7cc6bce3..4175e4c1ba 100644 --- a/kore/src/Kore/Internal/OrPattern.hs +++ b/kore/src/Kore/Internal/OrPattern.hs @@ -5,6 +5,11 @@ License : BSD-3-Clause module Kore.Internal.OrPattern ( OrPattern, coerceSort, + markSimplified, + isSimplified, + hasSimplifiedChildren, + hasSimplifiedChildrenIgnoreConditions, + forgetSimplified, fromPatterns, toPatterns, fromPattern, @@ -76,6 +81,43 @@ import Prelude.Kore -- | The disjunction of 'Pattern'. type OrPattern variable = MultiOr (Pattern variable) +markSimplified :: + InternalVariable variable => + OrPattern variable -> + OrPattern variable +markSimplified = MultiOr.map Pattern.markSimplified + +isSimplified :: SideCondition.Representation -> OrPattern variable -> Bool +isSimplified sideCondition = all (Pattern.isSimplified sideCondition) + +{- | Checks whether all patterns in the disjunction have simplified children. + +See also: 'Pattern.hasSimplifiedChildren' +-} +hasSimplifiedChildren :: + InternalVariable variable => + SideCondition.Representation -> + OrPattern variable -> + Bool +hasSimplifiedChildren sideCondition = + all (Pattern.hasSimplifiedChildren sideCondition) + +{- | Checks whether all patterns in the disjunction have simplified children, +ignoring the conditions used to simplify them. + +See also: 'Pattern.hasSimplifiedChildrenIgnoreConditions' +-} +hasSimplifiedChildrenIgnoreConditions :: + InternalVariable variable => + OrPattern variable -> + Bool +hasSimplifiedChildrenIgnoreConditions = + all Pattern.hasSimplifiedChildrenIgnoreConditions + +forgetSimplified :: + InternalVariable variable => OrPattern variable -> OrPattern variable +forgetSimplified = fromPatterns . map Pattern.forgetSimplified . toPatterns + -- | A "disjunction" of one 'Pattern.Pattern'. fromPattern :: Pattern variable -> OrPattern variable fromPattern = from diff --git a/kore/src/Kore/Internal/Pattern.hs b/kore/src/Kore/Internal/Pattern.hs index 8653b43716..464c31d922 100644 --- a/kore/src/Kore/Internal/Pattern.hs +++ b/kore/src/Kore/Internal/Pattern.hs @@ -24,6 +24,12 @@ module Kore.Internal.Pattern ( topOf, fromTermLike, Kore.Internal.Pattern.freeElementVariables, + isSimplified, + hasSimplifiedChildren, + hasSimplifiedChildrenIgnoreConditions, + forgetSimplified, + markSimplified, + simplifiedAttribute, assign, requireDefined, fromMultiAnd, @@ -42,6 +48,9 @@ import Kore.Attribute.Pattern.FreeVariables ( freeVariables, getFreeElementVariables, ) +import qualified Kore.Attribute.Pattern.Simplified as Attribute ( + Simplified, + ) import Kore.Internal.Condition ( Condition, ) @@ -113,6 +122,66 @@ fromPredicateSorted :: Predicate variable -> Pattern variable fromPredicateSorted sort = fromCondition sort . Condition.fromPredicate +isSimplified :: SideCondition.Representation -> Pattern variable -> Bool +isSimplified sideCondition (splitTerm -> (t, p)) = + TermLike.isSimplified sideCondition t + && Condition.isSimplified sideCondition p + +{- | Checks whether the conjunction a 'Pattern' has simplified children. +A 'Pattern' is a conjunction at the top level: +@ +\\and{S}('term', \\and{S}('predicate', 'substitution')) +@ +where 'predicate' itself is generally a conjunction of many clauses. The +children of the 'Pattern' are considered simplified if the 'term' and +'substitution' are simplified and the individual clauses of the 'predicate' are +simplified. +-} +hasSimplifiedChildren :: + Ord variable => + SideCondition.Representation -> + Pattern variable -> + Bool +hasSimplifiedChildren sideCondition patt = + TermLike.isSimplified sideCondition term + && all (Predicate.isSimplified sideCondition) clauses + && Substitution.isSimplified sideCondition substitution + where + Conditional{term, predicate, substitution} = patt + clauses = Predicate.toMultiAnd predicate + +{- | Similar to 'hasSimplifiedChildren', only that it ignores the conditions +used to simplify the children. +-} +hasSimplifiedChildrenIgnoreConditions :: + Ord variable => + Pattern variable -> + Bool +hasSimplifiedChildrenIgnoreConditions patt = + TermLike.isSimplifiedSomeCondition term + && all Predicate.isSimplifiedSomeCondition clauses + && Substitution.isSimplifiedSomeCondition substitution + where + Conditional{term, predicate, substitution} = patt + clauses = Predicate.toMultiAnd predicate + +forgetSimplified :: + InternalVariable variable => Pattern variable -> Pattern variable +forgetSimplified patt = + TermLike.forgetSimplified term + `withCondition` Condition.forgetSimplified condition + where + (term, condition) = Conditional.splitTerm patt +markSimplified :: + InternalVariable variable => Pattern variable -> Pattern variable +markSimplified patt = + TermLike.markSimplified term + `withCondition` Condition.markSimplified condition + where + (term, condition) = Conditional.splitTerm patt +simplifiedAttribute :: Pattern variable -> Attribute.Simplified +simplifiedAttribute (splitTerm -> (t, p)) = + TermLike.simplifiedAttribute t <> Condition.simplifiedAttribute p freeElementVariables :: InternalVariable variable => Pattern variable -> diff --git a/kore/src/Kore/Internal/Predicate.hs b/kore/src/Kore/Internal/Predicate.hs index cd6008ed32..79d911dee6 100644 --- a/kore/src/Kore/Internal/Predicate.hs +++ b/kore/src/Kore/Internal/Predicate.hs @@ -31,11 +31,19 @@ module Kore.Internal.Predicate ( getMultiOrPredicate, NotPredicate, isPredicate, + simplifiedAttribute, + isSimplified, + isSimplifiedSomeCondition, isFreeOf, freeElementVariables, hasFreeVariable, mapVariables, depth, + markSimplified, + markSimplifiedConditional, + markSimplifiedMaybeConditional, + setSimplified, + forgetSimplified, wrapPredicate, containsSymbolWithIdPred, refreshExists, @@ -85,6 +93,7 @@ import qualified Kore.Attribute.Pattern.FreeVariables as Attribute.FreeVariables toNames, toSet, ) +import qualified Kore.Attribute.Pattern.Simplified as Attribute import Kore.Attribute.PredicatePattern ( PredicatePattern, ) @@ -181,6 +190,22 @@ instance Ord variable => Synthetic (Attribute.FreeVariables variable) (Predicate OrF or' -> synthetic or' TopF top -> synthetic top +instance Synthetic Attribute.Simplified (PredicateF variable) where + synthetic = \case + AndF and' -> synthetic and' + BottomF bottom -> synthetic bottom + CeilF ceil -> synthetic (TermLike.simplifiedAttribute <$> ceil) + EqualsF equals -> synthetic (TermLike.simplifiedAttribute <$> equals) + ExistsF exists -> synthetic exists + FloorF floor' -> synthetic (TermLike.simplifiedAttribute <$> floor') + ForallF forall' -> synthetic forall' + IffF iff -> synthetic iff + ImpliesF implies -> synthetic implies + InF in' -> synthetic (TermLike.simplifiedAttribute <$> in') + NotF not' -> synthetic not' + OrF or' -> synthetic or' + TopF top -> synthetic top + instance From (Ceil () (TermLike variable)) (PredicateF variable child) where from = CeilF {-# INLINE from #-} @@ -549,20 +574,22 @@ fromPredicate :: fromPredicate sort = Recursive.fold worker where worker (pat :< predF) = - case predF of - AndF (And () t1 t2) -> TermLike.mkAnd t1 t2 - BottomF _ -> TermLike.mkBottom sort - CeilF (Ceil () () t) -> TermLike.mkCeil sort t - EqualsF (Equals () () t1 t2) -> TermLike.mkEquals sort t1 t2 - ExistsF (Exists () v t) -> TermLike.mkExists v t - FloorF (Floor () () t) -> TermLike.mkFloor sort t - ForallF (Forall () v t) -> TermLike.mkForall v t - IffF (Iff () t1 t2) -> TermLike.mkIff t1 t2 - ImpliesF (Implies () t1 t2) -> TermLike.mkImplies t1 t2 - InF (In () () t1 t2) -> TermLike.mkIn sort t1 t2 - NotF (Not () t) -> TermLike.mkNot t - OrF (Or () t1 t2) -> TermLike.mkOr t1 t2 - TopF _ -> TermLike.mkTop sort + TermLike.setSimplified + (PredicatePattern.simplifiedAttribute pat) + $ case predF of + AndF (And () t1 t2) -> TermLike.mkAnd t1 t2 + BottomF _ -> TermLike.mkBottom sort + CeilF (Ceil () () t) -> TermLike.mkCeil sort t + EqualsF (Equals () () t1 t2) -> TermLike.mkEquals sort t1 t2 + ExistsF (Exists () v t) -> TermLike.mkExists v t + FloorF (Floor () () t) -> TermLike.mkFloor sort t + ForallF (Forall () v t) -> TermLike.mkForall v t + IffF (Iff () t1 t2) -> TermLike.mkIff t1 t2 + ImpliesF (Implies () t1 t2) -> TermLike.mkImplies t1 t2 + InF (In () () t1 t2) -> TermLike.mkIn sort t1 t2 + NotF (Not () t) -> TermLike.mkNot t + OrF (Or () t1 t2) -> TermLike.mkOr t1 t2 + TopF _ -> TermLike.mkTop sort fromPredicate_ :: InternalVariable variable => @@ -964,6 +991,7 @@ makePredicate t = fst <$> makePredicateWorker t childChanged :: HasChanged childChanged = foldMap dropPredicate termWithChanged + oldSimplified = TermLike.attributeSimplifiedAttribute att (predicate, topChanged) <- case patE of TermLike.TopF _ -> return makeTruePredicate' TermLike.BottomF _ -> return makeFalsePredicate' @@ -990,7 +1018,7 @@ makePredicate t = fst <$> makePredicateWorker t return $ case topChanged <> childChanged of Changed -> (predicate, Changed) NotChanged -> - (predicate, NotChanged) + (setSimplified oldSimplified predicate, NotChanged) makePredicateTopDown :: TermLike variable -> @@ -1017,7 +1045,9 @@ makePredicate t = fst <$> makePredicateWorker t setSmp (p, NotChanged) = Left $ pure - (p, NotChanged) + (setSimplified oldSimplified p, NotChanged) + + oldSimplified = TermLike.attributeSimplifiedAttribute att isPredicate :: InternalVariable variable => TermLike variable -> Bool isPredicate = Either.isRight . makePredicate @@ -1028,6 +1058,149 @@ extractAttributes (Recursive.project -> attr :< _) = attr instance Attribute.HasFreeVariables (Predicate variable) variable where freeVariables = Attribute.freeVariables . extractAttributes +simplifiedAttribute :: Predicate variable -> Attribute.Simplified +simplifiedAttribute = PredicatePattern.simplifiedAttribute . extractAttributes + +{- | Is the 'Predicate' fully simplified under the given side condition? + +See also: 'isSimplifiedSomeCondition'. +-} +isSimplified :: SideCondition.Representation -> Predicate variable -> Bool +isSimplified condition = PredicatePattern.isSimplified condition . extractAttributes + +{- | Is the 'Predicate' fully simplified under some side condition? + +See also: 'isSimplified'. +-} +isSimplifiedSomeCondition :: Predicate variable -> Bool +isSimplifiedSomeCondition = + PredicatePattern.isSimplifiedSomeCondition . extractAttributes + +cannotSimplifyNotSimplifiedError :: + (HasCallStack, InternalVariable variable) => + PredicateF variable (Predicate variable) -> + a +cannotSimplifyNotSimplifiedError predF = + error + ( "Unexpectedly marking term with NotSimplified children as simplified:\n" + ++ show predF + ++ "\n" + ++ unparseToString term + ) + where + term = fromPredicate_ (synthesize predF) + +simplifiedFromChildren :: + HasCallStack => + PredicateF variable (Predicate variable) -> + Attribute.Simplified +simplifiedFromChildren predF = + case mergedSimplified of + Attribute.NotSimplified -> Attribute.NotSimplified + _ -> mergedSimplified `Attribute.simplifiedTo` Attribute.fullySimplified + where + mergedSimplified = case predF of + CeilF ceil' -> foldMap TermLike.simplifiedAttribute ceil' + FloorF floor' -> foldMap TermLike.simplifiedAttribute floor' + EqualsF equals' -> foldMap TermLike.simplifiedAttribute equals' + InF in' -> foldMap TermLike.simplifiedAttribute in' + _ -> foldMap simplifiedAttribute predF + +checkedSimplifiedFromChildren :: + (HasCallStack, InternalVariable variable) => + PredicateF variable (Predicate variable) -> + Attribute.Simplified +checkedSimplifiedFromChildren predF = + case simplifiedFromChildren predF of + Attribute.NotSimplified -> cannotSimplifyNotSimplifiedError predF + simplified -> simplified + +markSimplified :: + (HasCallStack, InternalVariable variable) => + Predicate variable -> + Predicate variable +markSimplified (Recursive.project -> attrs :< predF) = + Recursive.embed + ( PredicatePattern.setSimplified + (checkedSimplifiedFromChildren predF) + attrs + :< predF + ) + +markSimplifiedConditional :: + (HasCallStack, InternalVariable variable) => + SideCondition.Representation -> + Predicate variable -> + Predicate variable +markSimplifiedConditional + condition + (Recursive.project -> attrs :< predF) = + Recursive.embed + ( PredicatePattern.setSimplified + ( checkedSimplifiedFromChildren predF + <> Attribute.simplifiedConditionally condition + ) + attrs + :< predF + ) + +markSimplifiedMaybeConditional :: + (HasCallStack, InternalVariable variable) => + Maybe SideCondition.Representation -> + Predicate variable -> + Predicate variable +markSimplifiedMaybeConditional Nothing = markSimplified +markSimplifiedMaybeConditional (Just condition) = + markSimplifiedConditional condition + +setSimplified :: + (HasCallStack, InternalVariable variable) => + Attribute.Simplified -> + Predicate variable -> + Predicate variable +setSimplified + simplified + (Recursive.project -> attrs :< predF) = + Recursive.embed + ( PredicatePattern.setSimplified mergedSimplified attrs + :< predF + ) + where + childSimplified = simplifiedFromChildren predF + mergedSimplified = case (childSimplified, simplified) of + (Attribute.NotSimplified, Attribute.NotSimplified) -> + Attribute.NotSimplified + (Attribute.NotSimplified, _) -> + cannotSimplifyNotSimplifiedError predF + (_, Attribute.NotSimplified) -> + Attribute.NotSimplified + _ -> childSimplified <> simplified + +forgetSimplified :: + InternalVariable variable => + Predicate variable -> + Predicate variable +forgetSimplified = Recursive.fold worker + where + worker (_ :< predF) = case predF of + CeilF ceil' -> + synthesize $ + CeilF + (TermLike.forgetSimplified <$> ceil') + FloorF floor' -> + synthesize $ + FloorF + (TermLike.forgetSimplified <$> floor') + EqualsF equals' -> + synthesize $ + EqualsF + (TermLike.forgetSimplified <$> equals') + InF in' -> + synthesize $ + InF + (TermLike.forgetSimplified <$> in') + _ -> synthesize predF + mapVariables :: forall variable1 variable2. InternalVariable variable1 => diff --git a/kore/src/Kore/Internal/Substitution.hs b/kore/src/Kore/Internal/Substitution.hs index 3e2cd53200..705e297ab5 100644 --- a/kore/src/Kore/Internal/Substitution.hs +++ b/kore/src/Kore/Internal/Substitution.hs @@ -30,6 +30,11 @@ module Kore.Internal.Substitution ( mapTerms, mapAssignmentVariables, isNormalized, + isSimplified, + isSimplifiedSomeCondition, + forgetSimplified, + markSimplified, + simplifiedAttribute, null, variables, unsafeWrap, @@ -62,6 +67,9 @@ import ErrorContext import qualified GHC.Generics as GHC import qualified Generics.SOP as SOP import Kore.Attribute.Pattern.FreeVariables as FreeVariables +import qualified Kore.Attribute.Pattern.Simplified as Attribute ( + Simplified (..), + ) import Kore.Debug import Kore.Internal.Predicate ( Predicate, @@ -551,6 +559,58 @@ mapTerms mapper (Substitution s) = mapTerms mapper (NormalizedSubstitution s) = NormalizedSubstitution (fmap mapper s) +{- | Is the 'Substitution' fully simplified under the given side condition? + +See also: 'isSimplifiedSomeCondition'. +-} +isSimplified :: SideCondition.Representation -> Substitution variable -> Bool +isSimplified _ (Substitution _) = False +isSimplified sideCondition (NormalizedSubstitution normalized) = + all (TermLike.isSimplified sideCondition) normalized + +{- | Is the 'Substitution' fully simplified under some side condition? + +See also: 'isSimplified'. +-} +isSimplifiedSomeCondition :: Substitution variable -> Bool +isSimplifiedSomeCondition (Substitution _) = False +isSimplifiedSomeCondition (NormalizedSubstitution normalized) = + all TermLike.isSimplifiedSomeCondition normalized + +{- | Forget the 'simplifiedAttribute' associated with the 'Substitution'. + +@ +isSimplified (forgetSimplified _) == False +@ +-} +forgetSimplified :: + InternalVariable variable => + Substitution variable -> + Substitution variable +forgetSimplified = + wrap + . fmap (mapAssignedTerm TermLike.forgetSimplified) + . unwrap + +{- | Mark a 'Substitution' as fully simplified at the current level. + +See 'Kore.Internal.TermLike.markSimplified'. +-} +markSimplified :: + InternalVariable variable => + Substitution variable -> + Substitution variable +markSimplified = + wrap + . fmap (mapAssignedTerm TermLike.markSimplified) + . unwrap + +simplifiedAttribute :: + Substitution variable -> Attribute.Simplified +simplifiedAttribute (Substitution _) = Attribute.NotSimplified +simplifiedAttribute (NormalizedSubstitution normalized) = + foldMap TermLike.simplifiedAttribute normalized + -- | Returns true iff the substitution is normalized. isNormalized :: Substitution variable -> Bool isNormalized (Substitution _) = False diff --git a/kore/src/Kore/Internal/TermLike.hs b/kore/src/Kore/Internal/TermLike.hs index 6cdb9988dc..fcecd64f91 100644 --- a/kore/src/Kore/Internal/TermLike.hs +++ b/kore/src/Kore/Internal/TermLike.hs @@ -9,8 +9,18 @@ module Kore.Internal.TermLike ( TermAttributes (..), TermLike (..), extractAttributes, + isSimplified, + isSimplifiedSomeCondition, Attribute.isConstructorLike, assertConstructorLikeKeys, + markSimplified, + markSimplifiedConditional, + markSimplifiedMaybeConditional, + setSimplified, + setAttributeSimplified, + forgetSimplified, + simplifiedAttribute, + attributeSimplifiedAttribute, isFunctionPattern, isFunctionalPattern, hasConstructorLikeTop, @@ -215,6 +225,7 @@ import qualified Kore.Attribute.Pattern.FreeVariables as Attribute.FreeVariables ) import qualified Kore.Attribute.Pattern.Function as Attribute import qualified Kore.Attribute.Pattern.Functional as Attribute +import qualified Kore.Attribute.Pattern.Simplified as Attribute import Kore.Attribute.Synthetic import Kore.Builtin.Endianness.Endianness ( Endianness, @@ -397,6 +408,45 @@ fromConcrete :: TermLike variable fromConcrete = mapVariables (pure $ from @Concrete) +{- | Is the 'TermLike' fully simplified under the given side condition? + +See also: 'isSimplifiedAnyCondition', 'isSimplifiedSomeCondition'. +-} +isSimplified :: SideCondition.Representation -> TermLike variable -> Bool +isSimplified sideCondition = + isAttributeSimplified sideCondition . extractAttributes + +{- | Is the 'TermLike' fully simplified under any side condition? + +See also: 'isSimplified', 'isSimplifiedSomeCondition'. +-} +isSimplifiedAnyCondition :: TermLike variable -> Bool +isSimplifiedAnyCondition = + isAttributeSimplifiedAnyCondition . extractAttributes + +{- | Is the 'TermLike' fully simplified under some side condition? + +See also: 'isSimplified', 'isSimplifiedAnyCondition'. +-} +isSimplifiedSomeCondition :: TermLike variable -> Bool +isSimplifiedSomeCondition = + isAttributeSimplifiedSomeCondition . extractAttributes + +{- | Forget the 'simplifiedAttribute' associated with the 'TermLike'. + +@ +isSimplified (forgetSimplified _) == False +@ +-} +forgetSimplified :: + InternalVariable variable => + TermLike variable -> + TermLike variable +forgetSimplified = resynthesize + +simplifiedAttribute :: TermLike variable -> Attribute.Simplified +simplifiedAttribute = attributeSimplifiedAttribute . extractAttributes + assertConstructorLikeKeys :: HasCallStack => InternalVariable variable => @@ -416,8 +466,126 @@ assertConstructorLikeKeys keys a , Pretty.indent 2 "Non-constructor-like patterns:" ] <> fmap (Pretty.indent 4 . unparse) simplifiableKeys + | any (not . isSimplifiedAnyCondition) keys = + let simplifiableKeys = + filter (not . isSimplifiedAnyCondition) $ Prelude.Kore.toList keys + in (error . show . Pretty.vsep) $ + [ "Internal error: expected fully simplified patterns,\ + \ an internal invariant has been violated.\ + \ Please report this error." + , Pretty.indent 2 "Unsimplified patterns:" + ] + <> fmap (Pretty.indent 4 . unparse) simplifiableKeys | otherwise = a +{- | Mark a 'TermLike' as fully simplified at the current level. + +The pattern is fully simplified if we do not know how to simplify it any +further. The simplifier reserves the right to skip any pattern which is marked, +so do not mark any pattern unless you are certain it cannot be further +simplified. + +Note that fully simplified at the current level may not mean that the pattern +is fully simplified (e.g. if a child is simplified conditionally). +-} +markSimplified :: + (HasCallStack, InternalVariable variable) => + TermLike variable -> + TermLike variable +markSimplified (Recursive.project -> attrs :< termLikeF) = + Recursive.embed + ( setAttributeSimplified + (checkedSimplifiedFromChildren termLikeF) + attrs + :< termLikeF + ) + +markSimplifiedMaybeConditional :: + (HasCallStack, InternalVariable variable) => + Maybe SideCondition.Representation -> + TermLike variable -> + TermLike variable +markSimplifiedMaybeConditional Nothing = markSimplified +markSimplifiedMaybeConditional (Just condition) = + markSimplifiedConditional condition + +cannotSimplifyNotSimplifiedError :: + (HasCallStack, InternalVariable variable) => + TermLikeF variable (TermLike variable) -> + a +cannotSimplifyNotSimplifiedError termLikeF = + error + ( "Unexpectedly marking term with NotSimplified children as \ + \simplified:\n" + ++ show termLikeF + ++ "\n" + ++ Unparser.unparseToString termLikeF + ) + +setSimplified :: + (HasCallStack, InternalVariable variable) => + Attribute.Simplified -> + TermLike variable -> + TermLike variable +setSimplified + simplified + (Recursive.project -> attrs :< termLikeF) = + Recursive.embed + ( setAttributeSimplified mergedSimplified attrs + :< termLikeF + ) + where + childSimplified = simplifiedFromChildren termLikeF + mergedSimplified = case (childSimplified, simplified) of + (Attribute.NotSimplified, Attribute.NotSimplified) -> + Attribute.NotSimplified + (Attribute.NotSimplified, _) -> + cannotSimplifyNotSimplifiedError termLikeF + (_, Attribute.NotSimplified) -> + Attribute.NotSimplified + _ -> childSimplified <> simplified + +{- |Marks a term as being simplified as long as the side condition stays +unchanged. +-} +markSimplifiedConditional :: + (HasCallStack, InternalVariable variable) => + SideCondition.Representation -> + TermLike variable -> + TermLike variable +markSimplifiedConditional + condition + (Recursive.project -> attrs :< termLikeF) = + Recursive.embed + ( setAttributeSimplified + ( checkedSimplifiedFromChildren termLikeF + <> Attribute.simplifiedConditionally condition + ) + attrs + :< termLikeF + ) + +simplifiedFromChildren :: + HasCallStack => + TermLikeF variable (TermLike variable) -> + Attribute.Simplified +simplifiedFromChildren termLikeF = + case mergedSimplified of + Attribute.NotSimplified -> Attribute.NotSimplified + _ -> mergedSimplified `Attribute.simplifiedTo` Attribute.fullySimplified + where + mergedSimplified = + foldMap (attributeSimplifiedAttribute . extractAttributes) termLikeF + +checkedSimplifiedFromChildren :: + (HasCallStack, InternalVariable variable) => + TermLikeF variable (TermLike variable) -> + Attribute.Simplified +checkedSimplifiedFromChildren termLikeF = + case simplifiedFromChildren termLikeF of + Attribute.NotSimplified -> cannotSimplifyNotSimplifiedError termLikeF + simplified -> simplified + -- | Get the 'Sort' of a 'TermLike' from the 'Attribute.Pattern' annotation. termLikeSort :: TermLike variable -> Sort termLikeSort = termSort . extractAttributes diff --git a/kore/src/Kore/Internal/TermLike/TermLike.hs b/kore/src/Kore/Internal/TermLike/TermLike.hs index 9caca4772e..2d49a82a76 100644 --- a/kore/src/Kore/Internal/TermLike/TermLike.hs +++ b/kore/src/Kore/Internal/TermLike/TermLike.hs @@ -17,6 +17,11 @@ module Kore.Internal.TermLike.TermLike ( traverseVariablesF, updateCallStack, depth, + isAttributeSimplified, + isAttributeSimplifiedAnyCondition, + isAttributeSimplifiedSomeCondition, + attributeSimplifiedAttribute, + setAttributeSimplified, mapAttributeVariables, deleteFreeVariable, ) where @@ -52,9 +57,6 @@ import Data.Set ( Set, ) import qualified Data.Set as Set -import Data.Text ( - Text, - ) import qualified GHC.Generics as GHC import qualified GHC.Stack as GHC import qualified Generics.SOP as SOP @@ -70,6 +72,8 @@ import qualified Kore.Attribute.Pattern.FreeVariables as Attribute.FreeVariables import qualified Kore.Attribute.Pattern.FreeVariables as FreeVariables import qualified Kore.Attribute.Pattern.Function as Attribute import qualified Kore.Attribute.Pattern.Functional as Attribute +import qualified Kore.Attribute.Pattern.Simplified as Attribute +import qualified Kore.Attribute.Pattern.Simplified as Attribute.Simplified import Kore.Attribute.Synthetic import Kore.Builtin.Endianness.Endianness ( Endianness, @@ -371,6 +375,43 @@ instance Synthetic Attribute.Defined (TermLikeF variable) where SignednessF signedness -> synthetic signedness InjF inj -> synthetic inj +instance Synthetic Attribute.Simplified (TermLikeF variable) where + synthetic = + \case + AndF and' -> synthetic and' + ApplySymbolF application -> synthetic application + ApplyAliasF application -> synthetic application + BottomF bottom -> synthetic bottom + CeilF ceil -> synthetic ceil + DomainValueF domainValue -> synthetic domainValue + EqualsF equals -> synthetic equals + ExistsF exists -> synthetic exists + FloorF floor' -> synthetic floor' + ForallF forall' -> synthetic forall' + IffF iff -> synthetic iff + ImpliesF implies -> synthetic implies + InF in' -> synthetic in' + MuF mu -> synthetic mu + NextF next -> synthetic next + NotF not' -> synthetic not' + NuF nu -> synthetic nu + OrF or' -> synthetic or' + RewritesF rewrites -> synthetic rewrites + TopF top -> synthetic top + InhabitantF inhabitant -> synthetic inhabitant + StringLiteralF stringLiteral -> synthetic stringLiteral + InternalBoolF internalBool -> synthetic internalBool + InternalBytesF internalBytes -> synthetic internalBytes + InternalIntF internalInt -> synthetic internalInt + InternalStringF internalString -> synthetic internalString + InternalListF internalList -> synthetic internalList + InternalMapF internalMap -> synthetic internalMap + InternalSetF internalSet -> synthetic internalSet + VariableF variable -> synthetic variable + EndiannessF endianness -> synthetic endianness + SignednessF signedness -> synthetic signedness + InjF inj -> synthetic inj + instance Synthetic Attribute.ConstructorLike (TermLikeF variable) where synthetic = \case @@ -430,6 +471,7 @@ data TermAttributes variable = TermAttributes , termFunction :: !Attribute.Function , termDefined :: !Attribute.Defined , termCreated :: !Attribute.Created + , termSimplified :: !Attribute.Simplified , termConstructorLike :: !Attribute.ConstructorLike } deriving stock (Eq, Show) @@ -448,6 +490,7 @@ instance , Synthetic Attribute.Functional base , Synthetic Attribute.Function base , Synthetic Attribute.Defined base + , Synthetic Attribute.Simplified base , Synthetic Attribute.ConstructorLike base ) => Synthetic (TermAttributes variable) base @@ -460,6 +503,10 @@ instance , termFunction = synthetic (termFunction <$> base) , termDefined = synthetic (termDefined <$> base) , termCreated = synthetic (termCreated <$> base) + , termSimplified = + if Attribute.isConstructorLike constructorLikeAttr + then Attribute.fullySimplified + else synthetic (termSimplified <$> base) , termConstructorLike = constructorLikeAttr } where @@ -474,12 +521,66 @@ instance Attribute.HasConstructorLike (TermAttributes variable) where instance (Ord variable) => From KeyAttributes (TermAttributes variable) where from = fromKeyAttributes +attributeSimplifiedAttribute :: + HasCallStack => + TermAttributes variable -> + Attribute.Simplified +attributeSimplifiedAttribute patt@TermAttributes{termSimplified} = + assertSimplifiedConsistency patt termSimplified + constructorLikeAttribute :: TermAttributes variable -> Attribute.ConstructorLike constructorLikeAttribute TermAttributes{termConstructorLike} = termConstructorLike +{- Checks whether the pattern is simplified relative to the given side +condition. +-} +isAttributeSimplified :: + HasCallStack => + SideCondition.Representation -> + TermAttributes variable -> + Bool +isAttributeSimplified sideCondition patt@TermAttributes{termSimplified} = + assertSimplifiedConsistency patt $ + Attribute.isSimplified sideCondition termSimplified + +{- Checks whether the pattern is simplified relative to some side condition. +-} +isAttributeSimplifiedSomeCondition :: + HasCallStack => + TermAttributes variable -> + Bool +isAttributeSimplifiedSomeCondition patt@TermAttributes{termSimplified} = + assertSimplifiedConsistency patt $ + Attribute.isSimplifiedSomeCondition termSimplified + +{- Checks whether the pattern is simplified relative to any side condition. +-} +isAttributeSimplifiedAnyCondition :: + HasCallStack => + TermAttributes variable -> + Bool +isAttributeSimplifiedAnyCondition patt@TermAttributes{termSimplified} = + assertSimplifiedConsistency patt $ + Attribute.isSimplifiedAnyCondition termSimplified + +assertSimplifiedConsistency :: HasCallStack => TermAttributes variable -> a -> a +assertSimplifiedConsistency + TermAttributes{termConstructorLike, termSimplified} + | Attribute.isConstructorLike termConstructorLike + , not (Attribute.isSimplifiedAnyCondition termSimplified) = + error "Inconsistent attributes, constructorLike implies fully simplified." + | otherwise = id + +setAttributeSimplified :: + Attribute.Simplified -> + TermAttributes variable -> + TermAttributes variable +setAttributeSimplified termSimplified attrs = + attrs{termSimplified} + -- TODO: should we remove this? it isn't used anywhere {- | Use the provided mapping to replace all variables in a 'TermAttributes'. @@ -601,18 +702,18 @@ instance (Unparse variable, Ord variable) => Unparse (TermLike variable) where TermAttributes{termCreated} = attrs attributeRepresentation = case attrs of - (TermAttributes _ _ _ _ _ _ _) -> + (TermAttributes _ _ _ _ _ _ _ _) -> Pretty.surround (Pretty.hsep $ map Pretty.pretty representation) "/* " " */" where - representation :: [Text] representation = addFunctionalRepresentation $ addFunctionRepresentation $ addDefinedRepresentation $ - addConstructorLikeRepresentation [] + addSimplifiedRepresentation $ + addConstructorLikeRepresentation [] addFunctionalRepresentation | Attribute.isFunctional $ termFunctional attrs = ("Fl" :) | otherwise = id @@ -622,6 +723,14 @@ instance (Unparse variable, Ord variable) => Unparse (TermLike variable) where addDefinedRepresentation | Attribute.isDefined $ termDefined attrs = ("D" :) | otherwise = id + addSimplifiedRepresentation = + case simplifiedTag of + Just result -> (result :) + Nothing -> id + where + simplifiedTag = + Attribute.Simplified.unparseTag + (attributeSimplifiedAttribute attrs) addConstructorLikeRepresentation = case constructorLike of Just Attribute.ConstructorLikeHead -> ("Cl" :) @@ -830,17 +939,19 @@ fromKeyAttributes attrs = , termFunctional = Attribute.Functional True , termFunction = Attribute.Function True , termDefined = Attribute.Defined True + , termSimplified = Attribute.fullySimplified , termConstructorLike = Attribute.ConstructorLike (Just Attribute.ConstructorLikeHead) , termCreated = Attribute.Created Nothing } toKeyAttributes :: TermAttributes variable -> Maybe KeyAttributes -toKeyAttributes attrs@(TermAttributes _ _ _ _ _ _ _) +toKeyAttributes attrs@(TermAttributes _ _ _ _ _ _ _ _) | Attribute.nullFreeVariables termFreeVariables , Attribute.isFunctional termFunctional , Attribute.isFunction termFunction , Attribute.isDefined termDefined + , Attribute.isSimplifiedAnyCondition termSimplified , Attribute.isConstructorLike termConstructorLike = Just $ KeyAttributes termSort | otherwise = Nothing @@ -852,6 +963,7 @@ toKeyAttributes attrs@(TermAttributes _ _ _ _ _ _ _) , termFunction , termDefined , termConstructorLike + , termSimplified } = attrs -- | Ensure that a 'TermLike' is a concrete, constructor-like term. diff --git a/kore/src/Kore/Rewrite/AntiLeft.hs b/kore/src/Kore/Rewrite/AntiLeft.hs index 819bcdfb8b..a09ba5f108 100644 --- a/kore/src/Kore/Rewrite/AntiLeft.hs +++ b/kore/src/Kore/Rewrite/AntiLeft.hs @@ -5,6 +5,7 @@ License : BSD-3-Clause module Kore.Rewrite.AntiLeft ( AntiLeft (..), antiLeftPredicate, + forgetSimplified, mapVariables, parse, toTermLike, @@ -229,6 +230,32 @@ mapVariablesLeft adj antiLeft@(AntiLeftLhs _ _ _) = where AntiLeftLhs{existentials, predicate, term} = antiLeft +forgetSimplified :: + InternalVariable variable => + AntiLeft variable -> + AntiLeft variable +forgetSimplified antiLeft@(AntiLeft _ _ _) = + AntiLeft + { aliasTerm = TermLike.forgetSimplified aliasTerm + , maybeInner = forgetSimplified <$> maybeInner + , leftHands = map forgetSimplifiedLeft leftHands + } + where + AntiLeft{aliasTerm, maybeInner, leftHands} = antiLeft + +forgetSimplifiedLeft :: + InternalVariable variable => + AntiLeftLhs variable -> + AntiLeftLhs variable +forgetSimplifiedLeft antiLeftLhs@(AntiLeftLhs _ _ _) = + AntiLeftLhs + { existentials + , predicate = Predicate.forgetSimplified predicate + , term = TermLike.forgetSimplified term + } + where + AntiLeftLhs{existentials, predicate, term} = antiLeftLhs + toTermLike :: AntiLeft variable -> TermLike variable toTermLike AntiLeft{aliasTerm} = aliasTerm diff --git a/kore/src/Kore/Rewrite/ClaimPattern.hs b/kore/src/Kore/Rewrite/ClaimPattern.hs index bfe9b746bc..d031cb5d69 100644 --- a/kore/src/Kore/Rewrite/ClaimPattern.hs +++ b/kore/src/Kore/Rewrite/ClaimPattern.hs @@ -12,6 +12,7 @@ module Kore.Rewrite.ClaimPattern ( applySubstitution, termToExistentials, mkGoal, + forgetSimplified, parseRightHandSide, claimPatternToTerm, ) where @@ -314,6 +315,15 @@ termToExistentials (TermLike.Exists_ _ v term) = fmap (v :) (termToExistentials term) termToExistentials term = (term, []) +forgetSimplified :: ClaimPattern -> ClaimPattern +forgetSimplified claimPattern'@(ClaimPattern _ _ _ _) = + claimPattern' + { left = Pattern.forgetSimplified left + , right = OrPattern.forgetSimplified right + } + where + ClaimPattern{left, right} = claimPattern' + {- | Ensure that the 'ClaimPattern''s bound variables are fresh. The 'existentials' should not appear free on the left-hand side so that we can diff --git a/kore/src/Kore/Rewrite/Function/Evaluator.hs b/kore/src/Kore/Rewrite/Function/Evaluator.hs index 750af151cd..29f339a2c9 100644 --- a/kore/src/Kore/Rewrite/Function/Evaluator.hs +++ b/kore/src/Kore/Rewrite/Function/Evaluator.hs @@ -22,6 +22,7 @@ import Control.Error ( import Control.Monad.Catch ( MonadThrow, ) +import qualified Kore.Attribute.Pattern.Simplified as Attribute.Simplified import Kore.Attribute.Synthetic import qualified Kore.Internal.MultiOr as MultiOr ( flatten, @@ -116,9 +117,22 @@ evaluateApplication return $ OrPattern.fromPattern $ Pattern.withCondition - termLike + (markSimplifiedIfChildren maybeSideCondition termLike) childrenCondition + markSimplifiedIfChildren :: + Maybe SideCondition.Representation -> + TermLike RewritingVariableName -> + TermLike RewritingVariableName + markSimplifiedIfChildren Nothing = + TermLike.setSimplified + (foldMap TermLike.simplifiedAttribute application) + markSimplifiedIfChildren (Just condition) = + TermLike.setSimplified + ( foldMap TermLike.simplifiedAttribute application + <> Attribute.Simplified.simplifiedConditionally condition + ) + canMemoize | Symbol.isMemo symbol , ( isTop childrenCondition diff --git a/kore/src/Kore/Rewrite/Implication.hs b/kore/src/Kore/Rewrite/Implication.hs index 55a94ee78a..2b1cd4d96f 100644 --- a/kore/src/Kore/Rewrite/Implication.hs +++ b/kore/src/Kore/Rewrite/Implication.hs @@ -13,6 +13,7 @@ module Kore.Rewrite.Implication ( applySubstitution, termToExistentials, resetConfigVariables, + forgetSimplified, parseRightHandSide, implicationToTerm, ) where @@ -312,6 +313,15 @@ termToExistentials (TermLike.Exists_ _ v term) = fmap (v :) (termToExistentials term) termToExistentials term = (term, []) +forgetSimplified :: Implication modality -> Implication modality +forgetSimplified implication'@(Implication _ _ _ _ _) = + implication' + { left = Pattern.forgetSimplified left + , right = OrPattern.forgetSimplified right + } + where + Implication{left, right} = implication' + {- | Ensure that the 'Implication''s bound variables are fresh. The 'existentials' should not appear free on the left-hand side so that we can diff --git a/kore/src/Kore/Rewrite/RulePattern.hs b/kore/src/Kore/Rewrite/RulePattern.hs index db56297782..0e6f049c0b 100644 --- a/kore/src/Kore/Rewrite/RulePattern.hs +++ b/kore/src/Kore/Rewrite/RulePattern.hs @@ -16,6 +16,7 @@ module Kore.Rewrite.RulePattern ( topExistsToImplicitForall, isFreeOf, lhsEqualsRhs, + rhsForgetSimplified, rhsToTerm, lhsToTerm, rhsToPattern, @@ -405,6 +406,14 @@ renameExistentials subst RHS{existentials, right, ensures} = let name = SomeVariableNameElement . variableName $ var in maybe var expectElementVariable $ Map.lookup name subst +rhsForgetSimplified :: InternalVariable variable => RHS variable -> RHS variable +rhsForgetSimplified RHS{existentials, right, ensures} = + RHS + { existentials + , right = TermLike.forgetSimplified right + , ensures = Predicate.forgetSimplified ensures + } + {- | Applies a substitution to a rule and checks that it was fully applied, i.e. there is no substitution variable left in the rule. -} diff --git a/kore/src/Kore/Simplify/And.hs b/kore/src/Kore/Simplify/And.hs index 423593aff1..00fa6a5e8b 100644 --- a/kore/src/Kore/Simplify/And.hs +++ b/kore/src/Kore/Simplify/And.hs @@ -159,7 +159,10 @@ makeEvaluateNonBool notSimplifier sideCondition patterns = do term = applyAndIdempotenceAndFindContradictions (Conditional.term unified) - let predicate = Predicate.fromMultiAnd predicates + let predicate = + Predicate.fromMultiAnd predicates + & Predicate.setSimplified simplified + simplified = foldMap Predicate.simplifiedAttribute predicates in Pattern.withCondition term (from substitution <> from predicate) & return @@ -173,7 +176,10 @@ applyAndIdempotenceAndFindContradictions patt = where (terms, negatedTerms) = splitIntoTermsAndNegations patt noContradictions = Set.disjoint (Set.map mkNot terms) negatedTerms - mkAndSimplified a b = mkAnd a b + mkAndSimplified a b = + TermLike.setSimplified + (TermLike.simplifiedAttribute a <> TermLike.simplifiedAttribute b) + (mkAnd a b) splitIntoTermsAndNegations :: TermLike RewritingVariableName -> diff --git a/kore/src/Kore/Simplify/AndPredicates.hs b/kore/src/Kore/Simplify/AndPredicates.hs index b9ddf4331d..824670238f 100644 --- a/kore/src/Kore/Simplify/AndPredicates.hs +++ b/kore/src/Kore/Simplify/AndPredicates.hs @@ -45,4 +45,9 @@ simplifyEvaluatedMultiPredicate sideCondition predicates = andConditions element where andConditions predicates' = - Substitution.normalize sideCondition (fold predicates') + fmap markSimplified $ + Substitution.normalize sideCondition (fold predicates') + where + markSimplified = + Condition.setPredicateSimplified + (foldMap Condition.simplifiedAttribute predicates') diff --git a/kore/src/Kore/Simplify/AndTerms.hs b/kore/src/Kore/Simplify/AndTerms.hs index da0fc42ad3..e9a9a9026f 100644 --- a/kore/src/Kore/Simplify/AndTerms.hs +++ b/kore/src/Kore/Simplify/AndTerms.hs @@ -875,6 +875,7 @@ functionAnd first second | isFunctionPattern first , isFunctionPattern second = makeEqualsPredicate first' second' + & Predicate.markSimplified -- Ceil predicate not needed since first being -- bottom will make the entire term bottom. However, -- one must be careful to not just drop the term. diff --git a/kore/src/Kore/Simplify/Application.hs b/kore/src/Kore/Simplify/Application.hs index 1bf162bd3f..7e2ab845e4 100644 --- a/kore/src/Kore/Simplify/Application.hs +++ b/kore/src/Kore/Simplify/Application.hs @@ -130,6 +130,7 @@ evaluateApplicationFunction let applicationPattern = synthesize . ApplySymbolF <$> expandedApp in applicationPattern + & Pattern.markSimplified & OrPattern.fromPattern & return | otherwise = diff --git a/kore/src/Kore/Simplify/Ceil.hs b/kore/src/Kore/Simplify/Ceil.hs index 0ddb0c6b41..047a9f8ece 100644 --- a/kore/src/Kore/Simplify/Ceil.hs +++ b/kore/src/Kore/Simplify/Ceil.hs @@ -392,6 +392,7 @@ makeSimplifiedCeil unsimplified = OrCondition.fromPredicate + . Predicate.markSimplifiedMaybeConditional maybeCurrentCondition . makeCeilPredicate $ termLike diff --git a/kore/src/Kore/Simplify/Condition.hs b/kore/src/Kore/Simplify/Condition.hs index 2748fcc7d2..3f86d4ecac 100644 --- a/kore/src/Kore/Simplify/Condition.hs +++ b/kore/src/Kore/Simplify/Condition.hs @@ -146,7 +146,7 @@ simplifyPredicates sideCondition original = do (toList predicates) let simplified = foldMap mkCondition simplifiedPredicates if original == simplifiedPredicates - then return simplified + then return (Condition.markSimplified simplified) else simplifyPredicates sideCondition simplifiedPredicates {- | Simplify a conjunction of predicates by simplifying each one diff --git a/kore/src/Kore/Simplify/DomainValue.hs b/kore/src/Kore/Simplify/DomainValue.hs index a52a52f4a7..c4ab9ad06d 100644 --- a/kore/src/Kore/Simplify/DomainValue.hs +++ b/kore/src/Kore/Simplify/DomainValue.hs @@ -40,7 +40,7 @@ simplify :: OrPattern RewritingVariableName simplify builtin@DomainValue{domainValueSort} = OrPattern.coerceSort domainValueSort - . MultiOr.map (fmap mkDomainValue) + . MultiOr.map (fmap (markSimplified . mkDomainValue)) $ simplifyDomainValue builtin simplifyDomainValue :: diff --git a/kore/src/Kore/Simplify/Equals.hs b/kore/src/Kore/Simplify/Equals.hs index 366d1b6dfe..e02f5984cd 100644 --- a/kore/src/Kore/Simplify/Equals.hs +++ b/kore/src/Kore/Simplify/Equals.hs @@ -330,7 +330,8 @@ makeEvaluateTermsAssumesNoBottom firstTerm secondTerm = do Conditional { term = mkTop_ , predicate = - makeEqualsPredicate firstTerm secondTerm + Predicate.markSimplified $ + makeEqualsPredicate firstTerm secondTerm , substitution = mempty } @@ -370,7 +371,8 @@ makeEvaluateTermsToPredicate first second sideCondition Nothing -> return $ OrCondition.fromCondition . Condition.fromPredicate $ - makeEqualsPredicate first second + Predicate.markSimplified $ + makeEqualsPredicate first second Just predicatedOr -> do firstCeilOr <- makeEvaluateTermCeil sideCondition first secondCeilOr <- makeEvaluateTermCeil sideCondition second @@ -447,6 +449,7 @@ termEqualsAnd p1 p2 = . sequence equalsPattern = makeEqualsPredicate first second + & Predicate.markSimplified & Condition.fromPredicate -- Although the term will eventually be discarded, the sub-term -- unifier should return it in case the caller needs to diff --git a/kore/src/Kore/Simplify/Exists.hs b/kore/src/Kore/Simplify/Exists.hs index 7c4b3f237c..a73af44d0c 100644 --- a/kore/src/Kore/Simplify/Exists.hs +++ b/kore/src/Kore/Simplify/Exists.hs @@ -409,10 +409,10 @@ quantifyPattern variable original@Conditional{term, predicate, substitution} , "variable=" ++ unparseToString variable , "patt=" ++ unparseToString original ] - | quantifyTerm = mkExists variable <$> original + | quantifyTerm = TermLike.markSimplified . mkExists variable <$> original | quantifyPredicate = Conditional.withCondition term $ - Condition.fromPredicate + Condition.fromPredicate . Predicate.markSimplified -- TODO (thomas.tuegel): This may not be fully simplified: we have not used -- the And simplifier on the predicate. $ diff --git a/kore/src/Kore/Simplify/Floor.hs b/kore/src/Kore/Simplify/Floor.hs index 6ca1151638..4eb4b909b5 100644 --- a/kore/src/Kore/Simplify/Floor.hs +++ b/kore/src/Kore/Simplify/Floor.hs @@ -21,6 +21,9 @@ import Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( makeFloorPredicate, ) +import qualified Kore.Internal.Predicate as Predicate ( + markSimplified, + ) import Kore.Internal.TermLike import Kore.Rewrite.RewritingVariable ( RewritingVariableName, @@ -92,4 +95,5 @@ makeEvaluateNonBoolFloor patt = (term, condition) = Pattern.splitTerm patt floorCondition = makeFloorPredicate term + & Predicate.markSimplified & Condition.fromPredicate diff --git a/kore/src/Kore/Simplify/Forall.hs b/kore/src/Kore/Simplify/Forall.hs index b02e8986cb..ac62004a76 100644 --- a/kore/src/Kore/Simplify/Forall.hs +++ b/kore/src/Kore/Simplify/Forall.hs @@ -15,6 +15,7 @@ module Kore.Simplify.Forall ( import qualified Kore.Internal.Condition as Condition ( fromPredicate, hasFreeVariable, + markPredicateSimplified, toPredicate, ) import qualified Kore.Internal.Conditional as Conditional ( @@ -49,6 +50,7 @@ import Kore.Internal.TermLike ( ) import qualified Kore.Internal.TermLike as TermLike ( hasFreeVariable, + markSimplified, ) import qualified Kore.Internal.TermLike as TermLike.DoNotUse import Kore.Rewrite.RewritingVariable ( @@ -117,17 +119,19 @@ makeEvaluate variable patt | Pattern.isBottom patt = Pattern.bottom | not variableInTerm && not variableInCondition = patt | predicateIsBoolean = - mkForall variable term + TermLike.markSimplified (mkForall variable term) `Conditional.withCondition` predicate | termIsBoolean = term - `Conditional.withCondition` ( Condition.fromPredicate - (makeForallPredicate variable (Condition.toPredicate predicate)) - ) + `Conditional.withCondition` Condition.markPredicateSimplified + ( Condition.fromPredicate + (makeForallPredicate variable (Condition.toPredicate predicate)) + ) | otherwise = Pattern.fromTermLike $ - mkForall variable $ - Pattern.toTermLike patt + TermLike.markSimplified $ + mkForall variable $ + Pattern.toTermLike patt where (term, predicate) = Pattern.splitTerm patt someVariable = mkSomeVariable variable diff --git a/kore/src/Kore/Simplify/Iff.hs b/kore/src/Kore/Simplify/Iff.hs index 0179e2f319..3abf99a946 100644 --- a/kore/src/Kore/Simplify/Iff.hs +++ b/kore/src/Kore/Simplify/Iff.hs @@ -25,6 +25,9 @@ import Kore.Internal.SideCondition ( ) import qualified Kore.Internal.Substitution as Substitution import Kore.Internal.TermLike +import qualified Kore.Internal.TermLike as TermLike ( + markSimplified, + ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) @@ -137,20 +140,22 @@ makeEvaluateNonBoolIff [ Conditional { term = firstTerm , predicate = - Predicate.makeIffPredicate - ( Predicate.makeAndPredicate - firstPredicate - (Substitution.toPredicate firstSubstitution) - ) - ( Predicate.makeAndPredicate - secondPredicate - (Substitution.toPredicate secondSubstitution) - ) + Predicate.markSimplified $ + Predicate.makeIffPredicate + ( Predicate.makeAndPredicate + firstPredicate + (Substitution.toPredicate firstSubstitution) + ) + ( Predicate.makeAndPredicate + secondPredicate + (Substitution.toPredicate secondSubstitution) + ) , substitution = mempty } ] | otherwise = OrPattern.fromTermLike $ - mkIff - (Pattern.toTermLike patt1) - (Pattern.toTermLike patt2) + TermLike.markSimplified $ + mkIff + (Pattern.toTermLike patt1) + (Pattern.toTermLike patt2) diff --git a/kore/src/Kore/Simplify/Implies.hs b/kore/src/Kore/Simplify/Implies.hs index a58044cb43..ba85588df2 100644 --- a/kore/src/Kore/Simplify/Implies.hs +++ b/kore/src/Kore/Simplify/Implies.hs @@ -174,15 +174,16 @@ makeEvaluateImpliesNonBool [ Conditional { term = firstTerm , predicate = - Predicate.makeImpliesPredicate - ( Predicate.makeAndPredicate - firstPredicate - (Substitution.toPredicate firstSubstitution) - ) - ( Predicate.makeAndPredicate - secondPredicate - (Substitution.toPredicate secondSubstitution) - ) + Predicate.markSimplified $ + Predicate.makeImpliesPredicate + ( Predicate.makeAndPredicate + firstPredicate + (Substitution.toPredicate firstSubstitution) + ) + ( Predicate.makeAndPredicate + secondPredicate + (Substitution.toPredicate secondSubstitution) + ) , substitution = mempty } ] @@ -191,9 +192,10 @@ makeEvaluateImpliesNonBool OrPattern.fromPatterns [ Conditional { term = - mkImplies - (Pattern.toTermLike pattern1) - (Pattern.toTermLike pattern2) + TermLike.markSimplified $ + mkImplies + (Pattern.toTermLike pattern1) + (Pattern.toTermLike pattern2) , predicate = Predicate.makeTruePredicate , substitution = mempty } diff --git a/kore/src/Kore/Simplify/Inhabitant.hs b/kore/src/Kore/Simplify/Inhabitant.hs index 9a5ba27d34..24b62b7cbe 100644 --- a/kore/src/Kore/Simplify/Inhabitant.hs +++ b/kore/src/Kore/Simplify/Inhabitant.hs @@ -12,6 +12,9 @@ import Kore.Internal.OrPattern ( ) import qualified Kore.Internal.OrPattern as OrPattern import Kore.Internal.TermLike +import qualified Kore.Internal.TermLike as TermLike ( + markSimplified, + ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) @@ -25,4 +28,5 @@ simplify :: OrPattern RewritingVariableName simplify Inhabitant{inhSort} = OrPattern.fromTermLike $ - mkInhabitant inhSort + TermLike.markSimplified $ + mkInhabitant inhSort diff --git a/kore/src/Kore/Simplify/Inj.hs b/kore/src/Kore/Simplify/Inj.hs index d2edba856f..275579c820 100644 --- a/kore/src/Kore/Simplify/Inj.hs +++ b/kore/src/Kore/Simplify/Inj.hs @@ -44,7 +44,7 @@ simplify injOrPattern = do -- evaluateInj does not mark its result simplified because it -- exists outside the simplifier; for example, it might be -- called during unification or matching. - evaluateInj + (TermLike.markSimplified . evaluateInj) composed return evaluated diff --git a/kore/src/Kore/Simplify/InternalList.hs b/kore/src/Kore/Simplify/InternalList.hs index 52594a3104..72b451dff9 100644 --- a/kore/src/Kore/Simplify/InternalList.hs +++ b/kore/src/Kore/Simplify/InternalList.hs @@ -27,5 +27,5 @@ simplify = traverse (Logic.scatter >>> Compose) >>> fmap mkInternalList >>> getCompose - >>> fmap (Pattern.syncSort) + >>> fmap (Pattern.syncSort >>> fmap markSimplified) >>> MultiOr.observeAll diff --git a/kore/src/Kore/Simplify/InternalMap.hs b/kore/src/Kore/Simplify/InternalMap.hs index 5cfdaf736e..26df572b31 100644 --- a/kore/src/Kore/Simplify/InternalMap.hs +++ b/kore/src/Kore/Simplify/InternalMap.hs @@ -29,7 +29,7 @@ simplify :: OrPattern RewritingVariableName simplify = traverse (Logic.scatter >>> Compose) - >>> fmap normalizeInternalMap + >>> fmap (normalizeInternalMap >>> markSimplified) >>> getCompose >>> fmap Pattern.syncSort >>> MultiOr.observeAll diff --git a/kore/src/Kore/Simplify/InternalSet.hs b/kore/src/Kore/Simplify/InternalSet.hs index af8c1d638c..cd16cdc586 100644 --- a/kore/src/Kore/Simplify/InternalSet.hs +++ b/kore/src/Kore/Simplify/InternalSet.hs @@ -29,7 +29,7 @@ simplify :: OrPattern RewritingVariableName simplify = traverse (Logic.scatter >>> Compose) - >>> fmap normalizeInternalSet + >>> fmap (normalizeInternalSet >>> markSimplified) >>> getCompose >>> fmap Pattern.syncSort >>> MultiOr.observeAll diff --git a/kore/src/Kore/Simplify/Mu.hs b/kore/src/Kore/Simplify/Mu.hs index 5c46a7fb14..4577801c95 100644 --- a/kore/src/Kore/Simplify/Mu.hs +++ b/kore/src/Kore/Simplify/Mu.hs @@ -16,6 +16,7 @@ import Kore.Internal.Pattern ( ) import qualified Kore.Internal.Pattern as Pattern ( fromTermLike, + simplifiedAttribute, toTermLike, ) import Kore.Internal.TermLike ( @@ -23,6 +24,9 @@ import Kore.Internal.TermLike ( SetVariable, mkMu, ) +import qualified Kore.Internal.TermLike as TermLike ( + setSimplified, + ) import qualified Kore.Internal.TermLike as TermLike.DoNotUse import Kore.Rewrite.RewritingVariable ( RewritingVariableName, @@ -48,5 +52,6 @@ makeEvaluate :: Pattern RewritingVariableName makeEvaluate variable patt = Pattern.fromTermLike $ - mkMu variable $ - Pattern.toTermLike patt + TermLike.setSimplified (Pattern.simplifiedAttribute patt) $ + mkMu variable $ + Pattern.toTermLike patt diff --git a/kore/src/Kore/Simplify/Next.hs b/kore/src/Kore/Simplify/Next.hs index 251a0e92db..6e84e0893c 100644 --- a/kore/src/Kore/Simplify/Next.hs +++ b/kore/src/Kore/Simplify/Next.hs @@ -39,4 +39,4 @@ simplify Next{nextChild = child} = simplifyEvaluated child simplifyEvaluated :: OrPattern RewritingVariableName -> OrPattern RewritingVariableName -simplifyEvaluated = MultiOr.map (fmap mkNext) +simplifyEvaluated = MultiOr.map (Pattern.markSimplified . fmap mkNext) diff --git a/kore/src/Kore/Simplify/NoConfusion.hs b/kore/src/Kore/Simplify/NoConfusion.hs index 818e85fd92..79bdd336b0 100644 --- a/kore/src/Kore/Simplify/NoConfusion.hs +++ b/kore/src/Kore/Simplify/NoConfusion.hs @@ -92,7 +92,7 @@ equalInjectiveHeadsAndEquals -- which allow evaluating the symbol. It is possible this pattern -- is not actually fully simplified! term = - (mkApplySymbol firstHead) + (markSimplified . mkApplySymbol firstHead) (Pattern.term <$> children) return (Pattern.withCondition term merged) where diff --git a/kore/src/Kore/Simplify/Not.hs b/kore/src/Kore/Simplify/Not.hs index 32f27c4939..ba197c4cfb 100644 --- a/kore/src/Kore/Simplify/Not.hs +++ b/kore/src/Kore/Simplify/Not.hs @@ -53,6 +53,9 @@ import Kore.Internal.SideCondition ( ) import qualified Kore.Internal.Substitution as Substitution import Kore.Internal.TermLike +import qualified Kore.Internal.TermLike as TermLike ( + markSimplified, + ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, ) @@ -172,9 +175,10 @@ makeEvaluatePredicate Conditional { term = () , predicate = - makeNotPredicate $ - makeAndPredicate predicate $ - Substitution.toPredicate substitution + Predicate.markSimplified $ + makeNotPredicate $ + makeAndPredicate predicate $ + Substitution.toPredicate substitution , substitution = mempty } @@ -196,7 +200,7 @@ makeTermNot (And_ _ term1 term2) = makeTermNot term | isBottom term = MultiOr.singleton mkTop_ | isTop term = MultiOr.singleton mkBottom_ - | otherwise = MultiOr.singleton $ mkNot term + | otherwise = MultiOr.singleton $ TermLike.markSimplified $ mkNot term -- | Distribute 'Not' over 'MultiOr' using de Morgan's identity. distributeNot :: diff --git a/kore/src/Kore/Simplify/Nu.hs b/kore/src/Kore/Simplify/Nu.hs index 579a965318..7f33985bb0 100644 --- a/kore/src/Kore/Simplify/Nu.hs +++ b/kore/src/Kore/Simplify/Nu.hs @@ -16,6 +16,7 @@ import Kore.Internal.Pattern ( ) import qualified Kore.Internal.Pattern as Pattern ( fromTermLike, + simplifiedAttribute, toTermLike, ) import Kore.Internal.TermLike ( @@ -23,6 +24,9 @@ import Kore.Internal.TermLike ( SetVariable, mkNu, ) +import qualified Kore.Internal.TermLike as TermLike ( + setSimplified, + ) import qualified Kore.Internal.TermLike as TermLike.DoNotUse import Kore.Rewrite.RewritingVariable ( RewritingVariableName, @@ -47,5 +51,6 @@ makeEvaluate :: Pattern RewritingVariableName makeEvaluate variable patt = Pattern.fromTermLike $ - mkNu variable $ - Pattern.toTermLike patt + TermLike.setSimplified (Pattern.simplifiedAttribute patt) $ + mkNu variable $ + Pattern.toTermLike patt diff --git a/kore/src/Kore/Simplify/Pattern.hs b/kore/src/Kore/Simplify/Pattern.hs index eec9aaf007..b4467ed821 100644 --- a/kore/src/Kore/Simplify/Pattern.hs +++ b/kore/src/Kore/Simplify/Pattern.hs @@ -117,22 +117,15 @@ makeEvaluate :: Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) makeEvaluate sideCondition = - loop 0 . OrPattern.fromPattern + loop . OrPattern.fromPattern where - limit :: Int - limit = 4 - - loop count input - | count >= limit = - trace "\nexceeded pattern simplifier limit\n" $ - pure input - | otherwise = do - output <- - OrPattern.traverse worker input - & fmap OrPattern.flatten - if input == output - then pure output - else loop (count + 1) output + loop input = do + output <- + OrPattern.traverse worker input + & fmap OrPattern.flatten + if input == output + then pure output + else loop output worker pattern' = OrPattern.observeAllT $ do diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index effbf64fcb..9e12a06496 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -108,7 +108,7 @@ simplify sideCondition original = | otherwise = do output <- MultiAnd.traverseOrAnd worker input if input == output - then pure output -- (MultiOr.map (MultiAnd.map Predicate.markSimplified) output) + then pure output else loop (count + 1) output replacePredicate = SideCondition.replacePredicate sideCondition @@ -123,6 +123,8 @@ simplify sideCondition original = worker predicate | Just predicate' <- replacePredicate predicate = worker predicate' + | Predicate.isSimplified repr predicate = + pure (mkSingleton predicate) | otherwise = case predicateF of AndF andF -> normalizeAnd =<< traverse worker andF @@ -313,6 +315,7 @@ normalizeNotAnd Not{notSort, notChild = predicates} = -- \not(\and(_, ...)) Predicate.fromMultiAnd predicates & fromNot + & Predicate.markSimplified & mkSingleton & pure bottom = normalizeBottom Bottom{bottomSort = notSort} diff --git a/kore/src/Kore/Simplify/Rule.hs b/kore/src/Kore/Simplify/Rule.hs index e9ced83439..6db9a9855a 100644 --- a/kore/src/Kore/Simplify/Rule.hs +++ b/kore/src/Kore/Simplify/Rule.hs @@ -86,10 +86,10 @@ simplifyRulePattern rule = do RulePattern{attributes} = rule return RulePattern - { left = left' - , antiLeft = antiLeft' - , requires = requires' - , rhs = rhs' + { left = TermLike.forgetSimplified left' + , antiLeft = AntiLeft.forgetSimplified <$> antiLeft' + , requires = Predicate.forgetSimplified requires' + , rhs = rhsForgetSimplified rhs' , attributes = attributes } _ -> @@ -120,6 +120,7 @@ simplifyClaimPattern claim = do let subst = Substitution.toMap substitution left' = Pattern.withCondition term (Pattern.withoutTerm left) in return + . ClaimPattern.forgetSimplified . substitute subst $ claim { ClaimPattern.left = left' diff --git a/kore/src/Kore/Simplify/SubstitutionSimplifier.hs b/kore/src/Kore/Simplify/SubstitutionSimplifier.hs index 7edffef7d8..98143b18fe 100644 --- a/kore/src/Kore/Simplify/SubstitutionSimplifier.hs +++ b/kore/src/Kore/Simplify/SubstitutionSimplifier.hs @@ -349,9 +349,16 @@ simplifySubstitutionWorker sideCondition makeAnd' = \substitution -> do simplifySingleSubstitution subst@(Assignment uVar termLike) = case variableName uVar of SomeVariableNameSet _ -> return subst - SomeVariableNameElement _ -> do - termLike' <- simplifyTermLike termLike - return $ Substitution.assign uVar termLike' + SomeVariableNameElement _ + | isSimplified -> return subst + | otherwise -> do + termLike' <- simplifyTermLike termLike + return $ Substitution.assign uVar termLike' + where + isSimplified = + TermLike.isSimplified + sideConditionRepresentation + termLike simplifyTermLike :: TermLike RewritingVariableName -> diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index deaa9cee0e..af355efc72 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -132,24 +132,16 @@ simplify :: TermLike RewritingVariableName -> simplifier (OrPattern RewritingVariableName) simplify sideCondition = - loop 0 . OrPattern.fromTermLike + loop . OrPattern.fromTermLike where - limit :: Int - limit = 4 - loop :: - Int -> OrPattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) - loop count input - | count >= limit = - trace "\nexceeded term simplifier limit\n" $ - pure input - | otherwise = do - output <- MultiOr.traverseOr (propagateConditions worker) input - if input == output - then pure output -- (OrPattern.markTermSimplifiedConditionally repr output) - else loop (count + 1) output + loop input = do + output <- MultiOr.traverseOr (propagateConditions worker) input + if input == output + then pure output + else loop output replaceTerm = SideCondition.replaceTerm sideCondition @@ -167,6 +159,8 @@ simplify sideCondition = worker termLike | Just termLike' <- replaceTerm termLike = worker termLike' + | TermLike.isSimplified repr termLike = + pure (OrPattern.fromTermLike termLike) | otherwise = case termLikeF of -- Not implemented: diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index ff1bfb56c5..07a0f9fd49 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -629,6 +629,30 @@ test_simplificationIntegration = assertBool "Expected simplified term" (TermLike.isSimplified sideRepresentation term) assertBool (unlines ["Expected simplified condition:", message]) (Condition.isSimplified sideRepresentation condition) assertBool message (Pattern.isSimplified sideRepresentation pattern') + , testCase "Equals-in simplification" $ do + let gt = + mkSetVariable (testId "gt") Mock.stringSort + & mapSetVariable (pure mkConfigVariable) + g = + mkSetVariable (testId "g") Mock.testSort1 + & mapSetVariable (pure mkConfigVariable) + actual <- + evaluate + Conditional + { term = + mkNu + gt + ( mkEquals_ + ( mkIn_ + mkTop_ + (mkNu g (mkOr Mock.aSort1 (mkSetVar g))) + ) + mkTop_ + ) + , predicate = makeTruePredicate + , substitution = mempty + } + assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "And-list simplification" $ do actual <- evaluate @@ -641,6 +665,44 @@ test_simplificationIntegration = , substitution = mempty } assertBool "" (OrPattern.isSimplified sideRepresentation actual) + , testCase "Distributed equals simplification" $ do + let k = + mkSetVariable (testId "k") Mock.stringSort + & mapSetVariable (pure mkConfigVariable) + actual <- + evaluate + Conditional + { term = + mkMu + k + ( mkEquals_ + (Mock.functionalConstr21 Mock.cf Mock.cf) + (Mock.functionalConstr21 Mock.ch Mock.cg) + ) + , predicate = makeTruePredicate + , substitution = mempty + } + assertBool "" (OrPattern.isSimplified sideRepresentation actual) + , testCase "nu-floor-in-or simplification" $ do + let q = + mkSetVariable (testId "q") Mock.otherSort + & mapSetVariable (pure mkConfigVariable) + actual <- + evaluate + Conditional + { term = + mkNu + q + ( mkFloor_ + ( mkIn_ + (Mock.g Mock.ch) + (mkOr Mock.cf Mock.cg) + ) + ) + , predicate = makeTruePredicate + , substitution = mempty + } + assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "equals-predicate with sort change simplification" $ do actual <- evaluate diff --git a/test/regression-wasm/test-memory.sh.out.golden b/test/regression-wasm/test-memory.sh.out.golden index 7f1e941fe0..8c23413ce9 100644 --- a/test/regression-wasm/test-memory.sh.out.golden +++ b/test/regression-wasm/test-memory.sh.out.golden @@ -1 +1 @@ -/* D */ \top{R}() \ No newline at end of file +/* D Sfa */ \top{R}() \ No newline at end of file diff --git a/test/regression-wasm/test-simple-arithmetic.sh.out.golden b/test/regression-wasm/test-simple-arithmetic.sh.out.golden index 7f1e941fe0..8c23413ce9 100644 --- a/test/regression-wasm/test-simple-arithmetic.sh.out.golden +++ b/test/regression-wasm/test-simple-arithmetic.sh.out.golden @@ -1 +1 @@ -/* D */ \top{R}() \ No newline at end of file +/* D Sfa */ \top{R}() \ No newline at end of file From b692b9a768eb3afb996acb8262bb76408ac5ca4e Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 10 Aug 2021 18:51:59 +0300 Subject: [PATCH 17/40] Add failing Floor test --- kore/test/Test/Kore/Simplify/Integration.hs | 34 +++++++++++++-------- 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index 07a0f9fd49..fd44cdb464 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -689,19 +689,27 @@ test_simplificationIntegration = & mapSetVariable (pure mkConfigVariable) actual <- evaluate - Conditional - { term = - mkNu - q - ( mkFloor_ - ( mkIn_ - (Mock.g Mock.ch) - (mkOr Mock.cf Mock.cg) - ) - ) - , predicate = makeTruePredicate - , substitution = mempty - } + ( mkNu + q + ( mkFloor_ + ( mkIn_ + (Mock.g Mock.ch) + (mkOr Mock.cf Mock.cg) + ) + ) + & Pattern.fromTermLike + ) + assertBool "" (OrPattern.isSimplified sideRepresentation actual) + , testCase "Predicate simplifier simplifies child predicates" $ do + actual <- + evaluate + ( makeFloorPredicate + ( mkIn Mock.testSort + Mock.cf + Mock.cf + ) + & Pattern.fromPredicateSorted Mock.testSort + ) assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "equals-predicate with sort change simplification" $ do actual <- From 7aed8d2fd26b55fa8fff5ba88eb3b2cc719f4870 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 10 Aug 2021 18:52:36 +0300 Subject: [PATCH 18/40] Fix simplification for predicates with term children --- kore/src/Kore/Simplify/Predicate.hs | 30 ++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index 453948ff73..b55362098f 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -17,6 +17,7 @@ import Kore.Attribute.Pattern.FreeVariables ( occursIn, ) import Kore.Internal.From +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.MultiAnd ( MultiAnd, ) @@ -25,6 +26,9 @@ import Kore.Internal.MultiOr ( MultiOr, ) import qualified Kore.Internal.MultiOr as MultiOr +import Kore.Internal.OrCondition ( + OrCondition, + ) import Kore.Internal.OrPattern ( OrPattern, ) @@ -91,6 +95,18 @@ import Prelude.Kore -} type NormalForm = MultiOr (MultiAnd (Predicate RewritingVariableName)) +toOrPattern :: Sort -> NormalForm -> OrPattern RewritingVariableName +toOrPattern sort = + MultiOr.map + ( Pattern.fromCondition sort + . from @(Predicate _) @(Condition _) + . Predicate.makeMultipleAndPredicate + . toList + ) + +fromOrCondition :: OrCondition RewritingVariableName -> NormalForm +fromOrCondition = MultiOr.map (from @(Condition _)) + simplify :: forall simplifier. MonadSimplify simplifier => @@ -117,7 +133,15 @@ simplify sideCondition original = replacePredicate = SideCondition.replacePredicate sideCondition - simplifyTerm = simplifyTermLikeOnly sideCondition + -- If the child 'TermLike' is a term representing a predicate, + -- 'simplifyTermLikeOnly' will not attempt to simplify it, so + -- it should be transformed into a 'Predicate' and simplified + -- accordingly. + simplifyTerm term + | Right predicate <- Predicate.makePredicate term = + toOrPattern (termLikeSort term) <$> worker predicate + | otherwise = + simplifyTermLikeOnly sideCondition term repr = SideCondition.toRepresentation sideCondition @@ -379,7 +403,7 @@ simplifyCeil :: Ceil sort (OrPattern RewritingVariableName) -> simplifier NormalForm simplifyCeil sideCondition = - Ceil.simplify sideCondition >=> return . MultiOr.map (from @(Condition _)) + Ceil.simplify sideCondition >=> return . fromOrCondition {- | @ @@ -520,4 +544,4 @@ simplifyIn :: In sort (OrPattern RewritingVariableName) -> simplifier NormalForm simplifyIn sideCondition = - In.simplify sideCondition >=> return . MultiOr.map (from @(Condition _)) + In.simplify sideCondition >=> return . fromOrCondition From e73dbd9835eece2d9b3edc7effd325393101955f Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 10 Aug 2021 19:44:49 +0300 Subject: [PATCH 19/40] Clean-up --- kore/src/Kore/Simplify/Predicate.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index b55362098f..ba9bafed31 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -98,8 +98,7 @@ type NormalForm = MultiOr (MultiAnd (Predicate RewritingVariableName)) toOrPattern :: Sort -> NormalForm -> OrPattern RewritingVariableName toOrPattern sort = MultiOr.map - ( Pattern.fromCondition sort - . from @(Predicate _) @(Condition _) + ( Pattern.fromPredicateSorted sort . Predicate.makeMultipleAndPredicate . toList ) From b58fc80b9bc3716cbd4b3ceafef790eaf57898ae Mon Sep 17 00:00:00 2001 From: github-actions Date: Tue, 10 Aug 2021 16:46:58 +0000 Subject: [PATCH 20/40] Format with fourmolu --- kore/src/Kore/Simplify/Predicate.hs | 6 +++--- kore/test/Test/Kore/Simplify/Integration.hs | 15 ++++++++------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index ba9bafed31..61ac4512eb 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -17,7 +17,6 @@ import Kore.Attribute.Pattern.FreeVariables ( occursIn, ) import Kore.Internal.From -import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.MultiAnd ( MultiAnd, ) @@ -35,6 +34,7 @@ import Kore.Internal.OrPattern ( import Kore.Internal.Pattern ( Condition, ) +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( Predicate, PredicateF (..), @@ -99,8 +99,8 @@ toOrPattern :: Sort -> NormalForm -> OrPattern RewritingVariableName toOrPattern sort = MultiOr.map ( Pattern.fromPredicateSorted sort - . Predicate.makeMultipleAndPredicate - . toList + . Predicate.makeMultipleAndPredicate + . toList ) fromOrCondition :: OrCondition RewritingVariableName -> NormalForm diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index fd44cdb464..b206e038ba 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -697,19 +697,20 @@ test_simplificationIntegration = (mkOr Mock.cf Mock.cg) ) ) - & Pattern.fromTermLike + & Pattern.fromTermLike ) assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "Predicate simplifier simplifies child predicates" $ do actual <- evaluate - ( makeFloorPredicate - ( mkIn Mock.testSort - Mock.cf - Mock.cf - ) - & Pattern.fromPredicateSorted Mock.testSort + ( makeFloorPredicate + ( mkIn + Mock.testSort + Mock.cf + Mock.cf ) + & Pattern.fromPredicateSorted Mock.testSort + ) assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "equals-predicate with sort change simplification" $ do actual <- From 0e18ea309348236a36116328dfb0ab16dca9d1d4 Mon Sep 17 00:00:00 2001 From: github-actions Date: Mon, 16 Aug 2021 12:12:36 +0000 Subject: [PATCH 21/40] Format with fourmolu --- kore/src/Kore/Simplify/Predicate.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index fa80c67c09..dbd161ed82 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -34,12 +34,12 @@ import Kore.Internal.OrPattern ( import Kore.Internal.Pattern ( Condition, ) +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( Predicate, PredicateF (..), ) import qualified Kore.Internal.Predicate as Predicate -import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.SideCondition ( SideCondition, ) From 4d9f91a035f00b47a67b7c021962752c7fb595d1 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Mon, 16 Aug 2021 20:24:05 +0300 Subject: [PATCH 22/40] Add prototype Predicate generator --- kore/test/Test/ConsistentKore.hs | 39 +++++++++++++++++++ .../Test/Kore/Simplify/IntegrationProperty.hs | 8 ++++ 2 files changed, 47 insertions(+) diff --git a/kore/test/Test/ConsistentKore.hs b/kore/test/Test/ConsistentKore.hs index 6e7c5aac10..59b9db4020 100644 --- a/kore/test/Test/ConsistentKore.hs +++ b/kore/test/Test/ConsistentKore.hs @@ -3,6 +3,8 @@ module Test.ConsistentKore ( Setup (..), runTermGen, termLikeGen, + -- testing + predicateGen, ) where import qualified Control.Arrow as Arrow @@ -24,6 +26,8 @@ import Data.Text ( import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range +import Kore.Internal.From +import Kore.Internal.Predicate (Predicate) import qualified Kore.Attribute.Constructor as Attribute.Constructor ( Constructor (..), ) @@ -241,6 +245,41 @@ termLikeGen = do | s < 10 = Range.Size s | otherwise = Range.Size 10 +-- TODO: +-- - will need the config for generating terms/variables +-- - make generated predicates smaller +predicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +predicateGen = + Gen.recursive + Gen.choice + [return fromTop_, return fromBottom_] + [ andPredicateGen + , orPredicateGen + , notPredicateGen + , impliesPredicateGen + , iffPredicateGen + ] + +andPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +andPredicateGen = + Gen.subterm2 predicateGen predicateGen fromAnd + +orPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +orPredicateGen = + Gen.subterm2 predicateGen predicateGen fromOr + +impliesPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +impliesPredicateGen = + Gen.subterm2 predicateGen predicateGen fromImplies + +iffPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +iffPredicateGen = + Gen.subterm2 predicateGen predicateGen fromIff + +notPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +notPredicateGen = + Gen.subterm predicateGen fromNot + termLikeGenImpl :: Range.Size -> Sort -> Gen (Maybe (TermLike VariableName)) termLikeGenImpl (Range.Size size) requestedSort = do allGenerators <- termGenerators diff --git a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs index a61ee64839..b08c3b86b3 100644 --- a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs +++ b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs @@ -1,11 +1,13 @@ module Test.Kore.Simplify.IntegrationProperty ( test_simplifiesToSimplified, test_regressionGeneratedTerms, + test_testingPredicateGen, ) where import Control.Exception ( ErrorCall (..), ) +import Pretty (pretty) import Control.Monad.Catch ( MonadThrow, catch, @@ -92,6 +94,12 @@ test_simplifiesToSimplified = traceM ("Error for input: " ++ unparseToString term) throwM err +test_testingPredicateGen :: TestTree +test_testingPredicateGen = + testPropertyWithoutSolver "TESTING" $ do + pred' <- forAll predicateGen + traceM (show . pretty $ pred') + test_regressionGeneratedTerms :: [TestTree] test_regressionGeneratedTerms = [ testCase "Term simplifier should not crash with not simplified error" $ do From 52146377e29150fbdda8d3213ef27a094b6e28c6 Mon Sep 17 00:00:00 2001 From: github-actions Date: Mon, 16 Aug 2021 17:26:37 +0000 Subject: [PATCH 23/40] Format with fourmolu --- kore/test/Test/ConsistentKore.hs | 4 ++-- kore/test/Test/Kore/Simplify/IntegrationProperty.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/ConsistentKore.hs b/kore/test/Test/ConsistentKore.hs index 59b9db4020..5bff08ad98 100644 --- a/kore/test/Test/ConsistentKore.hs +++ b/kore/test/Test/ConsistentKore.hs @@ -26,8 +26,6 @@ import Data.Text ( import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -import Kore.Internal.From -import Kore.Internal.Predicate (Predicate) import qualified Kore.Attribute.Constructor as Attribute.Constructor ( Constructor (..), ) @@ -71,9 +69,11 @@ import qualified Kore.Internal.Alias as Internal ( import Kore.Internal.ApplicationSorts ( ApplicationSorts (ApplicationSorts), ) +import Kore.Internal.From import Kore.Internal.InternalMap import Kore.Internal.InternalSet import Kore.Internal.InternalString +import Kore.Internal.Predicate (Predicate) import qualified Kore.Internal.Symbol as Internal ( Symbol (Symbol), ) diff --git a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs index b08c3b86b3..e2501c6e1b 100644 --- a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs +++ b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs @@ -7,7 +7,6 @@ module Test.Kore.Simplify.IntegrationProperty ( import Control.Exception ( ErrorCall (..), ) -import Pretty (pretty) import Control.Monad.Catch ( MonadThrow, catch, @@ -57,6 +56,7 @@ import qualified Kore.Simplify.Pattern as Pattern ( import Kore.Simplify.Simplify import Kore.Unparser import Prelude.Kore +import Pretty (pretty) import qualified SMT import Test.ConsistentKore import qualified Test.Kore.Rewrite.MockSymbols as Mock From 7c2c9e0d09a7b5c79682d2714f4514e6efd4e561 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 17 Aug 2021 13:48:50 +0300 Subject: [PATCH 24/40] Implement Predicate generator, clean-up --- kore/test/Test/ConsistentKore.hs | 145 ++++++++---------- .../Test/Kore/Simplify/IntegrationProperty.hs | 22 +-- 2 files changed, 72 insertions(+), 95 deletions(-) diff --git a/kore/test/Test/ConsistentKore.hs b/kore/test/Test/ConsistentKore.hs index 59b9db4020..a897271d9c 100644 --- a/kore/test/Test/ConsistentKore.hs +++ b/kore/test/Test/ConsistentKore.hs @@ -1,10 +1,8 @@ module Test.ConsistentKore ( CollectionSorts (..), Setup (..), - runTermGen, - termLikeGen, - -- testing - predicateGen, + runKoreGen, + patternGen, ) where import qualified Control.Arrow as Arrow @@ -14,6 +12,8 @@ import Control.Monad.Reader ( ) import qualified Control.Monad.Reader as Reader import qualified Data.Functor.Foldable as Recursive +import Kore.Internal.Pattern (Pattern) +import qualified Kore.Internal.Pattern as Pattern import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List ( foldl', @@ -86,15 +86,11 @@ import Kore.Internal.TermLike ( mkApplyAlias, mkApplySymbol, mkBottom, - mkCeil, mkElemVar, - mkEquals, mkExists, - mkFloor, mkForall, mkIff, mkImplies, - mkIn, mkInternalBool, mkInternalInt, mkInternalList, @@ -190,8 +186,8 @@ data Setup = Setup type Gen = ReaderT (Setup, Context) Hedgehog.Gen -runTermGen :: Setup -> Gen a -> Hedgehog.Gen a -runTermGen +runKoreGen :: Setup -> Gen a -> Hedgehog.Gen a +runKoreGen setup@Setup{freeElementVariables, freeSetVariables} generator = Reader.runReaderT generator (setup, context) @@ -204,6 +200,12 @@ runTermGen , onlyConcrete = False } +patternGen :: Gen (Pattern VariableName) +patternGen = + Pattern.fromTermAndPredicate + <$> termLikeGen + <*> predicateGen + addQuantifiedSetVariable :: SetVariable VariableName -> Context -> Context addQuantifiedSetVariable variable @@ -232,8 +234,11 @@ requestConcrete = localContext (\context -> context{onlyConcrete = True}) termLikeGen :: Gen (TermLike VariableName) -termLikeGen = do - topSort <- sortGen +termLikeGen = + sortGen >>= termLikeGenWithSort + +termLikeGenWithSort :: Sort -> Gen (TermLike VariableName) +termLikeGenWithSort topSort = do maybeResult <- Gen.scale limitTermDepth $ Gen.sized (\size -> termLikeGenImpl size topSort) @@ -246,9 +251,8 @@ termLikeGen = do | otherwise = Range.Size 10 -- TODO: --- - will need the config for generating terms/variables -- - make generated predicates smaller -predicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +predicateGen :: Gen (Predicate VariableName) predicateGen = Gen.recursive Gen.choice @@ -258,28 +262,68 @@ predicateGen = , notPredicateGen , impliesPredicateGen , iffPredicateGen + , ceilGen + , floorGen + , equalsGen + , inGen + , existsPredicateGen + , forallPredicateGen ] -andPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +andPredicateGen :: Gen (Predicate VariableName) andPredicateGen = Gen.subterm2 predicateGen predicateGen fromAnd -orPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +orPredicateGen :: Gen (Predicate VariableName) orPredicateGen = Gen.subterm2 predicateGen predicateGen fromOr -impliesPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +impliesPredicateGen :: Gen (Predicate VariableName) impliesPredicateGen = Gen.subterm2 predicateGen predicateGen fromImplies -iffPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +iffPredicateGen :: Gen (Predicate VariableName) iffPredicateGen = Gen.subterm2 predicateGen predicateGen fromIff -notPredicateGen :: Hedgehog.MonadGen m => m (Predicate VariableName) +notPredicateGen :: Gen (Predicate VariableName) notPredicateGen = Gen.subterm predicateGen fromNot +ceilGen :: Gen (Predicate VariableName) +ceilGen = + fromCeil_ <$> termLikeGen + +floorGen :: Gen (Predicate VariableName) +floorGen = + fromFloor_ <$> termLikeGen + +equalsGen :: Gen (Predicate VariableName) +equalsGen = do + sort' <- sortGen + fromEquals_ + <$> termLikeGenWithSort sort' + <*> termLikeGenWithSort sort' + +inGen :: Gen (Predicate VariableName) +inGen = do + sort' <- sortGen + fromIn_ + <$> termLikeGenWithSort sort' + <*> termLikeGenWithSort sort' + +existsPredicateGen :: Gen (Predicate VariableName) +existsPredicateGen = do + sort' <- sortGen + variable <- elementVariableGen sort' + Gen.subterm predicateGen (fromExists variable) + +forallPredicateGen :: Gen (Predicate VariableName) +forallPredicateGen = do + sort' <- sortGen + variable <- elementVariableGen sort' + Gen.subterm predicateGen (fromForall variable) + termLikeGenImpl :: Range.Size -> Sort -> Gen (Maybe (TermLike VariableName)) termLikeGenImpl (Range.Size size) requestedSort = do allGenerators <- termGenerators @@ -375,19 +419,15 @@ termGenerators = do filterGeneratorsAndGroup [ andGenerator , bottomGenerator - , ceilGenerator - , equalsGenerator , existsGenerator - , floorGenerator , forallGenerator , iffGenerator , impliesGenerator - , inGenerator - , muGenerator , notGenerator - , nuGenerator , orGenerator , topGenerator + , nuGenerator + , muGenerator ] literals <- filterGeneratorsAndGroup @@ -464,27 +504,6 @@ unaryOperatorGenerator builder = return (builder <$> child) -- Maybe functor -unaryFreeSortOperatorGenerator :: - (Sort -> TermLike VariableName -> TermLike VariableName) -> - TermGenerator -unaryFreeSortOperatorGenerator builder = - TermGenerator - { arity = 1 - , sort = AnySort - , attributes = - AttributeRequirements - { isConstructorLike = False - , isConcrete = True - } - , generator = worker - } - where - worker childGenerator resultSort = do - childSort <- sortGen - child <- childGenerator childSort - return - (builder resultSort <$> child) -- Maybe functor - unaryQuantifiedElementOperatorGenerator :: (ElementVariable VariableName -> TermLike VariableName -> TermLike VariableName) -> TermGenerator @@ -534,28 +553,6 @@ muNuOperatorGenerator builder = return (builder quantifiedVariable <$> child) -- Maybe functor -binaryFreeSortOperatorGenerator :: - (Sort -> TermLike VariableName -> TermLike VariableName -> TermLike VariableName) -> - TermGenerator -binaryFreeSortOperatorGenerator builder = - TermGenerator - { arity = 2 - , sort = AnySort - , attributes = - AttributeRequirements - { isConstructorLike = False - , isConcrete = True - } - , generator = worker - } - where - worker childGenerator resultSort = do - childSort <- sortGen - child1 <- childGenerator childSort - child2 <- childGenerator childSort - return - (builder resultSort <$> child1 <*> child2) -- Maybe applicative - binaryOperatorGenerator :: (TermLike VariableName -> TermLike VariableName -> TermLike VariableName) -> TermGenerator @@ -583,18 +580,9 @@ andGenerator = binaryOperatorGenerator mkAnd bottomGenerator :: TermGenerator bottomGenerator = nullaryFreeSortOperatorGenerator mkBottom -ceilGenerator :: TermGenerator -ceilGenerator = unaryFreeSortOperatorGenerator mkCeil - -equalsGenerator :: TermGenerator -equalsGenerator = binaryFreeSortOperatorGenerator mkEquals - existsGenerator :: TermGenerator existsGenerator = unaryQuantifiedElementOperatorGenerator mkExists -floorGenerator :: TermGenerator -floorGenerator = unaryFreeSortOperatorGenerator mkFloor - forallGenerator :: TermGenerator forallGenerator = unaryQuantifiedElementOperatorGenerator mkForall @@ -604,9 +592,6 @@ iffGenerator = binaryOperatorGenerator mkIff impliesGenerator :: TermGenerator impliesGenerator = binaryOperatorGenerator mkImplies -inGenerator :: TermGenerator -inGenerator = binaryFreeSortOperatorGenerator mkIn - muGenerator :: TermGenerator muGenerator = muNuOperatorGenerator mkMu diff --git a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs index b08c3b86b3..629f125e74 100644 --- a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs +++ b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs @@ -1,13 +1,11 @@ module Test.Kore.Simplify.IntegrationProperty ( test_simplifiesToSimplified, test_regressionGeneratedTerms, - test_testingPredicateGen, ) where import Control.Exception ( ErrorCall (..), ) -import Pretty (pretty) import Control.Monad.Catch ( MonadThrow, catch, @@ -48,7 +46,7 @@ import Kore.Rewrite.Axiom.EvaluationStrategy ( ) import Kore.Rewrite.RewritingVariable ( RewritingVariableName, - mkRewritingTerm, + mkRewritingPattern, ) import qualified Kore.Simplify.Data as Simplification import qualified Kore.Simplify.Pattern as Pattern ( @@ -70,20 +68,20 @@ import Test.Tasty.HUnit.Ext test_simplifiesToSimplified :: TestTree test_simplifiesToSimplified = testPropertyWithoutSolver "simplify returns simplified pattern" $ do - term <- forAll (runTermGen Mock.generatorSetup termLikeGen) - let term' = mkRewritingTerm term + patt <- forAll (runKoreGen Mock.generatorSetup patternGen) + let patt' = mkRewritingPattern patt (annotate . unlines) - [" ***** unparsed input =", unparseToString term, " ***** "] + [" ***** unparsed input =", unparseToString patt, " ***** "] simplified <- catch - (evaluateT (Pattern.fromTermLike term')) - (exceptionHandler term) + (evaluateT patt') + (exceptionHandler patt) (===) True (OrPattern.isSimplified sideRepresentation simplified) where -- Discard exceptions that are normal for randomly generated patterns. exceptionHandler :: MonadThrow m => - TermLike VariableName -> + Pattern VariableName -> ErrorCall -> PropertyT m a exceptionHandler term err@(ErrorCallWithLocation message _location) @@ -94,12 +92,6 @@ test_simplifiesToSimplified = traceM ("Error for input: " ++ unparseToString term) throwM err -test_testingPredicateGen :: TestTree -test_testingPredicateGen = - testPropertyWithoutSolver "TESTING" $ do - pred' <- forAll predicateGen - traceM (show . pretty $ pred') - test_regressionGeneratedTerms :: [TestTree] test_regressionGeneratedTerms = [ testCase "Term simplifier should not crash with not simplified error" $ do From 9eed31624f91a2bcf4e28d88a8c033b7b9dddb75 Mon Sep 17 00:00:00 2001 From: github-actions Date: Tue, 17 Aug 2021 10:51:55 +0000 Subject: [PATCH 25/40] Format with fourmolu --- kore/test/Test/ConsistentKore.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/ConsistentKore.hs b/kore/test/Test/ConsistentKore.hs index a993636278..6d55da819e 100644 --- a/kore/test/Test/ConsistentKore.hs +++ b/kore/test/Test/ConsistentKore.hs @@ -12,8 +12,6 @@ import Control.Monad.Reader ( ) import qualified Control.Monad.Reader as Reader import qualified Data.Functor.Foldable as Recursive -import Kore.Internal.Pattern (Pattern) -import qualified Kore.Internal.Pattern as Pattern import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List ( foldl', @@ -73,6 +71,8 @@ import Kore.Internal.From import Kore.Internal.InternalMap import Kore.Internal.InternalSet import Kore.Internal.InternalString +import Kore.Internal.Pattern (Pattern) +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate (Predicate) import qualified Kore.Internal.Symbol as Internal ( Symbol (Symbol), From 5c88ecbd66e8d6ee5c8e70c79fde68e5db38e09c Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 17 Aug 2021 14:13:18 +0300 Subject: [PATCH 26/40] Remove todo --- kore/test/Test/ConsistentKore.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/kore/test/Test/ConsistentKore.hs b/kore/test/Test/ConsistentKore.hs index 6d55da819e..2d92b6b77d 100644 --- a/kore/test/Test/ConsistentKore.hs +++ b/kore/test/Test/ConsistentKore.hs @@ -250,8 +250,6 @@ termLikeGenWithSort topSort = do | s < 10 = Range.Size s | otherwise = Range.Size 10 --- TODO: --- - make generated predicates smaller predicateGen :: Gen (Predicate VariableName) predicateGen = Gen.recursive From 4556b54d9d490dbc9b3ab94a15790f045e60338d Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 17 Aug 2021 14:53:45 +0300 Subject: [PATCH 27/40] Fix test data --- kore/test/Test/Kore/Simplify/Integration.hs | 39 +++++++++---------- .../Test/Kore/Simplify/IntegrationProperty.hs | 1 - 2 files changed, 18 insertions(+), 22 deletions(-) diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index b206e038ba..95ac24e86f 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -629,9 +629,9 @@ test_simplificationIntegration = assertBool "Expected simplified term" (TermLike.isSimplified sideRepresentation term) assertBool (unlines ["Expected simplified condition:", message]) (Condition.isSimplified sideRepresentation condition) assertBool message (Pattern.isSimplified sideRepresentation pattern') - , testCase "Equals-in simplification" $ do + , testCase "Nu-And simplification" $ do let gt = - mkSetVariable (testId "gt") Mock.stringSort + mkSetVariable (testId "gt") Mock.testSort1 & mapSetVariable (pure mkConfigVariable) g = mkSetVariable (testId "g") Mock.testSort1 @@ -642,8 +642,8 @@ test_simplificationIntegration = { term = mkNu gt - ( mkEquals_ - ( mkIn_ + ( mkAnd + ( mkAnd mkTop_ (mkNu g (mkOr Mock.aSort1 (mkSetVar g))) ) @@ -665,34 +665,31 @@ test_simplificationIntegration = , substitution = mempty } assertBool "" (OrPattern.isSimplified sideRepresentation actual) - , testCase "Distributed equals simplification" $ do + , testCase "Nu over distributed and simplification" $ do let k = - mkSetVariable (testId "k") Mock.stringSort + mkSetVariable (testId "k") Mock.testSort & mapSetVariable (pure mkConfigVariable) actual <- evaluate - Conditional - { term = - mkMu - k - ( mkEquals_ - (Mock.functionalConstr21 Mock.cf Mock.cf) - (Mock.functionalConstr21 Mock.ch Mock.cg) - ) - , predicate = makeTruePredicate - , substitution = mempty - } + ( mkMu + k + ( mkAnd + (Mock.functionalConstr21 Mock.cf Mock.cf) + (Mock.functionalConstr21 Mock.ch Mock.cg) + ) + & Pattern.fromTermLike + ) assertBool "" (OrPattern.isSimplified sideRepresentation actual) - , testCase "nu-floor-in-or simplification" $ do + , testCase "nu-not-and-or simplification" $ do let q = - mkSetVariable (testId "q") Mock.otherSort + mkSetVariable (testId "q") Mock.testSort & mapSetVariable (pure mkConfigVariable) actual <- evaluate ( mkNu q - ( mkFloor_ - ( mkIn_ + ( mkNot + ( mkAnd (Mock.g Mock.ch) (mkOr Mock.cf Mock.cg) ) diff --git a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs index 221800881c..629f125e74 100644 --- a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs +++ b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs @@ -55,7 +55,6 @@ import qualified Kore.Simplify.Pattern as Pattern ( import Kore.Simplify.Simplify import Kore.Unparser import Prelude.Kore -import Pretty (pretty) import qualified SMT import Test.ConsistentKore import qualified Test.Kore.Rewrite.MockSymbols as Mock From 1801482aaa3bc0841ad63ccbafc93c10c7104d57 Mon Sep 17 00:00:00 2001 From: github-actions Date: Tue, 17 Aug 2021 11:55:46 +0000 Subject: [PATCH 28/40] Format with fourmolu --- kore/test/Test/Kore/Simplify/Integration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index 95ac24e86f..cca58fff1b 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -677,7 +677,7 @@ test_simplificationIntegration = (Mock.functionalConstr21 Mock.cf Mock.cf) (Mock.functionalConstr21 Mock.ch Mock.cg) ) - & Pattern.fromTermLike + & Pattern.fromTermLike ) assertBool "" (OrPattern.isSimplified sideRepresentation actual) , testCase "nu-not-and-or simplification" $ do From 91318f0ff602b1cabbcc6fb4494f99c97657d425 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 17 Aug 2021 16:32:29 +0300 Subject: [PATCH 29/40] kore-test: change to evaluateTerm and evaluatePredicate --- kore/test/Test/Kore/Builtin/Bool.hs | 4 +- kore/test/Test/Kore/Builtin/Builtin.hs | 32 ++- kore/test/Test/Kore/Builtin/Int.hs | 35 +-- kore/test/Test/Kore/Builtin/InternalBytes.hs | 44 +-- kore/test/Test/Kore/Builtin/KEqual.hs | 33 +-- kore/test/Test/Kore/Builtin/List.hs | 127 ++++----- kore/test/Test/Kore/Builtin/Map.hs | 271 ++++++++++--------- kore/test/Test/Kore/Builtin/Set.hs | 157 +++++------ kore/test/Test/Kore/Builtin/String.hs | 4 +- kore/test/Test/Kore/Simplify/Integration.hs | 124 ++++----- 10 files changed, 425 insertions(+), 406 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Bool.hs b/kore/test/Test/Kore/Builtin/Bool.hs index 312125067d..e536b8d3ef 100644 --- a/kore/test/Test/Kore/Builtin/Bool.hs +++ b/kore/test/Test/Kore/Builtin/Bool.hs @@ -114,7 +114,7 @@ testBinary symb impl = a <- forAll Gen.bool b <- forAll Gen.bool let expect = asOrPattern $ impl a b - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a, b]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a, b]) (===) expect actual where name = expectHook symb @@ -130,7 +130,7 @@ testUnary symb impl = testPropertyWithSolver (Text.unpack name) $ do a <- forAll Gen.bool let expect = asOrPattern $ impl a - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a]) (===) expect actual where name = expectHook symb diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index d810bbbba8..347401da2f 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -9,8 +9,10 @@ module Test.Kore.Builtin.Builtin ( testEvaluators, testSymbolWithoutSolver, simplify, - evaluate, - evaluateT, + evaluateTerm, + evaluateTermT, + evaluatePredicate, + evaluatePredicateT, evaluateToList, indexedModule, verifiedModule, @@ -33,6 +35,7 @@ import Data.Text ( ) import qualified Hedgehog import qualified Kore.Attribute.Null as Attribute +import Kore.Internal.Predicate (Predicate) import Kore.Attribute.Symbol as Attribute import qualified Kore.Builtin as Builtin import Kore.Error ( @@ -243,20 +246,35 @@ simplify = . Logic.observeAllT . (simplifyTerm SideCondition.top >=> Logic.scatter) -evaluate :: +evaluateTerm :: (MonadSMT smt, MonadLog smt, MonadProf smt, MonadMask smt) => TermLike RewritingVariableName -> smt (OrPattern RewritingVariableName) -evaluate termLike = - runSimplifier testEnv $ do +evaluateTerm termLike = + runSimplifier testEnv $ Pattern.simplify (Pattern.fromTermLike termLike) -evaluateT :: +evaluatePredicate :: + (MonadSMT smt, MonadLog smt, MonadProf smt, MonadMask smt) => + Predicate RewritingVariableName -> + smt (OrPattern RewritingVariableName) +evaluatePredicate predicate = + runSimplifier testEnv $ + Pattern.simplify (Pattern.fromTermAndPredicate mkTop_ predicate) + +evaluateTermT :: MonadTrans t => (MonadSMT smt, MonadLog smt, MonadProf smt, MonadMask smt) => TermLike RewritingVariableName -> t smt (OrPattern RewritingVariableName) -evaluateT = lift . evaluate +evaluateTermT = lift . evaluateTerm + +evaluatePredicateT :: + MonadTrans t => + (MonadSMT smt, MonadLog smt, MonadProf smt, MonadMask smt) => + Predicate RewritingVariableName -> + t smt (OrPattern RewritingVariableName) +evaluatePredicateT = lift . evaluatePredicate evaluateToList :: TermLike RewritingVariableName -> diff --git a/kore/test/Test/Kore/Builtin/Int.hs b/kore/test/Test/Kore/Builtin/Int.hs index d5ccde92c9..50a13322af 100644 --- a/kore/test/Test/Kore/Builtin/Int.hs +++ b/kore/test/Test/Kore/Builtin/Int.hs @@ -72,6 +72,7 @@ import Hedgehog hiding ( Concrete, ) import qualified Hedgehog.Gen as Gen +import Kore.Internal.From import qualified Hedgehog.Range as Range import Kore.Builtin.Int ( ediv, @@ -147,7 +148,7 @@ testUnary symb impl = testPropertyWithSolver (Text.unpack name) $ do a <- forAll genInteger let expect = asOrPattern $ impl a - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a]) (===) expect actual where name = expectHook symb @@ -164,7 +165,7 @@ testBinary symb impl = a <- forAll genInteger b <- forAll genInteger let expect = asOrPattern $ impl a b - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a, b]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a, b]) (===) expect actual where name = expectHook symb @@ -181,7 +182,7 @@ testComparison symb impl = a <- forAll genInteger b <- forAll genInteger let expect = Test.Bool.asOrPattern $ impl a b - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a, b]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a, b]) (===) expect actual where name = expectHook symb @@ -197,7 +198,7 @@ testPartialUnary symb impl = testPropertyWithSolver (Text.unpack name) $ do a <- forAll genInteger let expect = asPartialOrPattern $ impl a - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a]) (===) expect actual where name = expectHook symb @@ -214,7 +215,7 @@ testPartialBinary symb impl = a <- forAll genInteger b <- forAll genInteger let expect = asPartialOrPattern $ impl a b - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a, b]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a, b]) (===) expect actual where name = expectHook symb @@ -232,7 +233,7 @@ testPartialBinaryZero symb impl = testPropertyWithSolver (Text.unpack name ++ " zero") $ do a <- forAll genInteger let expect = asPartialOrPattern $ impl a 0 - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a, 0]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a, 0]) (===) expect actual where name = expectHook symb @@ -250,7 +251,7 @@ testPartialTernary symb impl = b <- forAll genInteger c <- forAll genInteger let expect = asPartialOrPattern $ impl a b c - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a, b, c]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a, b, c]) (===) expect actual where name = expectHook symb @@ -400,7 +401,7 @@ test_euclidian_division_theorem = mkApplySymbol symbol (asInternal <$> [a, b]) - & evaluateT + & evaluateTermT & fmap extractValue extractValue :: OrPattern RewritingVariableName -> Integer extractValue (OrPattern.toTermLike -> term) = @@ -479,7 +480,7 @@ testInt :: [TermLike RewritingVariableName] -> OrPattern RewritingVariableName -> TestTree -testInt name = testSymbolWithoutSolver evaluate name +testInt name = testSymbolWithoutSolver evaluateTerm name -- | "\equal"ed internal Integers that are not equal test_unifyEqual_NotEqual :: TestTree @@ -487,7 +488,7 @@ test_unifyEqual_NotEqual = testCaseWithoutSMT "unifyEqual BuiltinInteger: Not Equal" $ do let dv1 = asInternal 1 dv2 = asInternal 2 - actual <- evaluate $ mkEquals_ dv1 dv2 + actual <- evaluatePredicate $ fromEquals_ dv1 dv2 assertEqual' "" OrPattern.bottom actual -- | "\equal"ed internal Integers that are equal @@ -495,7 +496,7 @@ test_unifyEqual_Equal :: TestTree test_unifyEqual_Equal = testCaseWithoutSMT "unifyEqual BuiltinInteger: Equal" $ do let dv1 = asInternal 2 - actual <- evaluate $ mkEquals_ dv1 dv1 + actual <- evaluatePredicate $ fromEquals_ dv1 dv1 assertEqual' "" OrPattern.top actual -- | "\and"ed internal Integers that are not equal @@ -504,7 +505,7 @@ test_unifyAnd_NotEqual = testCaseWithoutSMT "unifyAnd BuiltinInteger: Not Equal" $ do let dv1 = asInternal 1 dv2 = asInternal 2 - actual <- evaluate $ mkAnd dv1 dv2 + actual <- evaluateTerm $ mkAnd dv1 dv2 assertEqual' "" OrPattern.bottom actual -- | "\and"ed internal Integers that are equal @@ -512,7 +513,7 @@ test_unifyAnd_Equal :: TestTree test_unifyAnd_Equal = testCaseWithoutSMT "unifyAnd BuiltinInteger: Equal" $ do let dv1 = asInternal 2 - actual <- evaluate $ mkAnd dv1 dv1 + actual <- evaluateTerm $ mkAnd dv1 dv1 assertEqual' "" (OrPattern.fromTermLike dv1) actual -- | "\and"ed then "\equal"ed internal Integers that are equal @@ -520,7 +521,7 @@ test_unifyAndEqual_Equal :: TestTree test_unifyAndEqual_Equal = testCaseWithoutSMT "unifyAnd BuiltinInteger: Equal" $ do let dv = asInternal 0 - actual <- evaluate $ mkEquals_ dv $ mkAnd dv dv + actual <- evaluatePredicate $ fromEquals_ dv $ mkAnd dv dv assertEqual' "" OrPattern.top actual -- | Internal Integer "\and"ed with builtin function applied to variable @@ -538,7 +539,7 @@ test_unifyAnd_Fn = , substitution = mempty } & MultiOr.singleton - actual <- evaluateT $ mkAnd dv fnPat + actual <- evaluateTermT $ mkAnd dv fnPat (===) expect actual test_reflexivity_symbolic :: TestTree @@ -546,7 +547,7 @@ test_reflexivity_symbolic = testCaseWithoutSMT "evaluate symbolic reflexivity for equality" $ do let x = mkElemVar $ "x" `ofSort` intSort expect = Test.Bool.asOrPattern True - actual <- evaluate $ mkApplySymbol eqIntSymbol [x, x] + actual <- evaluateTerm $ mkApplySymbol eqIntSymbol [x, x] assertEqual' "" expect actual test_symbolic_eq_not_conclusive :: TestTree @@ -557,7 +558,7 @@ test_symbolic_eq_not_conclusive = expect = MultiOr.singleton . fromTermLike $ mkApplySymbol eqIntSymbol [x, y] - actual <- evaluate $ mkApplySymbol eqIntSymbol [x, y] + actual <- evaluateTerm $ mkApplySymbol eqIntSymbol [x, y] assertEqual' "" expect actual ofSort :: Text.Text -> Sort -> ElementVariable RewritingVariableName diff --git a/kore/test/Test/Kore/Builtin/InternalBytes.hs b/kore/test/Test/Kore/Builtin/InternalBytes.hs index 7d46075705..4e324a482e 100644 --- a/kore/test/Test/Kore/Builtin/InternalBytes.hs +++ b/kore/test/Test/Kore/Builtin/InternalBytes.hs @@ -75,7 +75,7 @@ test_update = bytes = BS.pack [val] expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol updateBytesSymbol [ asInternal bytes @@ -91,7 +91,7 @@ test_update = val' = toInteger $ ord val expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol updateBytesSymbol [ asInternal bytes @@ -106,7 +106,7 @@ test_update = val' = toInteger $ ord val expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol updateBytesSymbol [ asInternal bytes @@ -140,7 +140,7 @@ test_get = let bytes = E.encode8Bit str expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol getBytesSymbol [ asInternal bytes @@ -152,7 +152,7 @@ test_get = let bytes = E.encode8Bit str expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol getBytesSymbol [ asInternal bytes @@ -163,7 +163,7 @@ test_get = idx <- forAll $ Gen.int (Range.linear 0 256) let expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol getBytesSymbol [ asInternal "" @@ -195,7 +195,7 @@ test_substr = let bytes = E.encode8Bit str expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol substrBytesSymbol [ asInternal bytes @@ -209,7 +209,7 @@ test_substr = let bytes = E.encode8Bit str expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol substrBytesSymbol [ asInternal bytes @@ -224,7 +224,7 @@ test_substr = let bytes = E.encode8Bit str expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol substrBytesSymbol [ asInternal bytes @@ -280,7 +280,7 @@ test_replaceAt = let bytes = E.encode8Bit str expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol replaceAtBytesSymbol [ asInternal bytes @@ -293,7 +293,7 @@ test_replaceAt = idx <- forAll $ Gen.int (Range.linear 0 256) let expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol replaceAtBytesSymbol [ asInternal "" @@ -311,7 +311,7 @@ test_replaceAt = bytes' = E.encode8Bit new expect = OrPattern.bottom actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol replaceAtBytesSymbol [ asInternal bytes @@ -353,7 +353,7 @@ test_padRight = let bytes = E.encode8Bit str expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol padRightBytesSymbol [ asInternal bytes @@ -379,7 +379,7 @@ test_padLeft = let bytes = E.encode8Bit str expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol padLeftBytesSymbol [ asInternal bytes @@ -404,7 +404,7 @@ test_reverse = let bytes = E.encode8Bit str expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol reverseBytesSymbol [ mkApplySymbol @@ -444,7 +444,7 @@ test_concat = let bytes = E.encode8Bit str expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol concatBytesSymbol [ asInternal bytes @@ -456,7 +456,7 @@ test_concat = let bytes = E.encode8Bit str expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol concatBytesSymbol [ asInternal "" @@ -479,7 +479,7 @@ test_reverse_length = let bytes = E.encode8Bit str expect = Test.Int.asOrPattern $ toInteger $ BS.length bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol lengthBytesSymbol [ mkApplySymbol @@ -497,7 +497,7 @@ test_update_get = let bytes = E.encode8Bit str expect = asOrPattern bytes actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol updateBytesSymbol [ asInternal bytes @@ -516,7 +516,7 @@ test_bytes2string_string2bytes = str <- forAll genString let expect = Test.String.asOrPattern str actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol bytes2stringBytesSymbol [ mkApplySymbol @@ -534,7 +534,7 @@ test_decodeBytes_encodeBytes = map testProp encodings str <- forAll genString let expect = Test.String.asOrPattern str actual <- - evaluateT $ + evaluateTermT $ mkApplySymbol decodeBytesBytesSymbol [ Test.String.asInternal encoding @@ -717,4 +717,4 @@ testBytes :: [TermLike RewritingVariableName] -> OrPattern RewritingVariableName -> TestTree -testBytes name = testSymbolWithoutSolver evaluate name +testBytes name = testSymbolWithoutSolver evaluateTerm name diff --git a/kore/test/Test/Kore/Builtin/KEqual.hs b/kore/test/Test/Kore/Builtin/KEqual.hs index d82cd83a17..0a315b77c5 100644 --- a/kore/test/Test/Kore/Builtin/KEqual.hs +++ b/kore/test/Test/Kore/Builtin/KEqual.hs @@ -12,6 +12,7 @@ import Control.Monad.Trans.Maybe ( import qualified Data.Text as Text import Hedgehog import qualified Hedgehog.Gen as Gen +import Kore.Internal.From import qualified Kore.Builtin.KEqual as KEqual import qualified Kore.Internal.MultiOr as MultiOr import Kore.Internal.Pattern ( @@ -66,7 +67,7 @@ testBinary symb impl = b <- forAll Gen.bool let expect = Test.Bool.asOrPattern (impl a b) actual <- - evaluateT + evaluateTermT . mkApplySymbol symb $ inj kSort . Test.Bool.asInternal <$> [a, b] (===) expect actual @@ -80,49 +81,49 @@ test_KEqual = OrPattern.fromTermLike $ Test.Bool.asInternal True original = keqBool dotk dotk - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual , testCaseWithoutSMT "kseq(x, dotk) equals kseq(x, dotk)" $ do let expect = OrPattern.top xConfigElemVarKItemSort = configElementVariableFromId "x" kItemSort original = - mkEquals_ + fromEquals_ (Test.Bool.asInternal True) ( keqBool (kseq (mkElemVar xConfigElemVarKItemSort) dotk) (kseq (mkElemVar xConfigElemVarKItemSort) dotk) ) - actual <- evaluate original + actual <- evaluatePredicate original assertEqual' "" expect actual , testCaseWithoutSMT "kseq(inj(x), dotk) equals kseq(inj(x), dotk)" $ do let expect = OrPattern.top xConfigElemVarIdSort = configElementVariableFromId "x" idSort original = - mkEquals_ + fromEquals_ (Test.Bool.asInternal True) ( keqBool (kseq (inj kItemSort (mkElemVar xConfigElemVarIdSort)) dotk) (kseq (inj kItemSort (mkElemVar xConfigElemVarIdSort)) dotk) ) - actual <- evaluate original + actual <- evaluatePredicate original assertEqual' "" expect actual , testCaseWithoutSMT "distinct constructor-like terms" $ do let expect = OrPattern.top original = - mkEquals_ + fromEquals_ (Test.Bool.asInternal False) ( keqBool (kseq (inj kItemSort dvX) dotk) (kseq (inj kItemSort dvT) dotk) ) - actual <- evaluate original + actual <- evaluatePredicate original assertEqual' "" expect actual , testCaseWithoutSMT "distinct domain values" $ do let expect = OrPattern.fromTermLike $ Test.Bool.asInternal False original = keqBool (inj kSort dvT) (inj kSort dvX) - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual , testCaseWithoutSMT "distinct domain value K lists" $ do let expect = Test.Bool.asOrPattern False @@ -130,24 +131,24 @@ test_KEqual = keqBool (kseq (inj kItemSort dvT) dotk) (kseq (inj kItemSort dvX) dotk) - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual , testCaseWithoutSMT "Bottom ==K Top" $ do let expect = OrPattern.bottom original = keqBool (mkBottom kSort) (mkTop kSort) - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual , testCaseWithoutSMT "X ==K X" $ do let xVar = mkElemVar $ configElementVariableFromId "x" kSort expect = OrPattern.fromTermLike $ Test.Bool.asInternal True original = keqBool xVar xVar - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual , testCaseWithoutSMT "X =/=K X" $ do let xVar = mkElemVar $ configElementVariableFromId "x" kSort expect = OrPattern.fromTermLike $ Test.Bool.asInternal False original = kneqBool xVar xVar - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual ] @@ -161,7 +162,7 @@ test_KIte = (Test.Bool.asInternal True) (inj kSort $ Test.Bool.asInternal False) (inj kSort $ Test.Bool.asInternal True) - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual , testCaseWithoutSMT "false" $ do let expect = @@ -172,7 +173,7 @@ test_KIte = (Test.Bool.asInternal False) (inj kSort $ Test.Bool.asInternal False) (inj kSort $ Test.Bool.asInternal True) - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual , testCaseWithoutSMT "abstract" $ do let original = kiteK x y z @@ -180,7 +181,7 @@ test_KIte = x = mkElemVar $ configElementVariableFromId (testId "x") boolSort y = mkElemVar $ configElementVariableFromId (testId "y") kSort z = mkElemVar $ configElementVariableFromId (testId "z") kSort - actual <- evaluate original + actual <- evaluateTerm original assertEqual' "" expect actual ] diff --git a/kore/test/Test/Kore/Builtin/List.hs b/kore/test/Test/Kore/Builtin/List.hs index 38f1485b0d..7263f80eb6 100644 --- a/kore/test/Test/Kore/Builtin/List.hs +++ b/kore/test/Test/Kore/Builtin/List.hs @@ -45,6 +45,7 @@ import Kore.Internal.Predicate ( makeTruePredicate, ) import Kore.Internal.TermLike +import Kore.Internal.From import Kore.Rewrite.RewritingVariable ( RewritingVariableName, configElementVariableFromId, @@ -82,9 +83,9 @@ test_getUnit = [ mkApplySymbol unitListSymbol [] , Test.Int.asInternal k ] - predicate = mkEquals_ mkBottom_ patGet - (===) OrPattern.bottom =<< evaluateT patGet - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ mkBottom_ patGet + (===) OrPattern.bottom =<< evaluateTermT patGet + (===) OrPattern.top =<< evaluatePredicateT predicate test_getFirstElement :: TestTree test_getFirstElement = @@ -103,10 +104,10 @@ test_getFirstElement = Seq.Empty -> Nothing v Seq.:<| _ -> Just v patFirst = maybe mkBottom_ Test.Int.asInternal value - predicate = mkEquals_ patGet patFirst + predicate = fromEquals_ patGet patFirst let expectGet = Test.Int.asPartialPattern value - (===) (MultiOr.singleton expectGet) =<< evaluateT patGet - (===) OrPattern.top =<< evaluateT predicate + (===) (MultiOr.singleton expectGet) =<< evaluateTermT patGet + (===) OrPattern.top =<< evaluatePredicateT predicate test_getLastElement :: TestTree test_getLastElement = @@ -126,10 +127,10 @@ test_getLastElement = Seq.Empty -> Nothing _ Seq.:|> v -> Just v patFirst = maybe mkBottom_ Test.Int.asInternal value - predicate = mkEquals_ patGet patFirst + predicate = fromEquals_ patGet patFirst let expectGet = Test.Int.asPartialPattern value - (===) (MultiOr.singleton expectGet) =<< evaluateT patGet - (===) OrPattern.top =<< evaluateT predicate + (===) (MultiOr.singleton expectGet) =<< evaluateTermT patGet + (===) OrPattern.top =<< evaluatePredicateT predicate test_GetUpdate :: TestTree test_GetUpdate = @@ -148,16 +149,16 @@ test_GetUpdate = then do let patGet = getList patUpdated $ Test.Int.asInternal ix predicate = - mkEquals_ + fromEquals_ patGet value expect = Pattern.fromTermLike value - (===) OrPattern.top =<< evaluateT predicate - (===) (MultiOr.singleton expect) =<< evaluateT patGet + (===) OrPattern.top =<< evaluatePredicateT predicate + (===) (MultiOr.singleton expect) =<< evaluateTermT patGet else do - let predicate = mkEquals_ mkBottom_ patUpdated - (===) OrPattern.bottom =<< evaluateT patUpdated - (===) OrPattern.top =<< evaluateT predicate + let predicate = fromEquals_ mkBottom_ patUpdated + (===) OrPattern.bottom =<< evaluateTermT patUpdated + (===) OrPattern.top =<< evaluatePredicateT predicate test_inUnit :: TestTree test_inUnit = @@ -170,9 +171,9 @@ test_inUnit = let patValue = Test.Int.asInternal value patIn = inList patValue unitList patFalse = Test.Bool.asInternal False - predicate = mkEquals_ patFalse patIn - (===) (Test.Bool.asOrPattern False) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patFalse patIn + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patIn + (===) OrPattern.top =<< evaluatePredicateT predicate test_inElement :: TestTree test_inElement = @@ -186,9 +187,9 @@ test_inElement = patElement = elementList patValue patIn = inList patValue patElement patTrue = Test.Bool.asInternal True - predicate = mkEquals_ patIn patTrue - (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patIn patTrue + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patIn + (===) OrPattern.top =<< evaluatePredicateT predicate test_inConcat :: TestTree test_inConcat = @@ -205,9 +206,9 @@ test_inConcat = patConcat = concatList patValues patElement patIn = inList patValue patConcat patTrue = Test.Bool.asInternal True - predicate = mkEquals_ patIn patTrue - (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patIn patTrue + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patIn + (===) OrPattern.top =<< evaluatePredicateT predicate test_concatUnit :: TestTree test_concatUnit = @@ -221,13 +222,13 @@ test_concatUnit = patValues = asTermLike (Test.Int.asInternal <$> values) patConcat1 = mkApplySymbol concatListSymbol [patUnit, patValues] patConcat2 = mkApplySymbol concatListSymbol [patValues, patUnit] - predicate1 = mkEquals_ patValues patConcat1 - predicate2 = mkEquals_ patValues patConcat2 - expectValues <- evaluateT patValues - (===) expectValues =<< evaluateT patConcat1 - (===) expectValues =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + predicate1 = fromEquals_ patValues patConcat1 + predicate2 = fromEquals_ patValues patConcat2 + expectValues <- evaluateTermT patValues + (===) expectValues =<< evaluateTermT patConcat1 + (===) expectValues =<< evaluateTermT patConcat2 + (===) OrPattern.top =<< evaluatePredicateT predicate1 + (===) OrPattern.top =<< evaluatePredicateT predicate2 test_concatUnitSymbolic :: TestTree test_concatUnitSymbolic = @@ -241,13 +242,13 @@ test_concatUnitSymbolic = mkElemVar $ configElementVariableFromId (testId "x") listSort patConcat1 = mkApplySymbol concatListSymbol [patUnit, patSymbolic] patConcat2 = mkApplySymbol concatListSymbol [patSymbolic, patUnit] - predicate1 = mkEquals_ patSymbolic patConcat1 - predicate2 = mkEquals_ patSymbolic patConcat2 - expectSymbolic <- evaluateT patSymbolic - (===) expectSymbolic =<< evaluateT patConcat1 - (===) expectSymbolic =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + predicate1 = fromEquals_ patSymbolic patConcat1 + predicate2 = fromEquals_ patSymbolic patConcat2 + expectSymbolic <- evaluateTermT patSymbolic + (===) expectSymbolic =<< evaluateTermT patConcat1 + (===) expectSymbolic =<< evaluateTermT patConcat2 + (===) OrPattern.top =<< evaluatePredicateT predicate1 + (===) OrPattern.top =<< evaluatePredicateT predicate2 test_concatAssociates :: TestTree test_concatAssociates = @@ -268,11 +269,11 @@ test_concatAssociates = mkApplySymbol concatListSymbol [patConcat12, patList3] patConcat1_23 = mkApplySymbol concatListSymbol [patList1, patConcat23] - predicate = mkEquals_ patConcat12_3 patConcat1_23 - evalConcat12_3 <- evaluateT patConcat12_3 - evalConcat1_23 <- evaluateT patConcat1_23 + predicate = fromEquals_ patConcat12_3 patConcat1_23 + evalConcat12_3 <- evaluateTermT patConcat12_3 + evalConcat1_23 <- evaluateTermT patConcat1_23 (===) evalConcat12_3 evalConcat1_23 - (===) OrPattern.top =<< evaluateT predicate + (===) OrPattern.top =<< evaluatePredicateT predicate test_concatSymbolic :: TestTree test_concatSymbolic = @@ -310,7 +311,7 @@ test_concatSymbolic = ) } & MultiOr.singleton - unified <- evaluateT patUnifiedXY + unified <- evaluateTermT patUnifiedXY expect === unified let patConcatX' = concatList patSymbolicXs patElemX @@ -330,7 +331,7 @@ test_concatSymbolic = ) } & MultiOr.singleton - unified' <- evaluateT patUnifiedXY' + unified' <- evaluateTermT patUnifiedXY' expect' === unified' test_concatSymbolicDifferentLengths :: TestTree @@ -376,7 +377,7 @@ test_concatSymbolicDifferentLengths = ) } & MultiOr.singleton - unified <- evaluateT patUnifiedXY + unified <- evaluateTermT patUnifiedXY expect === unified ofSort :: Text -> Sort -> ElementVariable RewritingVariableName @@ -390,7 +391,7 @@ test_simplify = let x = mkElemVar (configElementVariableFromId (testId "x") intSort) original = asInternal [mkAnd x mkTop_] expected = MultiOr.singleton $ asPattern [x] - (===) expected =<< evaluateT original + (===) expected =<< evaluateTermT original test_isBuiltin :: [TestTree] test_isBuiltin = @@ -413,41 +414,41 @@ test_size = [ testPropertyWithSolver "size(unit(_)) = 0" $ do let original = sizeList unitList zero = mkInt 0 - predicate = mkEquals_ zero original - (===) (OrPattern.fromTermLike zero) =<< evaluateT original - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ zero original + (===) (OrPattern.fromTermLike zero) =<< evaluateTermT original + (===) OrPattern.top =<< evaluatePredicateT predicate , testPropertyWithSolver "size(element(_)) = 1" $ do k <- forAll genInteger let original = sizeList (elementList $ mkInt k) one = mkInt 1 - predicate = mkEquals_ one original - (===) (OrPattern.fromTermLike one) =<< evaluateT original - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ one original + (===) (OrPattern.fromTermLike one) =<< evaluateTermT original + (===) OrPattern.top =<< evaluatePredicateT predicate , testPropertyWithSolver "size(a + b) = size(a) + size(b)" $ do as <- asInternal . fmap mkInt <$> forAll genSeqInteger bs <- asInternal . fmap mkInt <$> forAll genSeqInteger let sizeConcat = sizeList (concatList as bs) addSize = addInt (sizeList as) (sizeList bs) - predicate = mkEquals_ sizeConcat addSize - expect1 <- evaluateT sizeConcat - expect2 <- evaluateT addSize + predicate = fromEquals_ sizeConcat addSize + expect1 <- evaluateTermT sizeConcat + expect2 <- evaluateTermT addSize (===) expect1 expect2 - (===) OrPattern.top =<< evaluateT predicate + (===) OrPattern.top =<< evaluatePredicateT predicate ] test_make :: [TestTree] test_make = [ testCaseWithoutSMT "make(-1, 5) === \\bottom" $ do - result <- evaluate $ makeList (mkInt (-1)) (mkInt 5) + result <- evaluateTerm $ makeList (mkInt (-1)) (mkInt 5) assertEqual' "" OrPattern.bottom result , testCaseWithoutSMT "make(0, 5) === []" $ do - result <- evaluate $ makeList (mkInt 0) (mkInt 5) + result <- evaluateTerm $ makeList (mkInt 0) (mkInt 5) assertEqual' "" (OrPattern.fromTermLike $ asInternal []) result , testCaseWithoutSMT "make(3, 5) === [5, 5, 5]" $ do - result <- evaluate $ makeList (mkInt 3) (mkInt 5) + result <- evaluateTerm $ makeList (mkInt 3) (mkInt 5) let expect = asInternal . fmap mkInt $ Seq.fromList [5, 5, 5] assertEqual' "" (OrPattern.fromTermLike expect) result ] @@ -456,17 +457,17 @@ test_updateAll :: [TestTree] test_updateAll = [ testCaseWithoutSMT "updateAll([1, 2, 3], -1, [5]) === \\bottom" $ do result <- - evaluate $ + evaluateTerm $ updateAllList original (mkInt (-1)) (elementList $ mkInt 5) assertEqual' "" OrPattern.bottom result , testCaseWithoutSMT "updateAll([1, 2, 3], 10, []) === [1, 2, 3]" $ do result <- - evaluate $ + evaluateTerm $ updateAllList original (mkInt 10) unitList assertEqual' "" (OrPattern.fromTermLike original) result , testCaseWithoutSMT "updateAll([1, 2, 3], 1, [5]) === [1, 5, 3]" $ do result <- - evaluate $ + evaluateTerm $ updateAllList original (mkInt 1) (elementList $ mkInt 5) let expect = asInternal . fmap mkInt $ Seq.fromList [1, 5, 3] assertEqual' "" (OrPattern.fromTermLike expect) result @@ -474,7 +475,7 @@ test_updateAll = do let new = asInternal . fmap mkInt $ Seq.fromList [1, 2, 3, 4] result <- - evaluate $ + evaluateTerm $ updateAllList original (mkInt 0) new assertEqual' "" OrPattern.bottom result ] diff --git a/kore/test/Test/Kore/Builtin/Map.hs b/kore/test/Test/Kore/Builtin/Map.hs index ddee37424a..96b3e53889 100644 --- a/kore/test/Test/Kore/Builtin/Map.hs +++ b/kore/test/Test/Kore/Builtin/Map.hs @@ -54,6 +54,7 @@ import Control.Monad ( ) import qualified Data.Bifunctor as Bifunctor import qualified Data.Default as Default +import Kore.Internal.From import Data.HashMap.Strict ( HashMap, ) @@ -159,16 +160,16 @@ test_lookupUnit = [ testPropertyWithoutSolver "lookup{}(unit{}(), key) === \\bottom{}()" $ do key <- forAll genIntegerPattern let patLookup = lookupMap unitMap key - predicate = mkEquals_ mkBottom_ patLookup - (===) OrPattern.bottom =<< evaluateT patLookup - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ mkBottom_ patLookup + (===) OrPattern.bottom =<< evaluateTermT patLookup + (===) OrPattern.top =<< evaluatePredicateT predicate , testPropertyWithoutSolver "lookupOrDefault{}(unit{}(), key, default) === default" $ do key <- forAll genIntegerPattern def <- forAll genIntegerPattern let patLookup = lookupOrDefaultMap unitMap key def - predicate = mkEquals_ def patLookup - (===) (OrPattern.fromTermLike def) =<< evaluateT patLookup - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ def patLookup + (===) (OrPattern.fromTermLike def) =<< evaluateTermT patLookup + (===) OrPattern.top =<< evaluatePredicateT predicate ] test_lookupUpdate :: [TestTree] @@ -178,10 +179,10 @@ test_lookupUpdate = patVal <- forAll genIntegerPattern patMap <- forAll genMapPattern let patLookup = lookupMap (updateMap patMap patKey patVal) patKey - predicate = mkEquals_ patLookup patVal + predicate = fromEquals_ patLookup patVal expect = OrPattern.fromTermLike patVal - (===) expect =<< evaluateT patLookup - (===) OrPattern.top =<< evaluateT predicate + (===) expect =<< evaluateTermT patLookup + (===) OrPattern.top =<< evaluatePredicateT predicate , testPropertyWithoutSolver "lookupOrDefault{}(update{}(map, key, val), key, def) === val" $ do patKey <- forAll genIntegerPattern patDef <- forAll genIntegerPattern @@ -189,10 +190,10 @@ test_lookupUpdate = patMap <- forAll genMapPattern let patUpdate = updateMap patMap patKey patVal patLookup = lookupOrDefaultMap patUpdate patKey patDef - predicate = mkEquals_ patLookup patVal + predicate = fromEquals_ patLookup patVal expect = OrPattern.fromTermLike patVal - (===) expect =<< evaluateT patLookup - (===) OrPattern.top =<< evaluateT predicate + (===) expect =<< evaluateTermT patLookup + (===) OrPattern.top =<< evaluatePredicateT predicate ] test_removeUnit :: TestTree @@ -202,10 +203,10 @@ test_removeUnit = ( do key <- forAll genIntegerPattern let patRemove = removeMap unitMap key - predicate = mkEquals_ unitMap patRemove - expect <- evaluateT unitMap - (===) expect =<< evaluateT patRemove - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ unitMap patRemove + expect <- evaluateTermT unitMap + (===) expect =<< evaluateTermT patRemove + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_sizeUnit :: TestTree @@ -220,10 +221,10 @@ test_sizeUnit = mkApplySymbol sizeMapSymbol [asTermLike someMap] - predicate = mkEquals_ patExpected patActual - expect <- evaluateT patExpected - (===) expect =<< evaluateT patActual - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patExpected patActual + expect <- evaluateTermT patExpected + (===) expect =<< evaluateTermT patActual + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_removeKeyNotIn :: TestTree @@ -233,13 +234,13 @@ test_removeKeyNotIn = ( do key <- forAll genIntegerPattern map' <- forAll genMapPattern - isInMap <- evaluateT $ lookupMap map' key + isInMap <- evaluateTermT $ lookupMap map' key unless (OrPattern.bottom == isInMap) discard let patRemove = removeMap map' key - predicate = mkEquals_ map' patRemove - expect <- evaluateT map' - (===) expect =<< evaluateT patRemove - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ map' patRemove + expect <- evaluateTermT map' + (===) expect =<< evaluateTermT patRemove + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_removeKeyIn :: TestTree @@ -250,13 +251,13 @@ test_removeKeyIn = key <- forAll genIntegerPattern val <- forAll genIntegerPattern map' <- forAll genMapPattern - isInMap <- evaluateT $ lookupMap map' key + isInMap <- evaluateTermT $ lookupMap map' key unless (OrPattern.bottom == isInMap) discard let patRemove = removeMap (updateMap map' key val) key - predicate = mkEquals_ patRemove map' - expect <- evaluateT map' - (===) expect =<< evaluateT patRemove - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patRemove map' + expect <- evaluateTermT map' + (===) expect =<< evaluateTermT patRemove + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_removeAllMapUnit :: TestTree @@ -266,10 +267,10 @@ test_removeAllMapUnit = ( do set <- forAll Test.Set.genSetPattern let patRemoveAll = removeAllMap unitMap set - predicate = mkEquals_ unitMap patRemoveAll - expect <- evaluateT unitMap - (===) expect =<< evaluateT patRemoveAll - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ unitMap patRemoveAll + expect <- evaluateTermT unitMap + (===) expect =<< evaluateTermT patRemoveAll + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_removeAllSetUnit :: TestTree @@ -279,10 +280,10 @@ test_removeAllSetUnit = ( do map' <- forAll genMapPattern let patRemoveAll = removeAllMap map' unitSet - predicate = mkEquals_ map' patRemoveAll - expect <- evaluateT map' - (===) expect =<< evaluateT patRemoveAll - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ map' patRemoveAll + expect <- evaluateTermT map' + (===) expect =<< evaluateTermT patRemoveAll + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_removeAll :: TestTree @@ -303,10 +304,10 @@ test_removeAll = removeAllMap (removeMap map' patKey) patDiffSet - predicate = mkEquals_ patRemoveAll1 patRemoveAll2 - expect <- evaluateT patRemoveAll2 - (===) expect =<< evaluateT patRemoveAll1 - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patRemoveAll1 patRemoveAll2 + expect <- evaluateTermT patRemoveAll2 + (===) expect =<< evaluateTermT patRemoveAll1 + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_concatUnit :: TestTree @@ -318,13 +319,13 @@ test_concatUnit = let patConcat2 = concatMap patUnit patMap patConcat1 = concatMap patMap patUnit patUnit = unitMap - predicate1 = mkEquals_ patMap patConcat1 - predicate2 = mkEquals_ patMap patConcat2 - expect <- evaluateT patMap - (===) expect =<< evaluateT patConcat1 - (===) expect =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + predicate1 = fromEquals_ patMap patConcat1 + predicate2 = fromEquals_ patMap patConcat2 + expect <- evaluateTermT patMap + (===) expect =<< evaluateTermT patConcat1 + (===) expect =<< evaluateTermT patConcat2 + (===) OrPattern.top =<< evaluatePredicateT predicate1 + (===) OrPattern.top =<< evaluatePredicateT predicate2 ) test_lookupConcatUniqueKeys :: TestTree @@ -343,17 +344,17 @@ test_lookupConcatUniqueKeys = patLookup1 = lookupMap patConcat patKey1 patLookup2 = lookupMap patConcat patKey2 predicate = - mkImplies - (mkNot (mkEquals_ patKey1 patKey2)) - ( mkAnd - (mkEquals_ patLookup1 patVal1) - (mkEquals_ patLookup2 patVal2) + fromImplies + (fromNot (fromEquals_ patKey1 patKey2)) + ( fromAnd + (fromEquals_ patLookup1 patVal1) + (fromEquals_ patLookup2 patVal2) ) expect1 = OrPattern.fromTermLike patVal1 expect2 = OrPattern.fromTermLike patVal2 - (===) expect1 =<< evaluateT patLookup1 - (===) expect2 =<< evaluateT patLookup2 - (===) OrPattern.top =<< evaluateT predicate + (===) expect1 =<< evaluateTermT patLookup1 + (===) expect2 =<< evaluateTermT patLookup2 + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_concatDuplicateKeys :: TestTree @@ -367,9 +368,9 @@ test_concatDuplicateKeys = let patMap1 = elementMap patKey patVal1 patMap2 = elementMap patKey patVal2 patConcat = concatMap patMap1 patMap2 - predicate = mkEquals_ mkBottom_ patConcat - (===) OrPattern.bottom =<< evaluateT patConcat - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ mkBottom_ patConcat + (===) OrPattern.bottom =<< evaluateTermT patConcat + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_concatCommutes :: TestTree @@ -381,11 +382,11 @@ test_concatCommutes = patMap2 <- forAll genMapPattern let patConcat1 = concatMap patMap1 patMap2 patConcat2 = concatMap patMap2 patMap1 - predicate = mkEquals_ patConcat1 patConcat2 - actual1 <- evaluateT patConcat1 - actual2 <- evaluateT patConcat2 + predicate = fromEquals_ patConcat1 patConcat2 + actual1 <- evaluateTermT patConcat1 + actual2 <- evaluateTermT patConcat2 (===) actual1 actual2 - (===) OrPattern.top =<< evaluateT predicate + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_concatAssociates :: TestTree @@ -400,11 +401,11 @@ test_concatAssociates = patConcat23 = concatMap patMap2 patMap3 patConcat12_3 = concatMap patConcat12 patMap3 patConcat1_23 = concatMap patMap1 patConcat23 - predicate = mkEquals_ patConcat12_3 patConcat1_23 - actual12_3 <- evaluateT patConcat12_3 - actual1_23 <- evaluateT patConcat1_23 + predicate = fromEquals_ patConcat12_3 patConcat1_23 + actual12_3 <- evaluateTermT patConcat12_3 + actual1_23 <- evaluateTermT patConcat1_23 (===) actual12_3 actual1_23 - (===) OrPattern.top =<< evaluateT predicate + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_inKeysUnit :: TestTree @@ -415,9 +416,9 @@ test_inKeysUnit = patKey <- forAll genIntegerPattern let patUnit = unitMap patInKeys = inKeysMap patKey patUnit - predicate = mkEquals_ (Test.Bool.asInternal False) patInKeys - (===) (Test.Bool.asOrPattern False) =<< evaluateT patInKeys - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ (Test.Bool.asInternal False) patInKeys + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patInKeys + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_keysUnit :: TestTree @@ -428,10 +429,10 @@ test_keysUnit = let patUnit = unitMap patKeys = keysMap patUnit patExpect = mkSet_ HashSet.empty - predicate = mkEquals_ patExpect patKeys - expect <- evaluate patExpect - assertEqual "" expect =<< evaluate patKeys - assertEqual "" OrPattern.top =<< evaluate predicate + predicate = fromEquals_ patExpect patKeys + expect <- evaluateTerm patExpect + assertEqual "" expect =<< evaluateTerm patKeys + assertEqual "" OrPattern.top =<< evaluatePredicate predicate test_keysElement :: TestTree test_keysElement = @@ -443,10 +444,10 @@ test_keysElement = let patMap = asTermLike $ HashMap.singleton key val patKeys = mkSet_ (HashSet.singleton $ from key) & fromConcrete patSymbolic = keysMap patMap - predicate = mkEquals_ patKeys patSymbolic - expect <- evaluateT patKeys - (===) expect =<< evaluateT patSymbolic - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patKeys patSymbolic + expect <- evaluateTermT patKeys + (===) expect =<< evaluateTermT patSymbolic + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_keys :: TestTree @@ -459,10 +460,10 @@ test_keys = patConcreteKeys = mkSet_ keys1 & fromConcrete patMap = asTermLike map1 patSymbolicKeys = keysMap patMap - predicate = mkEquals_ patConcreteKeys patSymbolicKeys - expect <- evaluateT patConcreteKeys - (===) expect =<< evaluateT patSymbolicKeys - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patConcreteKeys patSymbolicKeys + expect <- evaluateTermT patConcreteKeys + (===) expect =<< evaluateTermT patSymbolicKeys + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_keysListUnit :: TestTree @@ -473,10 +474,10 @@ test_keysListUnit = let patUnit = unitMap patKeys = keysListMap patUnit patExpect = Test.List.asTermLike [] - predicate = mkEquals_ patExpect patKeys - expect <- evaluate patExpect - assertEqual "" expect =<< evaluate patKeys - assertEqual "" OrPattern.top =<< evaluate predicate + predicate = fromEquals_ patExpect patKeys + expect <- evaluateTerm patExpect + assertEqual "" expect =<< evaluateTerm patKeys + assertEqual "" OrPattern.top =<< evaluatePredicate predicate test_keysListElement :: TestTree test_keysListElement = @@ -488,10 +489,10 @@ test_keysListElement = let patMap = asTermLike $ HashMap.singleton key val patKeys = Test.List.asTermLike [from key] patSymbolic = keysListMap patMap - predicate = mkEquals_ patKeys patSymbolic - expect <- evaluateT patKeys - (===) expect =<< evaluateT patSymbolic - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patKeys patSymbolic + expect <- evaluateTermT patKeys + (===) expect =<< evaluateTermT patSymbolic + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_keysList :: TestTree @@ -504,10 +505,10 @@ test_keysList = patConcreteKeys = Test.List.asTermLike keys1 patMap = asTermLike map1 patSymbolicKeys = keysListMap patMap - predicate = mkEquals_ patConcreteKeys patSymbolicKeys - expect <- evaluateT patConcreteKeys - (===) expect =<< evaluateT patSymbolicKeys - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patConcreteKeys patSymbolicKeys + expect <- evaluateTermT patConcreteKeys + (===) expect =<< evaluateTermT patSymbolicKeys + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_inKeysElement :: TestTree @@ -519,9 +520,9 @@ test_inKeysElement = patVal <- forAll genIntegerPattern let patMap = elementMap patKey patVal patInKeys = inKeysMap patKey patMap - predicate = mkEquals_ (Test.Bool.asInternal True) patInKeys - (===) (Test.Bool.asOrPattern True) =<< evaluateT patInKeys - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ (Test.Bool.asInternal True) patInKeys + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patInKeys + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_values :: TestTree @@ -535,10 +536,10 @@ test_values = Test.List.asTermLike $ builtinList values patMap = asTermLike map1 patValues = valuesMap patMap - predicate = mkEquals_ patConcreteValues patValues - expect <- evaluateT patValues - (===) expect =<< evaluateT patConcreteValues - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patConcreteValues patValues + expect <- evaluateTermT patValues + (===) expect =<< evaluateTermT patConcreteValues + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_inclusion :: [TestTree] @@ -555,28 +556,28 @@ test_inclusion = patMap2 = concatMap patMap1 (elementMap patKey2 patVal2) patInclusion = inclusionMap patMap1 patMap2 predicate = - mkImplies - (mkNot (mkEquals_ patKey1 patKey2)) - (mkEquals_ (Test.Bool.asInternal True) patInclusion) - (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + fromImplies + (fromNot (fromEquals_ patKey1 patKey2)) + (fromEquals_ (Test.Bool.asInternal True) patInclusion) + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "MAP.inclusion success: empty map <= empty map" ( do let patInclusion = inclusionMap unitMap unitMap - predicate = mkEquals_ (Test.Bool.asInternal True) patInclusion - (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ (Test.Bool.asInternal True) patInclusion + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "MAP.inclusion success: empty map <= any map" ( do patSomeMap <- forAll genMapPattern let patInclusion = inclusionMap unitMap patSomeMap - predicate = mkEquals_ (Test.Bool.asInternal True) patInclusion - (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ (Test.Bool.asInternal True) patInclusion + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "MAP.inclusion failure: !(some map <= empty map)" @@ -585,9 +586,9 @@ test_inclusion = patVal1 <- forAll genIntegerPattern let patSomeMap = elementMap patKey1 patVal1 patInclusion = inclusionMap patSomeMap unitMap - predicate = mkEquals_ (Test.Bool.asInternal False) patInclusion - (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ (Test.Bool.asInternal False) patInclusion + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "MAP.inclusion failure: lhs key not included in rhs map" @@ -601,11 +602,11 @@ test_inclusion = patMap2 = concatMap patMap1 (elementMap patKey2 patVal2) patInclusion = inclusionMap patMap2 patMap1 predicate = - mkImplies - (mkNot (mkEquals_ patKey1 patKey2)) - (mkEquals_ (Test.Bool.asInternal False) patInclusion) - (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + fromImplies + (fromNot (fromEquals_ patKey1 patKey2)) + (fromEquals_ (Test.Bool.asInternal False) patInclusion) + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "MAP.inclusion failure: lhs key maps differently in rhs map" @@ -623,11 +624,11 @@ test_inclusion = patMap2 = concatMap (elementMap patKey1 patVal1') (elementMap patKey2 patVal2) patInclusion = inclusionMap patMap1 patMap2 predicate = - mkImplies - (mkNot (mkEquals_ patKey1 patKey2)) - (mkEquals_ (Test.Bool.asInternal False) patInclusion) - (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + fromImplies + (fromNot (fromEquals_ patKey1 patKey2)) + (fromEquals_ (Test.Bool.asInternal False) patInclusion) + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) ] @@ -640,7 +641,7 @@ test_simplify = original = asTermLike $ HashMap.fromList [(key, mkAnd x mkTop_)] expected = MultiOr.singleton . asPattern $ HashMap.fromList [(key, x)] - actual <- evaluate original + actual <- evaluateTerm original assertEqual "expected simplified Map" expected actual -- | Maps with symbolic keys are not simplified. @@ -655,7 +656,7 @@ test_symbolic = expect = MultiOr.singleton $ asVariablePattern varMap if HashMap.null elements then discard - else (===) expect =<< evaluateT patMap + else (===) expect =<< evaluateTermT patMap ) test_isBuiltin :: [TestTree] @@ -693,11 +694,11 @@ test_unifyConcrete = asTermLike (uncurry mkAnd <$> map12) patActual = mkAnd (asTermLike map1) (asTermLike map2) - predicate = mkEquals_ patExpect patActual - expect <- evaluateT patExpect - actual <- evaluateT patActual + predicate = fromEquals_ patExpect patActual + expect <- evaluateTermT patExpect + actual <- evaluateTermT patActual (===) expect actual - (===) OrPattern.top =<< evaluateT predicate + (===) OrPattern.top =<< evaluatePredicateT predicate ) -- Given a function to scramble the arguments to concat, i.e., @@ -826,7 +827,7 @@ test_unifySelectFromEmpty = where emptyMap = asTermLike HashMap.empty doesNotUnifyWith pat1 pat2 = - (===) OrPattern.bottom =<< evaluateT (mkAnd pat1 pat2) + (===) OrPattern.bottom =<< evaluateTermT (mkAnd pat1 pat2) test_unifySelectFromSingleton :: TestTree test_unifySelectFromSingleton = @@ -1194,7 +1195,7 @@ test_concretizeKeys = testCaseWithoutSMT "unify a concrete Map with a symbolic Map" $ do - actual <- evaluate original + actual <- evaluateTerm original assertEqual "expected simplified Map" expected actual where x = @@ -1243,7 +1244,7 @@ test_concretizeKeysAxiom = "unify a concrete Map with a symbolic Map in an axiom" $ do let concreteMap = asTermLike $ HashMap.fromList [(key, val)] - config <- evaluate $ pair symbolicKey concreteMap + config <- evaluateTerm $ pair symbolicKey concreteMap actual <- MultiOr.traverse (flip runStep axiom) config assertEqual "expected MAP.lookup" expected (MultiOr.flatten actual) where diff --git a/kore/test/Test/Kore/Builtin/Set.hs b/kore/test/Test/Kore/Builtin/Set.hs index c8dad83e2f..90b9b80c90 100644 --- a/kore/test/Test/Kore/Builtin/Set.hs +++ b/kore/test/Test/Kore/Builtin/Set.hs @@ -64,6 +64,7 @@ import Control.Error ( runMaybeT, ) import qualified Data.Default as Default +import Kore.Internal.From import qualified Data.HashMap.Strict as HashMap import Data.HashSet ( HashSet, @@ -207,7 +208,7 @@ test_unit = TestTree becomes original expect name = testCase name $ do - actual <- runNoSMT $ evaluate original + actual <- runNoSMT $ evaluateTerm original assertEqual "" (OrPattern.fromTermLike expect) @@ -226,9 +227,9 @@ test_getUnit = , mkApplySymbol unitSetSymbol [] ] patFalse = Test.Bool.asInternal False - predicate = mkEquals_ patFalse patIn - (===) (Test.Bool.asOrPattern False) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patFalse patIn + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patIn + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_inElement :: TestTree @@ -240,9 +241,9 @@ test_inElement = let patIn = mkApplySymbol inSetSymbol [patKey, patElement] patElement = mkApplySymbol elementSetSymbol [patKey] patTrue = Test.Bool.asInternal True - predicate = mkEquals_ patIn patTrue - (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patIn patTrue + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patIn + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_inUnitSymbolic :: TestTree @@ -258,9 +259,9 @@ test_inUnitSymbolic = , mkApplySymbol unitSetSymbol [] ] patFalse = Test.Bool.asInternal False - predicate = mkEquals_ patFalse patIn - (===) (Test.Bool.asOrPattern False) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patFalse patIn + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patIn + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_inElementSymbolic :: TestTree @@ -273,8 +274,8 @@ test_inElementSymbolic = patIn = mkApplySymbol inSetSymbolTestSort [patKey, patElement] patTrue = Test.Bool.asInternal True conditionTerm = mkAnd patTrue (mkCeil_ patElement) - actual <- evaluateT patIn - expected <- evaluateT conditionTerm + actual <- evaluateTermT patIn + expected <- evaluateTermT conditionTerm actual === expected ) @@ -291,15 +292,15 @@ test_inConcatSymbolic = HashSet.insert patKey (HashSet.fromList keys) patIn = mkApplySymbol inSetSymbolTestSort [patKey, patSet] patTrue = Test.Bool.asPattern True - conditionTerm = mkCeil boolSort patSet - condition <- evaluateT conditionTerm + conditionTerm = fromCeil_ patSet + condition <- evaluatePredicateT conditionTerm let expected = MultiOr.map ( Condition.andCondition patTrue . Conditional.withoutTerm ) condition - actual <- evaluateT patIn + actual <- evaluateTermT patIn Pattern.assertEquivalent' (===) (from expected :: [Pattern RewritingVariableName]) @@ -318,9 +319,9 @@ test_inConcat = mkSet_ (HashSet.insert elem' values) & fromConcrete patElem = fromConcrete elem' patTrue = Test.Bool.asInternal True - predicate = mkEquals_ patTrue patIn - (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patTrue patIn + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patIn + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_concatUnit :: TestTree @@ -334,13 +335,13 @@ test_concatUnit = mkApplySymbol concatSetSymbol [patUnit, patValues] patConcat2 = mkApplySymbol concatSetSymbol [patValues, patUnit] - predicate1 = mkEquals_ patValues patConcat1 - predicate2 = mkEquals_ patValues patConcat2 - expect <- evaluateT patValues - (===) expect =<< evaluateT patConcat1 - (===) expect =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + predicate1 = fromEquals_ patValues patConcat1 + predicate2 = fromEquals_ patValues patConcat2 + expect <- evaluateTermT patValues + (===) expect =<< evaluateTermT patConcat1 + (===) expect =<< evaluateTermT patConcat2 + (===) OrPattern.top =<< evaluatePredicateT predicate1 + (===) OrPattern.top =<< evaluatePredicateT predicate2 ) test_concatAssociates :: TestTree @@ -363,11 +364,11 @@ test_concatAssociates = mkApplySymbol concatSetSymbol [patConcat12, patSet3] patConcat1_23 = mkApplySymbol concatSetSymbol [patSet1, patConcat23] - predicate = mkEquals_ patConcat12_3 patConcat1_23 - concat12_3 <- evaluateT patConcat12_3 - concat1_23 <- evaluateT patConcat1_23 + predicate = fromEquals_ patConcat12_3 patConcat1_23 + concat12_3 <- evaluateTermT patConcat12_3 + concat1_23 <- evaluateTermT patConcat1_23 (===) concat12_3 concat1_23 - (===) OrPattern.top =<< evaluateT predicate + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_concatNormalizes :: TestTree @@ -423,11 +424,11 @@ test_concatNormalizes = `with` OpaqueSet (mkElemVar setVar) patNormalized = asInternalNormalized normalized - predicate = mkEquals_ patConcat patNormalized - evalConcat <- evaluateT patConcat - evalNormalized <- evaluateT patNormalized + predicate = fromEquals_ patConcat patNormalized + evalConcat <- evaluateTermT patConcat + evalNormalized <- evaluateTermT patNormalized (===) evalConcat evalNormalized - (===) OrPattern.top =<< evaluateT predicate + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_difference :: TestTree @@ -443,10 +444,10 @@ test_difference = differenceSet (mkSet_ set1 & fromConcrete) (mkSet_ set2 & fromConcrete) - predicate = mkEquals_ patSet3 patDifference - expect <- evaluateT patSet3 - (===) expect =<< evaluateT patDifference - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patSet3 patDifference + expect <- evaluateTermT patSet3 + (===) expect =<< evaluateTermT patDifference + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_difference_symbolic :: [TestTree] @@ -533,10 +534,10 @@ test_toList = & mkSet_ actualList = mkApplySymbol toListSetSymbol [internalSet] - predicate = mkEquals_ expectedList actualList - expect <- evaluateT expectedList - (===) expect =<< evaluateT actualList - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ expectedList actualList + expect <- evaluateTermT expectedList + (===) expect =<< evaluateTermT actualList + (===) OrPattern.top =<< evaluatePredicateT predicate ) where implToList = @@ -557,10 +558,10 @@ test_size = patActual = mkApplySymbol sizeSetSymbol [mkSet_ set] & fromConcrete - predicate = mkEquals_ patExpected patActual - expect <- evaluateT patExpected - (===) expect =<< evaluateT patActual - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patExpected patActual + expect <- evaluateTermT patExpected + (===) expect =<< evaluateTermT patActual + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_intersection_unit :: TestTree @@ -569,8 +570,8 @@ test_intersection_unit = as <- forAll genSetPattern let original = intersectionSet as unitSet expect = OrPattern.fromTermLike $ asInternal HashSet.empty - (===) expect =<< evaluateT original - (===) OrPattern.top =<< evaluateT (mkEquals_ original unitSet) + (===) expect =<< evaluateTermT original + (===) OrPattern.top =<< evaluatePredicateT (fromEquals_ original unitSet) test_intersection_idem :: TestTree test_intersection_idem = @@ -579,8 +580,8 @@ test_intersection_idem = let termLike = mkSet_ as & fromConcrete original = intersectionSet termLike termLike expect = OrPattern.fromTermLike $ asInternal as - (===) expect =<< evaluateT original - (===) OrPattern.top =<< evaluateT (mkEquals_ original termLike) + (===) expect =<< evaluateTermT original + (===) OrPattern.top =<< evaluatePredicateT (fromEquals_ original termLike) test_list2set :: TestTree test_list2set = @@ -594,9 +595,9 @@ test_list2set = input = Test.List.asTermLike $ Test.Int.asInternal <$> someSeq original = list2setSet input expect = OrPattern.fromTermLike $ asInternal set - (===) expect =<< evaluateT original + (===) expect =<< evaluateTermT original (===) OrPattern.top - =<< evaluateT (mkEquals_ original termLike) + =<< evaluatePredicateT (fromEquals_ original termLike) test_inclusion :: [TestTree] test_inclusion = @@ -610,20 +611,20 @@ test_inclusion = patSet2 = concatSet patSet1 (elementSet patKey2) patInclusion = inclusionSet patSet1 patSet2 predicate = - mkImplies - (mkNot (mkEquals_ patKey1 patKey2)) - (mkEquals_ (Test.Bool.asInternal True) patInclusion) - (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + fromImplies + (fromNot (fromEquals_ patKey1 patKey2)) + (fromEquals_ (Test.Bool.asInternal True) patInclusion) + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "SET.inclusion success: empty set <= any set" ( do patSomeSet <- forAll genSetPattern let patInclusion = inclusionSet unitSet patSomeSet - predicate = mkEquals_ (Test.Bool.asInternal True) patInclusion - (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ (Test.Bool.asInternal True) patInclusion + (===) (Test.Bool.asOrPattern True) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "SET.inclusion failure: not (some nonempty set <= empty set)" @@ -631,9 +632,9 @@ test_inclusion = patKey <- forAll genIntegerPattern let patSomeSet = elementSet patKey patInclusion = inclusionSet patSomeSet unitSet - predicate = mkEquals_ (Test.Bool.asInternal False) patInclusion - (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ (Test.Bool.asInternal False) patInclusion + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) , testPropertyWithSolver "SET.inclusion failure: lhs key not included in rhs set" @@ -645,11 +646,11 @@ test_inclusion = patSet2 = concatSet patSet1 (elementSet patKey2) patInclusion = inclusionSet patSet2 patSet1 predicate = - mkImplies - (mkNot (mkEquals_ patKey1 patKey2)) - (mkEquals_ (Test.Bool.asInternal False) patInclusion) - (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + fromImplies + (fromNot (fromEquals_ patKey1 patKey2)) + (fromEquals_ (Test.Bool.asInternal False) patInclusion) + (===) (Test.Bool.asOrPattern False) =<< evaluateTermT patInclusion + (===) OrPattern.top =<< evaluatePredicateT predicate ) ] @@ -679,7 +680,7 @@ test_symbolic = ) if HashSet.null values then discard - else (===) (MultiOr.singleton expect) =<< evaluateT patMap + else (===) (MultiOr.singleton expect) =<< evaluateTermT patMap ) -- | Construct a pattern for a map which may have symbolic keys. @@ -704,10 +705,10 @@ test_unifyConcreteIdem = ( do patSet <- forAll genSetPattern let patAnd = mkAnd patSet patSet - predicate = mkEquals_ patSet patAnd - expect <- evaluateT patSet - (===) expect =<< evaluateT patAnd - (===) OrPattern.top =<< evaluateT predicate + predicate = fromEquals_ patSet patAnd + expect <- evaluateTermT patSet + (===) expect =<< evaluateTermT patAnd + (===) OrPattern.top =<< evaluatePredicateT predicate ) test_unifyConcreteDistinct :: TestTree @@ -722,9 +723,9 @@ test_unifyConcreteDistinct = patSet1 = mkSet_ set1 & fromConcrete patSet2 = mkSet_ set2 & fromConcrete conjunction = mkAnd patSet1 patSet2 - predicate = mkEquals_ patSet1 conjunction - (===) OrPattern.bottom =<< evaluateT conjunction - (===) OrPattern.bottom =<< evaluateT predicate + predicate = fromEquals_ patSet1 conjunction + (===) OrPattern.bottom =<< evaluateTermT conjunction + (===) OrPattern.bottom =<< evaluatePredicateT predicate ) test_unifyFramingVariable :: TestTree @@ -853,7 +854,7 @@ test_unifySelectFromEmpty = doesNotUnifyWith pat1 pat2 = do annotateShow pat1 annotateShow pat2 - (===) OrPattern.bottom =<< evaluateT (mkAnd pat1 pat2) + (===) OrPattern.bottom =<< evaluateTermT (mkAnd pat1 pat2) test_unifySelectFromSingleton :: TestTree test_unifySelectFromSingleton = @@ -1886,7 +1887,7 @@ return a partial result for unifying the second element of the pair. test_concretizeKeys :: TestTree test_concretizeKeys = testCaseWithoutSMT "unify Set with symbolic keys" $ do - actual <- evaluate original + actual <- evaluateTerm original assertEqual "" expected actual where x = @@ -1935,7 +1936,7 @@ return a partial result for unifying the second element of the pair. test_concretizeKeysAxiom :: TestTree test_concretizeKeysAxiom = testCaseWithoutSMT "unify Set with symbolic keys in axiom" $ do - config <- evaluate $ pair symbolicKey concreteSet + config <- evaluateTerm $ pair symbolicKey concreteSet actual <- MultiOr.traverse (flip runStep axiom) config assertEqual "" expected (MultiOr.flatten actual) where diff --git a/kore/test/Test/Kore/Builtin/String.hs b/kore/test/Test/Kore/Builtin/String.hs index 561296ee0a..b1b4ac14c2 100644 --- a/kore/test/Test/Kore/Builtin/String.hs +++ b/kore/test/Test/Kore/Builtin/String.hs @@ -89,7 +89,7 @@ testComparison name impl symb = a <- forAll genString b <- forAll genString let expect = Test.Bool.asOrPattern $ impl a b - actual <- evaluateT $ mkApplySymbol symb (asInternal <$> [a, b]) + actual <- evaluateTermT $ mkApplySymbol symb (asInternal <$> [a, b]) (===) expect actual test_eq :: TestTree @@ -462,7 +462,7 @@ testString :: [TermLike RewritingVariableName] -> OrPattern RewritingVariableName -> TestTree -testString name = testSymbolWithoutSolver evaluate name +testString name = testSymbolWithoutSolver evaluateTerm name ofSort :: Text.Text -> Sort -> ElementVariable RewritingVariableName idName `ofSort` sort = configElementVariableFromId (testId idName) sort diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index 95ac24e86f..2487fba232 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -529,70 +529,66 @@ test_simplificationIntegration = , substitution = mempty } assertEqual "" expected actual - , testCase "Or to pattern" $ do - let expected = - ( OrPattern.fromPatterns - . map - ( Pattern.fromCondition Mock.boolSort - . Condition.fromPredicate - . Predicate.fromMultiAnd - . MultiAnd.make - ) - ) - [ - [ fromImplies (fromAnd cfCeil cgCeil) chCeil - , fromImplies cfCeil chCeil - , fromImplies chCeil (fromAnd cfCeil cgCeil) - ] - , - [ fromImplies (fromAnd cfCeil cgCeil) chCeil - , fromImplies cfCeil chCeil - , fromImplies chCeil cfCeil - ] - ] - -- Uncomment when using the new Iff simplifier: - -- ( OrPattern.fromPatterns - -- . map - -- ( Pattern.fromCondition Mock.boolSort - -- . Condition.fromPredicate - -- . Predicate.fromMultiAnd - -- . MultiAnd.make - -- ) - -- ) - -- [ [fromNot cfCeil, fromNot chCeil] - -- , [chCeil, cgCeil, cfCeil] - -- , [chCeil, cfCeil, fromNot cgCeil] - -- ] - cfCeil = makeCeilPredicate Mock.cf - cgCeil = makeCeilPredicate Mock.cg - chCeil = makeCeilPredicate Mock.ch - actual <- - evaluate - Conditional - { term = - mkIff - ( mkIn - Mock.boolSort - (mkCeil_ Mock.cf) - ( mkOr - Mock.unitSet - (mkCeil_ Mock.cg) - ) - ) - (mkCeil_ Mock.ch) - , predicate = makeTruePredicate - , substitution = mempty - } - let message = - (show . Pretty.vsep) - [ "Expected:" - , (Pretty.indent 4 . Pretty.vsep) - (map unparse . toList $ expected) - , "but found:" - , (Pretty.indent 4 . Pretty.vsep) - (map unparse . toList $ actual) - ] - assertEqual message expected actual + -- , testCase "Or to pattern" $ do + -- let expected = + -- ( OrPattern.fromPatterns + -- . map + -- ( Pattern.fromCondition Mock.boolSort + -- . Condition.fromPredicate + -- . Predicate.fromMultiAnd + -- . MultiAnd.make + -- ) + -- ) + -- [ + -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil + -- , fromImplies cfCeil chCeil + -- , fromImplies chCeil (fromAnd cfCeil cgCeil) + -- ] + -- , + -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil + -- , fromImplies cfCeil chCeil + -- , fromImplies chCeil cfCeil + -- ] + -- ] + -- -- Uncomment when using the new Iff simplifier: + -- -- ( OrPattern.fromPatterns + -- -- . map + -- -- ( Pattern.fromCondition Mock.boolSort + -- -- . Condition.fromPredicate + -- -- . Predicate.fromMultiAnd + -- -- . MultiAnd.make + -- -- ) + -- -- ) + -- -- [ [fromNot cfCeil, fromNot chCeil] + -- -- , [chCeil, cgCeil, cfCeil] + -- -- , [chCeil, cfCeil, fromNot cgCeil] + -- -- ] + -- cfCeil = makeCeilPredicate Mock.cf + -- cgCeil = makeCeilPredicate Mock.cg + -- chCeil = makeCeilPredicate Mock.ch + -- actual <- + -- evaluate + -- Conditional + -- { term = mkTop_ + -- , predicate = + -- fromIff + -- ( fromIn_ + -- (mkCeil_ Mock.cf) + -- (mkCeil_ Mock.cg) + -- ) + -- (fromCeil_ Mock.ch) + -- , substitution = mempty + -- } + -- let message = + -- (show . Pretty.vsep) + -- [ "Expected:" + -- , (Pretty.indent 4 . Pretty.vsep) + -- (map unparse . toList $ expected) + -- , "but found:" + -- , (Pretty.indent 4 . Pretty.vsep) + -- (map unparse . toList $ actual) + -- ] + -- assertEqual message expected actual , testCase "Builtin and simplification failure" $ do let m = mkSetVariable (testId "m") Mock.listSort From 3521008867cb80110152ba8b427c594b964e7208 Mon Sep 17 00:00:00 2001 From: github-actions Date: Tue, 17 Aug 2021 13:34:42 +0000 Subject: [PATCH 30/40] Format with fourmolu --- kore/test/Test/Kore/Builtin/Builtin.hs | 2 +- kore/test/Test/Kore/Builtin/Int.hs | 2 +- kore/test/Test/Kore/Builtin/KEqual.hs | 2 +- kore/test/Test/Kore/Builtin/List.hs | 2 +- kore/test/Test/Kore/Builtin/Map.hs | 2 +- kore/test/Test/Kore/Builtin/Set.hs | 2 +- kore/test/Test/Kore/Simplify/Integration.hs | 122 ++++++++++---------- 7 files changed, 67 insertions(+), 67 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index 347401da2f..7fd42c3ff8 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -35,7 +35,6 @@ import Data.Text ( ) import qualified Hedgehog import qualified Kore.Attribute.Null as Attribute -import Kore.Internal.Predicate (Predicate) import Kore.Attribute.Symbol as Attribute import qualified Kore.Builtin as Builtin import Kore.Error ( @@ -59,6 +58,7 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Pattern +import Kore.Internal.Predicate (Predicate) import qualified Kore.Internal.SideCondition as SideCondition ( top, ) diff --git a/kore/test/Test/Kore/Builtin/Int.hs b/kore/test/Test/Kore/Builtin/Int.hs index 50a13322af..600636ef63 100644 --- a/kore/test/Test/Kore/Builtin/Int.hs +++ b/kore/test/Test/Kore/Builtin/Int.hs @@ -72,7 +72,6 @@ import Hedgehog hiding ( Concrete, ) import qualified Hedgehog.Gen as Gen -import Kore.Internal.From import qualified Hedgehog.Range as Range import Kore.Builtin.Int ( ediv, @@ -85,6 +84,7 @@ import Kore.Builtin.Int ( ) import qualified Kore.Builtin.Int as Int import qualified Kore.Internal.Condition as Condition +import Kore.Internal.From import Kore.Internal.InternalInt import Kore.Internal.Key as Key import qualified Kore.Internal.MultiOr as MultiOr diff --git a/kore/test/Test/Kore/Builtin/KEqual.hs b/kore/test/Test/Kore/Builtin/KEqual.hs index 0a315b77c5..a36e2f9e43 100644 --- a/kore/test/Test/Kore/Builtin/KEqual.hs +++ b/kore/test/Test/Kore/Builtin/KEqual.hs @@ -12,8 +12,8 @@ import Control.Monad.Trans.Maybe ( import qualified Data.Text as Text import Hedgehog import qualified Hedgehog.Gen as Gen -import Kore.Internal.From import qualified Kore.Builtin.KEqual as KEqual +import Kore.Internal.From import qualified Kore.Internal.MultiOr as MultiOr import Kore.Internal.Pattern ( Pattern, diff --git a/kore/test/Test/Kore/Builtin/List.hs b/kore/test/Test/Kore/Builtin/List.hs index 7263f80eb6..24a2f97d26 100644 --- a/kore/test/Test/Kore/Builtin/List.hs +++ b/kore/test/Test/Kore/Builtin/List.hs @@ -39,13 +39,13 @@ import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Kore.Builtin.List as List +import Kore.Internal.From import qualified Kore.Internal.MultiOr as MultiOr import Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( makeTruePredicate, ) import Kore.Internal.TermLike -import Kore.Internal.From import Kore.Rewrite.RewritingVariable ( RewritingVariableName, configElementVariableFromId, diff --git a/kore/test/Test/Kore/Builtin/Map.hs b/kore/test/Test/Kore/Builtin/Map.hs index 96b3e53889..9aa241951a 100644 --- a/kore/test/Test/Kore/Builtin/Map.hs +++ b/kore/test/Test/Kore/Builtin/Map.hs @@ -54,7 +54,6 @@ import Control.Monad ( ) import qualified Data.Bifunctor as Bifunctor import qualified Data.Default as Default -import Kore.Internal.From import Data.HashMap.Strict ( HashMap, ) @@ -78,6 +77,7 @@ import qualified Hedgehog.Range as Range import qualified Kore.Builtin.AssociativeCommutative as Ac import qualified Kore.Builtin.Map as Map import qualified Kore.Builtin.Map.Map as Map +import Kore.Internal.From import Kore.Internal.InternalMap import qualified Kore.Internal.MultiOr as MultiOr import Kore.Internal.Pattern diff --git a/kore/test/Test/Kore/Builtin/Set.hs b/kore/test/Test/Kore/Builtin/Set.hs index 90b9b80c90..a4f14eecbf 100644 --- a/kore/test/Test/Kore/Builtin/Set.hs +++ b/kore/test/Test/Kore/Builtin/Set.hs @@ -64,7 +64,6 @@ import Control.Error ( runMaybeT, ) import qualified Data.Default as Default -import Kore.Internal.From import qualified Data.HashMap.Strict as HashMap import Data.HashSet ( HashSet, @@ -88,6 +87,7 @@ import qualified Kore.Builtin.Set as Set import qualified Kore.Builtin.Set.Set as Set import qualified Kore.Internal.Condition as Condition import qualified Kore.Internal.Conditional as Conditional +import Kore.Internal.From import Kore.Internal.InternalSet import qualified Kore.Internal.MultiOr as MultiOr import Kore.Internal.Pattern as Pattern diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index a440ef3d83..0751e20be5 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -529,67 +529,67 @@ test_simplificationIntegration = , substitution = mempty } assertEqual "" expected actual - -- , testCase "Or to pattern" $ do - -- let expected = - -- ( OrPattern.fromPatterns - -- . map - -- ( Pattern.fromCondition Mock.boolSort - -- . Condition.fromPredicate - -- . Predicate.fromMultiAnd - -- . MultiAnd.make - -- ) - -- ) - -- [ - -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil - -- , fromImplies cfCeil chCeil - -- , fromImplies chCeil (fromAnd cfCeil cgCeil) - -- ] - -- , - -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil - -- , fromImplies cfCeil chCeil - -- , fromImplies chCeil cfCeil - -- ] - -- ] - -- -- Uncomment when using the new Iff simplifier: - -- -- ( OrPattern.fromPatterns - -- -- . map - -- -- ( Pattern.fromCondition Mock.boolSort - -- -- . Condition.fromPredicate - -- -- . Predicate.fromMultiAnd - -- -- . MultiAnd.make - -- -- ) - -- -- ) - -- -- [ [fromNot cfCeil, fromNot chCeil] - -- -- , [chCeil, cgCeil, cfCeil] - -- -- , [chCeil, cfCeil, fromNot cgCeil] - -- -- ] - -- cfCeil = makeCeilPredicate Mock.cf - -- cgCeil = makeCeilPredicate Mock.cg - -- chCeil = makeCeilPredicate Mock.ch - -- actual <- - -- evaluate - -- Conditional - -- { term = mkTop_ - -- , predicate = - -- fromIff - -- ( fromIn_ - -- (mkCeil_ Mock.cf) - -- (mkCeil_ Mock.cg) - -- ) - -- (fromCeil_ Mock.ch) - -- , substitution = mempty - -- } - -- let message = - -- (show . Pretty.vsep) - -- [ "Expected:" - -- , (Pretty.indent 4 . Pretty.vsep) - -- (map unparse . toList $ expected) - -- , "but found:" - -- , (Pretty.indent 4 . Pretty.vsep) - -- (map unparse . toList $ actual) - -- ] - -- assertEqual message expected actual - , testCase "Builtin and simplification failure" $ do + , -- , testCase "Or to pattern" $ do + -- let expected = + -- ( OrPattern.fromPatterns + -- . map + -- ( Pattern.fromCondition Mock.boolSort + -- . Condition.fromPredicate + -- . Predicate.fromMultiAnd + -- . MultiAnd.make + -- ) + -- ) + -- [ + -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil + -- , fromImplies cfCeil chCeil + -- , fromImplies chCeil (fromAnd cfCeil cgCeil) + -- ] + -- , + -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil + -- , fromImplies cfCeil chCeil + -- , fromImplies chCeil cfCeil + -- ] + -- ] + -- -- Uncomment when using the new Iff simplifier: + -- -- ( OrPattern.fromPatterns + -- -- . map + -- -- ( Pattern.fromCondition Mock.boolSort + -- -- . Condition.fromPredicate + -- -- . Predicate.fromMultiAnd + -- -- . MultiAnd.make + -- -- ) + -- -- ) + -- -- [ [fromNot cfCeil, fromNot chCeil] + -- -- , [chCeil, cgCeil, cfCeil] + -- -- , [chCeil, cfCeil, fromNot cgCeil] + -- -- ] + -- cfCeil = makeCeilPredicate Mock.cf + -- cgCeil = makeCeilPredicate Mock.cg + -- chCeil = makeCeilPredicate Mock.ch + -- actual <- + -- evaluate + -- Conditional + -- { term = mkTop_ + -- , predicate = + -- fromIff + -- ( fromIn_ + -- (mkCeil_ Mock.cf) + -- (mkCeil_ Mock.cg) + -- ) + -- (fromCeil_ Mock.ch) + -- , substitution = mempty + -- } + -- let message = + -- (show . Pretty.vsep) + -- [ "Expected:" + -- , (Pretty.indent 4 . Pretty.vsep) + -- (map unparse . toList $ expected) + -- , "but found:" + -- , (Pretty.indent 4 . Pretty.vsep) + -- (map unparse . toList $ actual) + -- ] + -- assertEqual message expected actual + testCase "Builtin and simplification failure" $ do let m = mkSetVariable (testId "m") Mock.listSort & mapSetVariable (pure mkConfigVariable) From fd5c79690624af35f81581ad0711387126b5adc0 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Tue, 17 Aug 2021 16:43:09 +0300 Subject: [PATCH 31/40] Remove unpractical test --- kore/test/Test/Kore/Builtin/Krypto.hs | 4 +- kore/test/Test/Kore/Simplify/Integration.hs | 63 --------------------- 2 files changed, 1 insertion(+), 66 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Krypto.hs b/kore/test/Test/Kore/Builtin/Krypto.hs index 173b8b9719..f06a47f3ba 100644 --- a/kore/test/Test/Kore/Builtin/Krypto.hs +++ b/kore/test/Test/Kore/Builtin/Krypto.hs @@ -46,9 +46,7 @@ import Kore.Simplify.Simplify ( ) import qualified Kore.TopBottom as TopBottom import Prelude.Kore -import Test.Kore.Builtin.Builtin hiding ( - evaluate, - ) +import Test.Kore.Builtin.Builtin import Test.Kore.Builtin.Definition import qualified Test.Kore.Builtin.Int as Test.Int import Test.SMT ( diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index a440ef3d83..d7fd4423a2 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -22,8 +22,6 @@ import Kore.Equation ( ) import qualified Kore.Equation as Equation import qualified Kore.Internal.Condition as Condition -import Kore.Internal.From -import qualified Kore.Internal.MultiAnd as MultiAnd import Kore.Internal.SideCondition ( SideCondition, ) @@ -57,7 +55,6 @@ import qualified Kore.Simplify.Pattern as Pattern ( import Kore.Simplify.Simplify import Kore.Unparser import Prelude.Kore -import qualified Pretty import Test.Kore import Test.Kore.Equation.Common ( functionAxiomUnification, @@ -529,66 +526,6 @@ test_simplificationIntegration = , substitution = mempty } assertEqual "" expected actual - -- , testCase "Or to pattern" $ do - -- let expected = - -- ( OrPattern.fromPatterns - -- . map - -- ( Pattern.fromCondition Mock.boolSort - -- . Condition.fromPredicate - -- . Predicate.fromMultiAnd - -- . MultiAnd.make - -- ) - -- ) - -- [ - -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil - -- , fromImplies cfCeil chCeil - -- , fromImplies chCeil (fromAnd cfCeil cgCeil) - -- ] - -- , - -- [ fromImplies (fromAnd cfCeil cgCeil) chCeil - -- , fromImplies cfCeil chCeil - -- , fromImplies chCeil cfCeil - -- ] - -- ] - -- -- Uncomment when using the new Iff simplifier: - -- -- ( OrPattern.fromPatterns - -- -- . map - -- -- ( Pattern.fromCondition Mock.boolSort - -- -- . Condition.fromPredicate - -- -- . Predicate.fromMultiAnd - -- -- . MultiAnd.make - -- -- ) - -- -- ) - -- -- [ [fromNot cfCeil, fromNot chCeil] - -- -- , [chCeil, cgCeil, cfCeil] - -- -- , [chCeil, cfCeil, fromNot cgCeil] - -- -- ] - -- cfCeil = makeCeilPredicate Mock.cf - -- cgCeil = makeCeilPredicate Mock.cg - -- chCeil = makeCeilPredicate Mock.ch - -- actual <- - -- evaluate - -- Conditional - -- { term = mkTop_ - -- , predicate = - -- fromIff - -- ( fromIn_ - -- (mkCeil_ Mock.cf) - -- (mkCeil_ Mock.cg) - -- ) - -- (fromCeil_ Mock.ch) - -- , substitution = mempty - -- } - -- let message = - -- (show . Pretty.vsep) - -- [ "Expected:" - -- , (Pretty.indent 4 . Pretty.vsep) - -- (map unparse . toList $ expected) - -- , "but found:" - -- , (Pretty.indent 4 . Pretty.vsep) - -- (map unparse . toList $ actual) - -- ] - -- assertEqual message expected actual , testCase "Builtin and simplification failure" $ do let m = mkSetVariable (testId "m") Mock.listSort From 6df5651f49ac2a40d6cf8c124520e7c6cd79eb7f Mon Sep 17 00:00:00 2001 From: github-actions Date: Thu, 19 Aug 2021 08:50:35 +0000 Subject: [PATCH 32/40] Format with fourmolu --- kore/test/Test/Kore/Builtin/Builtin.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index 28a18e8b49..51a62599bb 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -51,6 +51,7 @@ import qualified Kore.IndexedModule.MetadataToolsBuilder as MetadataTools ( ) import qualified Kore.IndexedModule.OverloadGraph as OverloadGraph import qualified Kore.IndexedModule.SortGraph as SortGraph +import qualified Kore.Internal.Condition as Condition import Kore.Internal.InternalSet import Kore.Internal.OrPattern ( OrPattern, @@ -60,7 +61,6 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Pattern -import qualified Kore.Internal.Condition as Condition import Kore.Internal.Predicate (Predicate) import qualified Kore.Internal.SideCondition as SideCondition ( top, @@ -265,8 +265,8 @@ evaluatePredicate predicate = runSimplifier testEnv $ Pattern.simplify ( Pattern.fromCondition kSort - . Condition.fromPredicate - $ predicate + . Condition.fromPredicate + $ predicate ) evaluateTermT :: From 57c9ddcf2b8a5c977b8c893d1155bfbdccb20705 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Thu, 19 Aug 2021 12:56:13 +0300 Subject: [PATCH 33/40] Fix unit test --- kore/test/Test/Kore/Simplify/Integration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index 6ee9b5fdac..074d7ea8ba 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -583,7 +583,7 @@ test_simplificationIntegration = (mkTop Mock.testSort1) (mkNu g (mkOr Mock.aSort1 (mkSetVar g))) ) - (mkTop Mock.listSort) + (mkTop Mock.testSort1) ) , predicate = makeTruePredicate , substitution = mempty From 3404f75f156ec032670a5f727ba5e1957d2c3c04 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Mon, 6 Sep 2021 12:53:06 +0300 Subject: [PATCH 34/40] AddConditionWithReplacements: optimization --- kore/src/Kore/Internal/SideCondition.hs | 47 ++++++++++++++++++------- 1 file changed, 34 insertions(+), 13 deletions(-) diff --git a/kore/src/Kore/Internal/SideCondition.hs b/kore/src/Kore/Internal/SideCondition.hs index b82fff109f..7fa82a8425 100644 --- a/kore/src/Kore/Internal/SideCondition.hs +++ b/kore/src/Kore/Internal/SideCondition.hs @@ -281,6 +281,24 @@ addAssumptions predicates sideCondition = predicates <> assumedTrue sideCondition } +areIncludedIn + :: Eq variable + => Foldable f + => f (Predicate variable) + -> SideCondition variable + -> Bool +areIncludedIn predicates sideCondition = + all (flip isIncludedIn sideCondition) predicates + +isIncludedIn + :: Eq variable + => Predicate variable + -> SideCondition variable + -> Bool +isIncludedIn predicate SideCondition { assumedTrue } = + predicate `elem` assumedTrue + + {- | Assumes a 'Condition' to be true in the context of another 'SideCondition' and recalculates the term replacements table from the combined predicate. @@ -292,19 +310,22 @@ addConditionWithReplacements :: SideCondition variable addConditionWithReplacements (from @(Condition _) @(MultiAnd _) -> newCondition) - sideCondition = - let combinedConditions = oldCondition <> newCondition - (assumedTrue, assumptions) = - simplifyConjunctionByAssumption combinedConditions - & extract - Assumptions replacementsTermLike replacementsPredicate = assumptions - in SideCondition - { assumedTrue - , replacementsTermLike - , replacementsPredicate - , definedTerms - , simplifiedFunctions - } + sideCondition + | newCondition `areIncludedIn` sideCondition = + sideCondition + | otherwise = + let combinedConditions = oldCondition <> newCondition + (assumedTrue, assumptions) = + simplifyConjunctionByAssumption combinedConditions + & extract + Assumptions replacementsTermLike replacementsPredicate = assumptions + in SideCondition + { assumedTrue + , replacementsTermLike + , replacementsPredicate + , definedTerms + , simplifiedFunctions + } where SideCondition { assumedTrue = oldCondition From a311eceab7653820a8b850a3155830cd4f869afa Mon Sep 17 00:00:00 2001 From: github-actions Date: Mon, 6 Sep 2021 09:55:20 +0000 Subject: [PATCH 35/40] Format with fourmolu --- kore/src/Kore/Internal/SideCondition.hs | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/kore/src/Kore/Internal/SideCondition.hs b/kore/src/Kore/Internal/SideCondition.hs index 7fa82a8425..b96b4b0263 100644 --- a/kore/src/Kore/Internal/SideCondition.hs +++ b/kore/src/Kore/Internal/SideCondition.hs @@ -281,24 +281,23 @@ addAssumptions predicates sideCondition = predicates <> assumedTrue sideCondition } -areIncludedIn - :: Eq variable - => Foldable f - => f (Predicate variable) - -> SideCondition variable - -> Bool +areIncludedIn :: + Eq variable => + Foldable f => + f (Predicate variable) -> + SideCondition variable -> + Bool areIncludedIn predicates sideCondition = all (flip isIncludedIn sideCondition) predicates -isIncludedIn - :: Eq variable - => Predicate variable - -> SideCondition variable - -> Bool -isIncludedIn predicate SideCondition { assumedTrue } = +isIncludedIn :: + Eq variable => + Predicate variable -> + SideCondition variable -> + Bool +isIncludedIn predicate SideCondition{assumedTrue} = predicate `elem` assumedTrue - {- | Assumes a 'Condition' to be true in the context of another 'SideCondition' and recalculates the term replacements table from the combined predicate. From 2a5d675f044ae4e8ef26818b7ed934958c4e9c67 Mon Sep 17 00:00:00 2001 From: github-actions Date: Mon, 6 Sep 2021 11:08:09 +0000 Subject: [PATCH 36/40] Format with fourmolu --- kore/test/Test/Kore/Builtin/Builtin.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index d87d36fb76..88ebfd1ea5 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -56,15 +56,15 @@ import qualified Kore.IndexedModule.MetadataToolsBuilder as MetadataTools ( ) import qualified Kore.IndexedModule.OverloadGraph as OverloadGraph import qualified Kore.IndexedModule.SortGraph as SortGraph +import Kore.Internal.Condition ( + Condition, + ) import qualified Kore.Internal.Condition as Condition import Kore.Internal.InternalSet import Kore.Internal.OrPattern ( OrPattern, ) import qualified Kore.Internal.OrPattern as OrPattern -import Kore.Internal.Condition ( - Condition, - ) import Kore.Internal.Pattern ( Pattern, ) From 88bba445bf286b7fce3bcc367071da95a1ee10c2 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Mon, 6 Sep 2021 14:14:17 +0300 Subject: [PATCH 37/40] Retrigger workflows From 8596a22d8d1c464b34f04b9ab01f3bad7c1684d5 Mon Sep 17 00:00:00 2001 From: ana-pantilie Date: Mon, 6 Sep 2021 15:49:26 +0300 Subject: [PATCH 38/40] Unit test: remove awkward \and predicate simplification --- kore/test/Test/Kore/Builtin/Map.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Map.hs b/kore/test/Test/Kore/Builtin/Map.hs index e391417c7a..14348f6143 100644 --- a/kore/test/Test/Kore/Builtin/Map.hs +++ b/kore/test/Test/Kore/Builtin/Map.hs @@ -696,11 +696,9 @@ test_unifyConcrete = asTermLike (uncurry mkAnd <$> map12) patActual = mkAnd (asTermLike map1) (asTermLike map2) - predicate = fromEquals_ patExpect patActual expect <- evaluateTermT patExpect actual <- evaluateTermT patActual (===) expect actual - (===) (OrPattern.topOf kSort) =<< evaluatePredicateT predicate ) -- Given a function to scramble the arguments to concat, i.e., From de76e112dc37adf08d00b5168f7fe946886dcd2e Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 8 Sep 2021 14:57:36 +0300 Subject: [PATCH 39/40] Address review comment --- kore/src/Kore/Rewrite/Function/Evaluator.hs | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/kore/src/Kore/Rewrite/Function/Evaluator.hs b/kore/src/Kore/Rewrite/Function/Evaluator.hs index 29f339a2c9..e70acb0c43 100644 --- a/kore/src/Kore/Rewrite/Function/Evaluator.hs +++ b/kore/src/Kore/Rewrite/Function/Evaluator.hs @@ -271,7 +271,7 @@ maybeEvaluatePattern | toSimplify == unchangedPatt = return (OrPattern.fromPattern unchangedPatt) | otherwise = - reevaluateFunctions sideCondition toSimplify + simplifyPattern sideCondition toSimplify evaluateSortInjection :: InternalVariable variable => @@ -323,17 +323,6 @@ sortInjectionSorts symbol = , "should have two sort parameters." ] -{- | 'reevaluateFunctions' re-evaluates functions after a user-defined function -was evaluated. --} -reevaluateFunctions :: - MonadSimplify simplifier => - SideCondition RewritingVariableName -> - -- | Function evaluation result. - Pattern RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) -reevaluateFunctions = simplifyPattern - -- | Ands the given condition-substitution to the given function evaluation. mergeWithConditionAndSubstitution :: MonadSimplify simplifier => From a7d1cd3905fd31e9b80202a13a5183815438ead2 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Wed, 8 Sep 2021 15:04:10 +0300 Subject: [PATCH 40/40] Testing git config