From afd63226139210f42cd93d42621a984b9b41dcad Mon Sep 17 00:00:00 2001 From: Boarders Date: Tue, 25 May 2021 17:48:19 -0400 Subject: [PATCH 01/74] Remove _PREDICATE sort (#2604) Remove the predicate sort in favour of using known sorts at all call sites. This mostly adds sort arguments to various functions that previously implicitly used _PREDICATE sort. In turn this means removing the various underbar methods previously in `Kore.Internal.TermLike`. --- kore/src/Kore/Builtin/Builtin.hs | 8 +- kore/src/Kore/Builtin/EqTerm.hs | 3 +- kore/src/Kore/Builtin/Int.hs | 2 +- kore/src/Kore/Builtin/Int/Int.hs | 2 +- kore/src/Kore/Builtin/KEqual.hs | 2 +- kore/src/Kore/Builtin/List.hs | 4 +- kore/src/Kore/Builtin/Map.hs | 8 +- kore/src/Kore/Builtin/String/String.hs | 2 +- kore/src/Kore/Exec.hs | 5 +- kore/src/Kore/Internal/Inj.hs | 2 +- kore/src/Kore/Internal/OrPattern.hs | 26 ++- kore/src/Kore/Internal/Pattern.hs | 39 +--- kore/src/Kore/Internal/Predicate.hs | 9 +- kore/src/Kore/Internal/SideCondition.hs | 2 +- kore/src/Kore/Internal/TermLike.hs | 201 +++--------------- kore/src/Kore/ModelChecker/Simplification.hs | 6 +- kore/src/Kore/ModelChecker/Step.hs | 5 +- kore/src/Kore/Reachability/Claim.hs | 14 +- kore/src/Kore/Reachability/Prove.hs | 8 +- kore/src/Kore/Repl/Data.hs | 8 +- kore/src/Kore/Repl/Interpreter.hs | 2 +- kore/src/Kore/Repl/State.hs | 3 +- kore/src/Kore/Sort.hs | 48 +---- kore/src/Kore/Step/ClaimPattern.hs | 16 +- kore/src/Kore/Step/Implication.hs | 19 +- kore/src/Kore/Step/Remainder.hs | 4 +- kore/src/Kore/Step/Rule.hs | 3 +- kore/src/Kore/Step/Search.hs | 4 +- kore/src/Kore/Step/Simplification/And.hs | 23 +- kore/src/Kore/Step/Simplification/AndTerms.hs | 48 ++--- kore/src/Kore/Step/Simplification/Ceil.hs | 47 ++-- kore/src/Kore/Step/Simplification/Equals.hs | 92 ++++---- kore/src/Kore/Step/Simplification/Floor.hs | 27 +-- kore/src/Kore/Step/Simplification/Forall.hs | 12 +- kore/src/Kore/Step/Simplification/Iff.hs | 43 ++-- kore/src/Kore/Step/Simplification/Implies.hs | 33 +-- kore/src/Kore/Step/Simplification/In.hs | 6 +- .../Kore/Step/Simplification/InternalMap.hs | 10 +- .../Kore/Step/Simplification/InternalSet.hs | 10 +- kore/src/Kore/Step/Simplification/Not.hs | 26 ++- kore/src/Kore/Step/Simplification/Rewrites.hs | 78 +++++++ kore/src/Kore/Step/Simplification/Simplify.hs | 6 +- .../Simplification/SubstitutionSimplifier.hs | 4 +- kore/src/Kore/Step/Simplification/TermLike.hs | 12 +- kore/src/Kore/Step/Simplification/Top.hs | 3 +- kore/src/Kore/Step/Step.hs | 3 +- kore/src/Kore/Syntax/And.hs | 4 +- kore/src/Kore/Syntax/Ceil.hs | 2 +- kore/src/Kore/Syntax/DomainValue.hs | 2 +- kore/src/Kore/Syntax/Equals.hs | 4 +- kore/src/Kore/Syntax/Exists.hs | 2 +- kore/src/Kore/Syntax/Floor.hs | 2 +- kore/src/Kore/Syntax/Forall.hs | 2 +- kore/src/Kore/Syntax/Iff.hs | 4 +- kore/src/Kore/Syntax/Implies.hs | 4 +- kore/src/Kore/Syntax/In.hs | 4 +- kore/src/Kore/Syntax/Mu.hs | 2 +- kore/src/Kore/Syntax/Next.hs | 2 +- kore/src/Kore/Syntax/Not.hs | 2 +- kore/src/Kore/Syntax/Nu.hs | 2 +- kore/src/Kore/Syntax/Or.hs | 4 +- kore/src/Kore/Syntax/Rewrites.hs | 4 +- kore/src/Kore/Unification/Procedure.hs | 2 +- 63 files changed, 482 insertions(+), 504 deletions(-) create mode 100644 kore/src/Kore/Step/Simplification/Rewrites.hs diff --git a/kore/src/Kore/Builtin/Builtin.hs b/kore/src/Kore/Builtin/Builtin.hs index 2d0e597076..60bd7b4adb 100644 --- a/kore/src/Kore/Builtin/Builtin.hs +++ b/kore/src/Kore/Builtin/Builtin.hs @@ -86,9 +86,6 @@ import Kore.Internal.SideCondition ( SideCondition, ) import Kore.Internal.TermLike as TermLike -import Kore.Sort ( - predicateSort, - ) import Kore.Step.Simplification.Simplify ( AttemptedAxiom (..), AttemptedAxiomResults (AttemptedAxiomResults), @@ -448,19 +445,18 @@ isSymbol builtinName Symbol{symbolAttributes = Attribute.Symbol{hook}} = {- | Is the given sort hooked to the named builtin? +TO DO (callan): fix documentation here + Returns Nothing if the sort is unknown (i.e. the _PREDICATE sort). Returns Just False if the sort is a variable. -} isSort :: Text -> SmtMetadataTools attr -> Sort -> Maybe Bool isSort builtinName tools sort - | isPredicateSort = Nothing | SortVariableSort _ <- sort = Nothing | otherwise = let MetadataTools{sortAttributes} = tools Attribute.Sort{hook} = sortAttributes sort in Just (getHook hook == Just builtinName) - where - isPredicateSort = sort == predicateSort -- | Run a function evaluator that can terminate early. getAttemptedAxiom :: diff --git a/kore/src/Kore/Builtin/EqTerm.hs b/kore/src/Kore/Builtin/EqTerm.hs index 7fea52f3c4..2f20ca24c6 100644 --- a/kore/src/Kore/Builtin/EqTerm.hs +++ b/kore/src/Kore/Builtin/EqTerm.hs @@ -72,5 +72,6 @@ unifyEqTerm unifyChildren (NotSimplifier notSimplifier) eqTerm termLike2 >>= Unify.scatter | otherwise = empty where + sort = TermLike.termLikeSort termLike2 EqTerm{operand1, operand2} = eqTerm - eraseTerm = Pattern.fromCondition_ . Pattern.withoutTerm + eraseTerm = Pattern.fromCondition sort . Pattern.withoutTerm diff --git a/kore/src/Kore/Builtin/Int.hs b/kore/src/Kore/Builtin/Int.hs index 1b5b71655c..98b70d6bf3 100644 --- a/kore/src/Kore/Builtin/Int.hs +++ b/kore/src/Kore/Builtin/Int.hs @@ -515,4 +515,4 @@ unifyIntEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyIntEq{eqTerm, value} = unifyData EqTerm{operand1, operand2} = eqTerm - eraseTerm = Pattern.fromCondition_ . Pattern.withoutTerm + eraseTerm = fmap (mkTop . termLikeSort) diff --git a/kore/src/Kore/Builtin/Int/Int.hs b/kore/src/Kore/Builtin/Int/Int.hs index ba88c3560f..b183126f34 100644 --- a/kore/src/Kore/Builtin/Int/Int.hs +++ b/kore/src/Kore/Builtin/Int/Int.hs @@ -101,7 +101,7 @@ asPartialPattern :: Maybe Integer -> Pattern variable asPartialPattern resultSort = - maybe Pattern.bottom (asPattern resultSort) + maybe (Pattern.bottomOf resultSort) (asPattern resultSort) randKey :: IsString s => s randKey = "INT.rand" diff --git a/kore/src/Kore/Builtin/KEqual.hs b/kore/src/Kore/Builtin/KEqual.hs index c1b34ed3d2..5c653cd074 100644 --- a/kore/src/Kore/Builtin/KEqual.hs +++ b/kore/src/Kore/Builtin/KEqual.hs @@ -272,7 +272,7 @@ unifyKequalsEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyKequalsEq{eqTerm, value} = unifyData EqTerm{operand1, operand2} = eqTerm - eraseTerm = Pattern.fromCondition_ . Pattern.withoutTerm + eraseTerm = fmap (mkTop . termLikeSort) -- | The @KEQUAL.ite@ hooked symbol applied to @term@-type arguments. data IfThenElse term = IfThenElse diff --git a/kore/src/Kore/Builtin/List.hs b/kore/src/Kore/Builtin/List.hs index c086bda8ca..0cb7124c27 100644 --- a/kore/src/Kore/Builtin/List.hs +++ b/kore/src/Kore/Builtin/List.hs @@ -272,7 +272,7 @@ evalGet _ resultSort [_list, _ix] = do emptyList <|> bothConcrete where maybeBottom = - maybe Pattern.bottom Pattern.fromTermLike + maybe (Pattern.bottomOf resultSort) Pattern.fromTermLike evalGet _ _ _ = Builtin.wrongArity getKey evalUpdate :: Builtin.Function @@ -553,7 +553,7 @@ unifyEquals "Cannot unify lists of different length." first second - return Pattern.bottom + return (Pattern.bottomOf sort1) unifyEqualsFramedRightRight :: TermLike.Symbol -> diff --git a/kore/src/Kore/Builtin/Map.hs b/kore/src/Kore/Builtin/Map.hs index 135102004b..db1b47a0c9 100644 --- a/kore/src/Kore/Builtin/Map.hs +++ b/kore/src/Kore/Builtin/Map.hs @@ -631,8 +631,10 @@ unifyNotInKeys unifyChildren (NotSimplifier notSimplifier) a b = >>= Unify.scatter & lift + sort1 = TermLike.termLikeSort a + eraseTerm = - Pattern.fromCondition_ . Pattern.withoutTerm + Pattern.fromCondition sort1 . Pattern.withoutTerm unifyAndNegate t1 t2 = do @@ -646,7 +648,7 @@ unifyNotInKeys unifyChildren (NotSimplifier notSimplifier) a b = (OrPattern.fromPatterns unificationSolutions) >>= Unify.scatter - collectConditions terms = fold terms & Pattern.fromCondition_ + collectConditions terms = fold terms & Pattern.fromCondition sort1 worker :: TermLike RewritingVariableName -> @@ -663,7 +665,7 @@ unifyNotInKeys unifyChildren (NotSimplifier notSimplifier) a b = mapKeys = symbolicKeys <> concreteKeys opaqueElements = opaque . unwrapAc $ normalizedMap if null mapKeys && null opaqueElements - then return Pattern.top + then return (Pattern.topOf sort1) else do Monad.guard (not (null mapKeys) || (length opaqueElements > 1)) -- Concrete keys are constructor-like, therefore they are defined diff --git a/kore/src/Kore/Builtin/String/String.hs b/kore/src/Kore/Builtin/String/String.hs index e460ed8b3f..7029053e83 100644 --- a/kore/src/Kore/Builtin/String/String.hs +++ b/kore/src/Kore/Builtin/String/String.hs @@ -91,7 +91,7 @@ asPartialPattern :: Maybe Text -> Pattern variable asPartialPattern resultSort = - maybe Pattern.bottom (asPattern resultSort) + maybe (Pattern.bottomOf resultSort) (asPattern resultSort) eqKey :: IsString s => s eqKey = "STRING.eq" diff --git a/kore/src/Kore/Exec.hs b/kore/src/Kore/Exec.hs index e40fd28352..2ab5debf5a 100644 --- a/kore/src/Kore/Exec.hs +++ b/kore/src/Kore/Exec.hs @@ -266,8 +266,9 @@ exec <$> finalConfigs exitCode <- getExitCode verifiedModule finalConfigs' let finalTerm = - forceSort initialSort $ + sameTermLikeSort initialSort $ OrPattern.toTermLike + _ (MultiOr.map getRewritingPattern finalConfigs') return (exitCode, finalTerm) where @@ -423,7 +424,7 @@ search orPredicate = makeMultipleOrPredicate (Condition.toPredicate <$> solutions) return - . forceSort patternSort + . sameTermLikeSort patternSort . getRewritingTerm . fromPredicate_ $ orPredicate diff --git a/kore/src/Kore/Internal/Inj.hs b/kore/src/Kore/Internal/Inj.hs index 53934a5938..24c1bd341b 100644 --- a/kore/src/Kore/Internal/Inj.hs +++ b/kore/src/Kore/Internal/Inj.hs @@ -85,7 +85,7 @@ instance Unparse a => Unparse (Inj a) where instance Synthetic Sort Inj where synthetic Inj{injFrom, injTo, injChild} = - injTo & seq (matchSort injFrom injChild) + injTo & seq (sameSort injFrom injChild) {-# INLINE synthetic #-} instance Synthetic (FreeVariables variable) Inj where diff --git a/kore/src/Kore/Internal/OrPattern.hs b/kore/src/Kore/Internal/OrPattern.hs index 429e800cd2..6db156ad05 100644 --- a/kore/src/Kore/Internal/OrPattern.hs +++ b/kore/src/Kore/Internal/OrPattern.hs @@ -16,6 +16,7 @@ module Kore.Internal.OrPattern ( bottom, isFalse, isPredicate, + tryGetSort, top, isTrue, toPattern, @@ -58,7 +59,7 @@ import Kore.Internal.TermLike ( InternalVariable, Sort, TermLike, - mkBottom_, + mkBottom, mkOr, ) import Kore.Syntax.Variable @@ -151,10 +152,12 @@ isFalse = isBottom @ 'isTrue' top == True + +To do (Callan): should this be renamed `topOf` as elsewhere? @ -} -top :: InternalVariable variable => OrPattern variable -top = fromPattern Pattern.top +top :: InternalVariable variable => Sort -> OrPattern variable +top sort = fromPattern (Pattern.topOf sort) -- | 'isTrue' checks if the 'Or' has a single top pattern. isTrue :: OrPattern variable -> Bool @@ -164,11 +167,12 @@ isTrue = isTop toPattern :: forall variable. InternalVariable variable => + Sort -> OrPattern variable -> Pattern variable -toPattern multiOr = +toPattern sort multiOr = case toList multiOr of - [] -> Pattern.bottom + [] -> Pattern.bottomOf sort [patt] -> patt patts -> foldr1 mergeWithOr patts where @@ -198,14 +202,22 @@ toPattern multiOr = isPredicate :: OrPattern variable -> Bool isPredicate = all Pattern.isPredicate +-- | Gets the `Sort` of a non-empty 'OrPattern' and othewise returns `Nothing`. +tryGetSort :: OrPattern variable -> Maybe Sort +tryGetSort multiOr = + case toList multiOr of + [] -> Nothing + p : _ -> Just (Pattern.patternSort p) + -- | Transforms a 'Pattern' into a 'TermLike'. toTermLike :: InternalVariable variable => + Sort -> OrPattern variable -> TermLike variable -toTermLike multiOr = +toTermLike sort multiOr = case toList multiOr of - [] -> mkBottom_ + [] -> mkBottom sort [patt] -> Pattern.toTermLike patt patts -> foldr1 mkOr (Pattern.toTermLike <$> patts) diff --git a/kore/src/Kore/Internal/Pattern.hs b/kore/src/Kore/Internal/Pattern.hs index cee83d78f1..2175ba1664 100644 --- a/kore/src/Kore/Internal/Pattern.hs +++ b/kore/src/Kore/Internal/Pattern.hs @@ -10,17 +10,14 @@ module Kore.Internal.Pattern ( syncSort, patternSort, fromCondition, - fromCondition_, fromTermAndPredicate, fromPredicateSorted, - bottom, bottomOf, isBottom, isTop, Kore.Internal.Pattern.mapVariables, splitTerm, toTermLike, - top, topOf, fromTermLike, Kore.Internal.Pattern.freeElementVariables, @@ -81,9 +78,7 @@ import Kore.Internal.TermLike ( TermLike, mkAnd, mkBottom, - mkBottom_, mkTop, - mkTop_, termLikeSort, ) import qualified Kore.Internal.TermLike as TermLike @@ -110,11 +105,6 @@ fromTermAndPredicate term predicate = , predicate , substitution = mempty } -fromCondition_ :: - InternalVariable variable => - Condition variable -> - Pattern variable -fromCondition_ = (<$) mkTop_ fromCondition :: InternalVariable variable => Sort -> @@ -239,17 +229,6 @@ toTermLike Conditional{term, predicate, substitution} = predicateTermLike = Predicate.fromPredicate sort predicate' sort = termLikeSort pattern' -{- |'bottom' is an expanded pattern that has a bottom condition and that -should become Bottom when transformed to a ML pattern. --} -bottom :: InternalVariable variable => Pattern variable -bottom = - Conditional - { term = mkBottom_ - , predicate = Predicate.makeFalsePredicate - , substitution = mempty - } - {- | An 'Pattern' where the 'term' is 'Bottom' of the given 'Sort'. The 'predicate' is set to 'makeFalsePredicate'. @@ -262,17 +241,6 @@ bottomOf resultSort = , substitution = mempty } -{- |'top' is an expanded pattern that has a top condition and that -should become Top when transformed to a ML pattern. --} -top :: InternalVariable variable => Pattern variable -top = - Conditional - { term = mkTop_ - , predicate = Predicate.makeTruePredicate - , substitution = mempty - } - -- | An 'Pattern' where the 'term' is 'Top' of the given 'Sort'. topOf :: InternalVariable variable => Sort -> Pattern variable topOf resultSort = @@ -342,7 +310,7 @@ coerceSort { term = if isTop term then mkTop sort - else TermLike.forceSort sort term + else TermLike.sameTermLikeSort sort term , -- Need to override this since a 'ceil' (say) over a predicate is that -- predicate with a different sort. predicate = predicate @@ -410,9 +378,10 @@ substitute subst Conditional{term, predicate, substitution} = fromMultiAnd :: InternalVariable variable => + Sort -> MultiAnd (Pattern variable) -> Pattern variable -fromMultiAnd patterns = +fromMultiAnd sort patterns = foldr ( \pattern1 -> pure @@ -422,4 +391,4 @@ fromMultiAnd patterns = ) Nothing patterns - & fromMaybe top + & fromMaybe (topOf sort) diff --git a/kore/src/Kore/Internal/Predicate.hs b/kore/src/Kore/Internal/Predicate.hs index a2f56499e2..a3f250a972 100644 --- a/kore/src/Kore/Internal/Predicate.hs +++ b/kore/src/Kore/Internal/Predicate.hs @@ -136,9 +136,6 @@ import Kore.Internal.TermLike hiding ( substitute, ) import qualified Kore.Internal.TermLike as TermLike -import Kore.Sort ( - predicateSort, - ) import Kore.TopBottom ( TopBottom (..), ) @@ -504,7 +501,7 @@ fromPredicate_ :: InternalVariable variable => Predicate variable -> TermLike variable -fromPredicate_ = fromPredicate predicateSort +fromPredicate_ = fromPredicate undefined {- | Simple type used to track whether a predicate building function performed a simplification that changed the shape of the resulting term. This is @@ -728,7 +725,7 @@ makeInPredicate' :: TermLike variable -> (Predicate variable, HasChanged) makeInPredicate' t1 t2 = - (TermLike.makeSortsAgree makeInWorker t1 t2, NotChanged) + (TermLike.checkSortsAgree makeInWorker t1 t2, NotChanged) where makeInWorker t1' t2' _ = synthesize $ InF $ In () () t1' t2' @@ -745,7 +742,7 @@ makeEqualsPredicate' :: TermLike variable -> (Predicate variable, HasChanged) makeEqualsPredicate' t1 t2 = - (TermLike.makeSortsAgree makeEqualsWorker t1 t2, NotChanged) + (TermLike.checkSortsAgree makeEqualsWorker t1 t2, NotChanged) where makeEqualsWorker t1' t2' _ = synthesize $ EqualsF $ Equals () () t1' t2' diff --git a/kore/src/Kore/Internal/SideCondition.hs b/kore/src/Kore/Internal/SideCondition.hs index 619be6c8db..a17c2a25cb 100644 --- a/kore/src/Kore/Internal/SideCondition.hs +++ b/kore/src/Kore/Internal/SideCondition.hs @@ -528,7 +528,7 @@ simplifyConjunctionByAssumption (toList -> andPredicates) = assumeEqualTerms = case predicate of PredicateEquals t1 t2 -> - case retractLocalFunction (TermLike.mkEquals_ t1 t2) of + case retractLocalFunction (TermLike.mkEquals (TermLike.termLikeSort t1) t1 t2) of Just (Pair t1' t2') -> Lens.over (field @"termLikeMap") $ HashMap.insert t1' t2' diff --git a/kore/src/Kore/Internal/TermLike.hs b/kore/src/Kore/Internal/TermLike.hs index bf2920ad24..74be17ffcf 100644 --- a/kore/src/Kore/Internal/TermLike.hs +++ b/kore/src/Kore/Internal/TermLike.hs @@ -38,10 +38,10 @@ module Kore.Internal.TermLike ( refreshElementBinder, refreshSetBinder, depth, - makeSortsAgree, + checkSortsAgree, -- * Utility functions for dealing with sorts - forceSort, + sameTermLikeSort, fullyOverrideSort, -- * Reachability modalities and application @@ -92,14 +92,6 @@ module Kore.Internal.TermLike ( mkEndianness, mkSignedness, - -- * Predicate constructors - mkBottom_, - mkCeil_, - mkEquals_, - mkFloor_, - mkIn_, - mkTop_, - -- * Sentence constructors mkAlias, mkAlias_, @@ -594,27 +586,18 @@ checkedSimplifiedFromChildren termLikeF = termLikeSort :: TermLike variable -> Sort termLikeSort = termSort . extractAttributes --- | Attempts to modify p to have sort s. -forceSort :: +-- | Check the given `TermLike` has the same sort as that supplied +sameTermLikeSort :: (InternalVariable variable, HasCallStack) => + -- | expected sort Sort -> TermLike variable -> TermLike variable -forceSort forcedSort = - if forcedSort == predicateSort - then id - else Recursive.apo forceSortWorker +sameTermLikeSort expectedSort term + | expectedSort == termSort = term + | otherwise = illSorted expectedSort term where - forceSortWorker original@(Recursive.project -> attrs :< pattern') = - (:<) - (attrs{termSort = forcedSort}) - ( case attrs of - TermAttributes{termSort = sort} - | sort == forcedSort -> Left <$> pattern' - | sort == predicateSort -> - forceSortPredicate forcedSort original - | otherwise -> illSorted forcedSort original - ) + termSort = termLikeSort term {- | Attempts to modify the pattern to have the given sort, ignoring the previous sort and without assuming that the pattern's sorts are consistent. @@ -727,35 +710,15 @@ forceSortPredicate SignednessF _ -> illSorted forcedSort original InjF _ -> illSorted forcedSort original -{- | Call the argument function with two patterns whose sorts agree. - -If one pattern is flexibly sorted, the result is the rigid sort of the other -pattern. If both patterns are flexibly sorted, then the result is -'predicateSort'. If both patterns have the same rigid sort, that is the -result. It is an error if the patterns are rigidly sorted but do not have the -same sort. --} -makeSortsAgree :: - (InternalVariable variable, HasCallStack) => +checkSortsAgree :: (TermLike variable -> TermLike variable -> Sort -> a) -> TermLike variable -> TermLike variable -> a -makeSortsAgree withPatterns = \pattern1 pattern2 -> - let sort1 = getRigidSort pattern1 - sort2 = getRigidSort pattern2 - sort = fromMaybe predicateSort (sort1 <|> sort2) - !pattern1' = forceSort sort pattern1 - !pattern2' = forceSort sort pattern2 - in withPatterns pattern1' pattern2' sort -{-# INLINE makeSortsAgree #-} - -getRigidSort :: TermLike variable -> Maybe Sort -getRigidSort pattern' = - case termLikeSort pattern' of - sort - | sort == predicateSort -> Nothing - | otherwise -> Just sort +checkSortsAgree withPatterns t1 t2 = withPatterns t1 t2 (sameSort s1 s2) + where + s1 = termLikeSort t1 + s2 = termLikeSort t2 -- | Construct an 'And' pattern. mkAnd :: @@ -764,7 +727,7 @@ mkAnd :: TermLike variable -> TermLike variable -> TermLike variable -mkAnd t1 t2 = updateCallStack $ makeSortsAgree mkAndWorker t1 t2 +mkAnd t1 t2 = updateCallStack $ checkSortsAgree mkAndWorker t1 t2 where mkAndWorker andFirst andSecond andSort = synthesize (AndF And{andSort, andFirst, andSecond}) @@ -773,23 +736,21 @@ mkAnd t1 t2 = updateCallStack $ makeSortsAgree mkAndWorker t1 t2 It is an error if the lists are not the same length, or if any 'TermLike' cannot be coerced to its corresponding 'Sort'. - -See also: 'forceSort' -} -forceSorts :: +sameTermLikeSorts :: HasCallStack => InternalVariable variable => [Sort] -> [TermLike variable] -> [TermLike variable] -forceSorts operandSorts children = +sameTermLikeSorts operandSorts children = alignWith forceTheseSorts operandSorts children where forceTheseSorts (This _) = (error . show . Pretty.vsep) ("Too few arguments:" : expected) forceTheseSorts (That _) = (error . show . Pretty.vsep) ("Too many arguments:" : expected) - forceTheseSorts (These sort termLike) = forceSort sort termLike + forceTheseSorts (These sort termLike) = sameTermLikeSort sort termLike expected = [ "Expected:" , Pretty.indent 4 (Unparser.arguments operandSorts) @@ -819,7 +780,7 @@ mkApplyAlias alias children = application = Application { applicationSymbolOrAlias = alias - , applicationChildren = forceSorts operandSorts children + , applicationChildren = sameTermLikeSorts operandSorts children } operandSorts = applicationSortsOperands (aliasSorts alias) @@ -854,7 +815,7 @@ symbolApplication :: symbolApplication symbol children = Application { applicationSymbolOrAlias = symbol - , applicationChildren = forceSorts operandSorts children + , applicationChildren = sameTermLikeSorts operandSorts children } where operandSorts = applicationSortsOperands (symbolSorts symbol) @@ -902,7 +863,7 @@ applyAlias sentence params children = where forceChildSort = \case - These sort pattern' -> forceSort sort pattern' + These sort pattern' -> sameTermLikeSort sort pattern' This _ -> (error . show . Pretty.vsep) ("Too few parameters:" : expected) @@ -975,10 +936,7 @@ applySymbol_ :: TermLike variable applySymbol_ sentence = updateCallStack . applySymbol sentence [] -{- | Construct a 'Bottom' pattern in the given sort. - -See also: 'mkBottom_' --} +-- | Construct a 'Bottom' pattern in the given sort. mkBottom :: HasCallStack => InternalVariable variable => @@ -987,23 +945,7 @@ mkBottom :: mkBottom bottomSort = updateCallStack $ synthesize (BottomF Bottom{bottomSort}) -{- | Construct a 'Bottom' pattern in 'predicateSort'. - -This should not be used outside "Kore.Internal.Predicate"; please use -'mkBottom' instead. - -See also: 'mkBottom' --} -mkBottom_ :: - HasCallStack => - InternalVariable variable => - TermLike variable -mkBottom_ = updateCallStack $ mkBottom predicateSort - -{- | Construct a 'Ceil' pattern in the given sort. - -See also: 'mkCeil_' --} +-- | Construct a 'Ceil' pattern in the given sort. mkCeil :: HasCallStack => InternalVariable variable => @@ -1016,20 +958,6 @@ mkCeil ceilResultSort ceilChild = where ceilOperandSort = termLikeSort ceilChild -{- | Construct a 'Ceil' pattern in 'predicateSort'. - -This should not be used outside "Kore.Internal.Predicate"; please use 'mkCeil' -instead. - -See also: 'mkCeil' --} -mkCeil_ :: - HasCallStack => - InternalVariable variable => - TermLike variable -> - TermLike variable -mkCeil_ = updateCallStack . mkCeil predicateSort - -- | Construct an internal bool pattern. mkInternalBool :: HasCallStack => @@ -1086,10 +1014,7 @@ mkDomainValue :: TermLike variable mkDomainValue = updateCallStack . synthesize . DomainValueF -{- | Construct an 'Equals' pattern in the given sort. - -See also: 'mkEquals_' --} +-- | Construct an 'Equals' pattern in the given sort. mkEquals :: HasCallStack => InternalVariable variable => @@ -1098,7 +1023,7 @@ mkEquals :: TermLike variable -> TermLike variable mkEquals equalsResultSort t1 = - updateCallStack . makeSortsAgree mkEqualsWorker t1 + updateCallStack . checkSortsAgree mkEqualsWorker t1 where mkEqualsWorker equalsFirst equalsSecond equalsOperandSort = synthesize (EqualsF equals) @@ -1111,21 +1036,6 @@ mkEquals equalsResultSort t1 = , equalsSecond } -{- | Construct a 'Equals' pattern in 'predicateSort'. - -This should not be used outside "Kore.Internal.Predicate"; please use -'mkEquals' instead. - -See also: 'mkEquals' --} -mkEquals_ :: - HasCallStack => - InternalVariable variable => - TermLike variable -> - TermLike variable -> - TermLike variable -mkEquals_ t1 t2 = updateCallStack $ mkEquals predicateSort t1 t2 - -- | Construct an 'Exists' pattern. mkExists :: HasCallStack => @@ -1149,10 +1059,7 @@ mkExistsN :: TermLike variable mkExistsN = (updateCallStack .) . appEndo . foldMap (Endo . mkExists) -{- | Construct a 'Floor' pattern in the given sort. - -See also: 'mkFloor_' --} +-- | Construct a 'Floor' pattern in the given sort. mkFloor :: HasCallStack => InternalVariable variable => @@ -1165,20 +1072,6 @@ mkFloor floorResultSort floorChild = where floorOperandSort = termLikeSort floorChild -{- | Construct a 'Floor' pattern in 'predicateSort'. - -This should not be used outside "Kore.Internal.Predicate"; please use 'mkFloor' -instead. - -See also: 'mkFloor' --} -mkFloor_ :: - HasCallStack => - InternalVariable variable => - TermLike variable -> - TermLike variable -mkFloor_ = updateCallStack . mkFloor predicateSort - -- | Construct a 'Forall' pattern. mkForall :: HasCallStack => @@ -1209,7 +1102,7 @@ mkIff :: TermLike variable -> TermLike variable -> TermLike variable -mkIff t1 t2 = updateCallStack $ makeSortsAgree mkIffWorker t1 t2 +mkIff t1 t2 = updateCallStack $ checkSortsAgree mkIffWorker t1 t2 where mkIffWorker iffFirst iffSecond iffSort = synthesize (IffF Iff{iffSort, iffFirst, iffSecond}) @@ -1221,7 +1114,7 @@ mkImplies :: TermLike variable -> TermLike variable -> TermLike variable -mkImplies t1 t2 = updateCallStack $ makeSortsAgree mkImpliesWorker t1 t2 +mkImplies t1 t2 = updateCallStack $ checkSortsAgree mkImpliesWorker t1 t2 where mkImpliesWorker impliesFirst impliesSecond impliesSort = synthesize (ImpliesF implies') @@ -1239,7 +1132,7 @@ mkIn :: TermLike variable -> TermLike variable -> TermLike variable -mkIn inResultSort t1 t2 = updateCallStack $ makeSortsAgree mkInWorker t1 t2 +mkIn inResultSort t1 t2 = updateCallStack $ checkSortsAgree mkInWorker t1 t2 where mkInWorker inContainedChild inContainingChild inOperandSort = synthesize (InF in') @@ -1252,21 +1145,6 @@ mkIn inResultSort t1 t2 = updateCallStack $ makeSortsAgree mkInWorker t1 t2 , inContainingChild } -{- | Construct a 'In' pattern in 'predicateSort'. - -This should not be used outside "Kore.Internal.Predicate"; please use 'mkIn' -instead. - -See also: 'mkIn' --} -mkIn_ :: - HasCallStack => - InternalVariable variable => - TermLike variable -> - TermLike variable -> - TermLike variable -mkIn_ t1 t2 = updateCallStack $ mkIn predicateSort t1 t2 - -- | Construct a 'Mu' pattern. mkMu :: HasCallStack => @@ -1274,7 +1152,7 @@ mkMu :: SetVariable variable -> TermLike variable -> TermLike variable -mkMu muVar = updateCallStack . makeSortsAgree mkMuWorker (mkSetVar muVar) +mkMu muVar = updateCallStack . checkSortsAgree mkMuWorker (mkSetVar muVar) where mkMuWorker (SetVar_ muVar') muChild _ = synthesize (MuF Mu{muVariable = muVar', muChild}) @@ -1309,7 +1187,7 @@ mkNu :: SetVariable variable -> TermLike variable -> TermLike variable -mkNu nuVar = updateCallStack . makeSortsAgree mkNuWorker (mkSetVar nuVar) +mkNu nuVar = updateCallStack . checkSortsAgree mkNuWorker (mkSetVar nuVar) where mkNuWorker (SetVar_ nuVar') nuChild _ = synthesize (NuF Nu{nuVariable = nuVar', nuChild}) @@ -1322,7 +1200,7 @@ mkOr :: TermLike variable -> TermLike variable -> TermLike variable -mkOr t1 t2 = updateCallStack $ makeSortsAgree mkOrWorker t1 t2 +mkOr t1 t2 = updateCallStack $ checkSortsAgree mkOrWorker t1 t2 where mkOrWorker orFirst orSecond orSort = synthesize (OrF Or{orSort, orFirst, orSecond}) @@ -1334,7 +1212,7 @@ mkRewrites :: TermLike variable -> TermLike variable -> TermLike variable -mkRewrites t1 t2 = updateCallStack $ makeSortsAgree mkRewritesWorker t1 t2 +mkRewrites t1 t2 = updateCallStack $ checkSortsAgree mkRewritesWorker t1 t2 where mkRewritesWorker rewritesFirst rewritesSecond rewritesSort = synthesize (RewritesF rewrites') @@ -1353,19 +1231,6 @@ mkTop :: mkTop topSort = updateCallStack $ synthesize (TopF Top{topSort}) -{- | Construct a 'Top' pattern in 'predicateSort'. - -This should not be used outside "Kore.Internal.Predicate"; please use -'mkTop' instead. - -See also: 'mkTop' --} -mkTop_ :: - HasCallStack => - InternalVariable variable => - TermLike variable -mkTop_ = updateCallStack $ mkTop predicateSort - -- | Construct an element variable pattern. mkElemVar :: HasCallStack => diff --git a/kore/src/Kore/ModelChecker/Simplification.hs b/kore/src/Kore/ModelChecker/Simplification.hs index b0bce8ecec..b591be6a4e 100644 --- a/kore/src/Kore/ModelChecker/Simplification.hs +++ b/kore/src/Kore/ModelChecker/Simplification.hs @@ -21,7 +21,7 @@ import qualified Kore.Internal.Predicate as Predicate import Kore.Internal.TermLike ( TermLike, mkAnd, - mkCeil_, + mkCeil, mkElemVar, mkNot, pattern Forall_, @@ -59,7 +59,8 @@ checkImplicationIsTop lhs rhs = implicationLHS' = TermLike.substitute subst implicationLHS implicationRHS' = TermLike.substitute subst implicationRHS resultTerm = - mkCeil_ + mkCeil + sort ( mkAnd (mkAnd lhsMLPatt implicationLHS') (mkNot implicationRHS') @@ -87,6 +88,7 @@ checkImplicationIsTop lhs rhs = & map variableName & Set.fromList lhsMLPatt = Pattern.toTermLike lhs + sort = TermLike.termLikeSort rhs stripForallQuantifiers :: TermLike RewritingVariableName -> diff --git a/kore/src/Kore/ModelChecker/Step.hs b/kore/src/Kore/ModelChecker/Step.hs index b260dbd702..de9950873a 100644 --- a/kore/src/Kore/ModelChecker/Step.hs +++ b/kore/src/Kore/ModelChecker/Step.hs @@ -201,8 +201,9 @@ transitionRule transitionComputeWeakNext _ (Unprovable config) = return (Unprovable config) transitionComputeWeakNext rules (GoalLHS config) = transitionComputeWeakNextHelper rules config - transitionComputeWeakNext _ (GoalRemLHS _) = - return (GoalLHS Pattern.bottom) + transitionComputeWeakNext _ (GoalRemLHS pat) = + let patSort = Pattern.patternSort pat + in return (GoalLHS (Pattern.bottomOf patSort)) transitionComputeWeakNextHelper :: [RewriteRule RewritingVariableName] -> diff --git a/kore/src/Kore/Reachability/Claim.hs b/kore/src/Kore/Reachability/Claim.hs index 9e44e6dbd3..0759a03214 100644 --- a/kore/src/Kore/Reachability/Claim.hs +++ b/kore/src/Kore/Reachability/Claim.hs @@ -97,6 +97,7 @@ import Kore.Internal.Symbol ( Symbol, ) import Kore.Internal.TermLike ( + Sort, isFunctionPattern, mkIn, termLikeSort, @@ -274,13 +275,14 @@ deriveSeqClaim lensClaimPattern mkClaim claims claim = fmap (snd . Step.refreshRule mempty) $ Lens.forOf (field @"left") claimPattern $ \config -> Compose $ do + let claimPatSort = ClaimPattern.getClaimPatternSort claimPattern results <- Step.applyClaimsSequence mkClaim config (Lens.view lensClaimPattern <$> claims) & lift - deriveResults fromAppliedRule results + deriveResults claimPatSort fromAppliedRule results where fromAppliedRule = AppliedClaim @@ -555,7 +557,7 @@ checkImplicationWorker (ClaimPattern.refreshExistentials -> claimPattern) = Exists.makeEvaluate sideCondition existentials removed >>= Logic.scatter & OrPattern.observeAllT - & (>>= Not.simplifyEvaluated sideCondition) + & (>>= (Not.simplifyEvaluated sort) sideCondition) & wereAnyUnified wereAnyUnified :: StateT AnyUnified m a -> m (AnyUnified, a) @@ -665,8 +667,9 @@ deriveWith lensClaimPattern mkRule takeStep rewrites claim = fmap (snd . Step.refreshRule mempty) $ Lens.forOf (field @"left") claimPattern $ \config -> Compose $ do + let claimPatSort = ClaimPattern.getClaimPatternSort claimPattern results <- takeStep rewrites config & lift - deriveResults fromAppliedRule results + deriveResults claimPatSort fromAppliedRule results where fromAppliedRule = AppliedAxiom @@ -688,6 +691,7 @@ deriveSeq' lensRulePattern mkRule = deriveResults :: Step.UnifyingRuleVariable representation ~ RewritingVariableName => + Sort -> (Step.UnifiedRule representation -> AppliedRule claim) -> Step.Results representation -> Strategy.TransitionT @@ -695,7 +699,7 @@ deriveResults :: simplifier (ApplyResult (Pattern RewritingVariableName)) -- TODO (thomas.tuegel): Remove claim argument. -deriveResults fromAppliedRule Results{results, remainders} = +deriveResults sort fromAppliedRule Results{results, remainders} = addResults <|> addRemainders where addResults = asum (addResult <$> results) @@ -704,7 +708,7 @@ deriveResults fromAppliedRule Results{results, remainders} = addResult Result{appliedRule, result} = do addRule appliedRule case toList result of - [] -> addRewritten Pattern.bottom + [] -> addRewritten (Pattern.bottomOf sort) configs -> asum (addRewritten <$> configs) addRewritten = pure . ApplyRewritten diff --git a/kore/src/Kore/Reachability/Prove.hs b/kore/src/Kore/Reachability/Prove.hs index 8db28dd403..aeb85c7002 100644 --- a/kore/src/Kore/Reachability/Prove.hs +++ b/kore/src/Kore/Reachability/Prove.hs @@ -101,6 +101,9 @@ import Kore.Rewriting.RewritingVariable ( RewritingVariableName, getRewritingPattern, ) +import Kore.Sort ( + Sort, + ) import Kore.Step.ClaimPattern ( mkGoal, ) @@ -142,16 +145,17 @@ type CommonTransitionRule m = the configuration will be '\\bottom'. -} lhsClaimStateTransformer :: + Sort -> ClaimStateTransformer SomeClaim (Pattern RewritingVariableName) -lhsClaimStateTransformer = +lhsClaimStateTransformer sort = ClaimStateTransformer { claimedTransformer = getConfiguration , remainingTransformer = getConfiguration , rewrittenTransformer = getConfiguration , stuckTransformer = getConfiguration - , provenValue = Pattern.bottom + , provenValue = Pattern.bottomOf sort } {- | @Verifer a@ is a 'Simplifier'-based action which returns an @a@. diff --git a/kore/src/Kore/Repl/Data.hs b/kore/src/Kore/Repl/Data.hs index 3336fbd4cc..9f3bf86b6b 100644 --- a/kore/src/Kore/Repl/Data.hs +++ b/kore/src/Kore/Repl/Data.hs @@ -104,6 +104,9 @@ import qualified Kore.Reachability as Reachability import Kore.Rewriting.RewritingVariable ( RewritingVariableName, ) +import Kore.Sort ( + Sort, + ) import Kore.Step.Simplification.Data ( MonadSimplify (..), ) @@ -691,16 +694,17 @@ makeKoreReplOutput str = runUnifierWithExplanation :: forall m a. MonadSimplify m => + Sort -> UnifierWithExplanation m a -> m (Either ReplOutput (NonEmpty a)) -runUnifierWithExplanation (UnifierWithExplanation unifier) = +runUnifierWithExplanation currSort (UnifierWithExplanation unifier) = failWithExplanation <$> unificationResults where unificationResults :: m ([a], First ReplOutput) unificationResults = flip runAccumT mempty - . Monad.Unify.runUnifierT Not.notSimplifier + . Monad.Unify.runUnifierT (Not.notSimplifier currSort) $ unifier failWithExplanation :: ([a], First ReplOutput) -> diff --git a/kore/src/Kore/Repl/Interpreter.hs b/kore/src/Kore/Repl/Interpreter.hs index bda006fe57..6e1a09311e 100644 --- a/kore/src/Kore/Repl/Interpreter.hs +++ b/kore/src/Kore/Repl/Interpreter.hs @@ -1394,7 +1394,7 @@ prettyClaimStateComponent transformation omitList = } where prettyComponent = - unparseToString . OrPattern.toTermLike + unparseToString . OrPattern.toTermLike _ . MultiOr.map (fmap hide . getRewritingPattern) . transformation hide :: diff --git a/kore/src/Kore/Repl/State.hs b/kore/src/Kore/Repl/State.hs index 2739dfc243..e648e13ba0 100644 --- a/kore/src/Kore/Repl/State.hs +++ b/kore/src/Kore/Repl/State.hs @@ -620,8 +620,9 @@ runUnifier :: runUnifier sideCondition first second = do unifier <- asks unifier mvar <- asks logger + let firstSort = TermLike.termLikeSort first liftSimplifierWithLogger mvar - . runUnifierWithExplanation + . (runUnifierWithExplanation firstSort) $ unifier sideCondition first second getNodeState :: InnerGraph -> Graph.Node -> Maybe (NodeState, Graph.Node) diff --git a/kore/src/Kore/Sort.hs b/kore/src/Kore/Sort.hs index 085fa3ea74..5531bfc18c 100644 --- a/kore/src/Kore/Sort.hs +++ b/kore/src/Kore/Sort.hs @@ -11,11 +11,8 @@ module Kore.Sort ( getSortId, sortSubstitution, substituteSortVariables, - rigidSort, sameSort, - matchSort, matchSorts, - alignSorts, -- * Meta-sorts MetaSortType (..), @@ -27,7 +24,6 @@ module Kore.Sort ( stringMetaSort, predicateSortId, predicateSortActual, - predicateSort, -- * Exceptions SortMismatch (..), @@ -218,29 +214,6 @@ predicateSortActual = SortActual predicateSortId [] The final predicate sort is unknown until the predicate is attached to a pattern. -} -predicateSort :: Sort -{- TODO PREDICATE (thomas.tuegel): - -Add a constructor - -> data Sort = ... | FlexibleSort - -to use internally as a placeholder where the predicate sort is not yet -known. Using the sort _PREDICATE{} is a kludge; the backend will melt down if -the user tries to define a sort named _PREDICATE{}. (At least, this is not -actually a valid identifier in Kore.) - -Until this is fixed, the identifier _PREDICATE is reserved in -Kore.ASTVerifier.DefinitionVerifier.indexImplicitModule. - --} -predicateSort = SortActualSort predicateSortActual - -rigidSort :: Sort -> Maybe Sort -rigidSort sort - | sort == predicateSort = Nothing - | otherwise = Just sort - data SortMismatch = SortMismatch !Sort !Sort deriving stock (Eq, Show, Typeable) @@ -290,28 +263,9 @@ sameSort sort1 sort2 | sort1 == sort2 = sort1 | otherwise = sortMismatch sort1 sort2 -{- | Match the second sort to the first. - -If the second sort is flexible, it matches the first sort. If the second sort is -rigid, it must be equal to the first sort. --} -matchSort :: Sort -> Sort -> Sort -matchSort sort1 sort2 = - maybe sort1 (sameSort sort1) (rigidSort sort2) - matchSorts :: [Sort] -> [Sort] -> [Sort] matchSorts = alignWith matchTheseSorts where matchTheseSorts (This sort1) = missingArgument sort1 matchTheseSorts (That sort2) = unexpectedArgument sort2 - matchTheseSorts (These sort1 sort2) = matchSort sort1 sort2 - -alignSorts :: Foldable f => f Sort -> Sort -alignSorts = fromMaybe predicateSort . foldl' worker Nothing - where - worker Nothing sort2 = rigidSort sort2 - worker (Just sort1) sort2 = - Just $ maybe sort1 (alignSort sort1) (rigidSort sort2) - alignSort sort1 sort2 - | sort1 == sort2 = sort1 - | otherwise = sortMismatch sort1 sort2 + matchTheseSorts (These sort1 sort2) = sameSort sort1 sort2 diff --git a/kore/src/Kore/Step/ClaimPattern.hs b/kore/src/Kore/Step/ClaimPattern.hs index 6695cc26b7..ebc86eb13a 100644 --- a/kore/src/Kore/Step/ClaimPattern.hs +++ b/kore/src/Kore/Step/ClaimPattern.hs @@ -16,6 +16,7 @@ module Kore.Step.ClaimPattern ( forgetSimplified, parseRightHandSide, claimPatternToTerm, + getClaimPatternSort, ) where import Control.Error.Util ( @@ -63,6 +64,7 @@ import Kore.Internal.TermLike ( Modality, SomeVariable, SomeVariableName (..), + Sort, TermLike, Variable (..), VariableName, @@ -121,7 +123,7 @@ instance Pretty ClaimPattern where , "existentials:" , Pretty.indent 4 (Pretty.list $ unparse <$> existentials) , "right:" - , Pretty.indent 4 (unparse $ OrPattern.toTermLike right) + , Pretty.indent 4 (unparse $ OrPattern.toTermLike sort right) ] where ClaimPattern @@ -129,6 +131,7 @@ instance Pretty ClaimPattern where , right , existentials } = claimPattern' + sort = getClaimPatternSort claimPattern' instance TopBottom ClaimPattern where isTop _ = False @@ -137,6 +140,12 @@ instance TopBottom ClaimPattern where instance From ClaimPattern Attribute.PriorityAttributes where from = from @(Attribute.Axiom _ _) . attributes +getClaimPatternSort :: + ClaimPattern -> + Sort +getClaimPatternSort (ClaimPattern left _ _ _) = + Pattern.patternSort left + freeVariablesRight :: ClaimPattern -> FreeVariables RewritingVariableName @@ -144,10 +153,11 @@ freeVariablesRight claimPattern'@(ClaimPattern _ _ _ _) = freeVariables ( TermLike.mkExistsN existentials - (OrPattern.toTermLike right) + (OrPattern.toTermLike sort right) ) where ClaimPattern{right, existentials} = claimPattern' + sort = getClaimPatternSort claimPattern' freeVariablesLeft :: ClaimPattern -> @@ -214,7 +224,7 @@ claimPatternToTerm modality representation@(ClaimPattern _ _ _ _) = & Pattern.toTermLike & getRewritingTerm rightPattern = - TermLike.mkExistsN existentials (OrPattern.toTermLike right) + TermLike.mkExistsN existentials (OrPattern.toTermLike sort right) & getRewritingTerm substituteRight :: diff --git a/kore/src/Kore/Step/Implication.hs b/kore/src/Kore/Step/Implication.hs index 719e11e821..f973853d1c 100644 --- a/kore/src/Kore/Step/Implication.hs +++ b/kore/src/Kore/Step/Implication.hs @@ -64,6 +64,7 @@ import Kore.Internal.TermLike ( Modality, SomeVariable, SomeVariableName (..), + Sort, TermLike, Variable (..), VariableName, @@ -123,7 +124,7 @@ instance Pretty (Implication modality) where , "existentials:" , Pretty.indent 4 (Pretty.list $ unparse <$> existentials) , "right:" - , Pretty.indent 4 (unparse $ OrPattern.toTermLike right) + , Pretty.indent 4 (unparse $ rightTerm) ] where Implication @@ -131,6 +132,10 @@ instance Pretty (Implication modality) where , right , existentials } = implication' + rightTerm = + case OrPattern.tryGetSort right of + Nothing -> error "to do" + Just s -> OrPattern.toTermLike s right instance TopBottom (Implication modality) where isTop _ = False @@ -139,6 +144,11 @@ instance TopBottom (Implication modality) where instance From (Implication modality) Attribute.PriorityAttributes where from = from @(Attribute.Axiom _ _) . attributes +getImplicationSort :: + Implication modality -> + Sort +getImplicationSort (Implication left _ _ _ _) = Pattern.patternSort left + freeVariablesRight :: Implication modality -> FreeVariables RewritingVariableName @@ -146,9 +156,10 @@ freeVariablesRight implication'@(Implication _ _ _ _ _) = freeVariables ( TermLike.mkExistsN existentials - (OrPattern.toTermLike right) + (OrPattern.toTermLike sort right) ) where + sort = getImplicationSort implication' Implication{right, existentials} = implication' freeVariablesLeft :: @@ -210,14 +221,14 @@ implicationToTerm representation@(Implication _ _ _ _ _) = leftTerm = Pattern.term left & getRewritingTerm - sort = TermLike.termLikeSort leftTerm + sort = getImplicationSort representation leftCondition = Pattern.withoutTerm left & Condition.toPredicate & Predicate.fromPredicate sort & getRewritingTerm rightPattern = - TermLike.mkExistsN existentials (OrPattern.toTermLike right) + TermLike.mkExistsN existentials (OrPattern.toTermLike sort right) & getRewritingTerm substituteRight :: diff --git a/kore/src/Kore/Step/Remainder.hs b/kore/src/Kore/Step/Remainder.hs index d9b5baefa2..dfc032ec40 100644 --- a/kore/src/Kore/Step/Remainder.hs +++ b/kore/src/Kore/Step/Remainder.hs @@ -134,7 +134,7 @@ ceilChildOfApplicationOrTop sideCondition patt = case patt of App_ _ children -> do ceil <- - traverse (Ceil.makeEvaluateTerm sideCondition) children + traverse (Ceil.makeEvaluateTerm termSort sideCondition) children >>= ( AndPredicates.simplifyEvaluatedMultiPredicate sideCondition . MultiAnd.make @@ -149,3 +149,5 @@ ceilChildOfApplicationOrTop sideCondition patt = , substitution = mempty } _ -> pure Condition.top + where + termSort = termLikeSort patt diff --git a/kore/src/Kore/Step/Rule.hs b/kore/src/Kore/Step/Rule.hs index 1bc2079900..c30b45fdc2 100644 --- a/kore/src/Kore/Step/Rule.hs +++ b/kore/src/Kore/Step/Rule.hs @@ -427,9 +427,10 @@ mkEqualityAxiom lhs rhs requires = Just requires' -> TermLike.mkImplies (requires' sortR) - (TermLike.mkAnd function TermLike.mkTop_) + (TermLike.mkAnd function (TermLike.mkTop sortLHS)) Nothing -> function where + sortLHS = TermLike.termLikeSort lhs sortVariableR = SortVariable "R" sortR = SortVariableSort sortVariableR function = TermLike.mkEquals sortR lhs rhs diff --git a/kore/src/Kore/Step/Search.hs b/kore/src/Kore/Step/Search.hs index 5d4850dcab..1bfbac6414 100644 --- a/kore/src/Kore/Step/Search.hs +++ b/kore/src/Kore/Step/Search.hs @@ -35,6 +35,7 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Conditional +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.SideCondition ( SideCondition, ) @@ -132,7 +133,7 @@ matchWith :: matchWith sideCondition e1 e2 = do unifiers <- lift $ - Unifier.runUnifierT Not.notSimplifier $ + Unifier.runUnifierT (Not.notSimplifier sort) $ unificationProcedure sideCondition t1 t2 let mergeAndEvaluate :: Condition RewritingVariableName -> @@ -177,3 +178,4 @@ matchWith sideCondition e1 e2 = do where t1 = Conditional.term e1 t2 = Conditional.term e2 + sort = Pattern.patternSort e1 diff --git a/kore/src/Kore/Step/Simplification/And.hs b/kore/src/Kore/Step/Simplification/And.hs index d704576ecd..1233f34716 100644 --- a/kore/src/Kore/Step/Simplification/And.hs +++ b/kore/src/Kore/Step/Simplification/And.hs @@ -41,9 +41,10 @@ import Kore.Internal.SideCondition ( ) import Kore.Internal.TermLike ( And (..), + Sort, TermLike, mkAnd, - mkBottom_, + mkBottom, mkNot, pattern And_, pattern Not_, @@ -99,14 +100,15 @@ Also, we have -} simplify :: MonadSimplify simplifier => + Sort -> NotSimplifier (UnifierT simplifier) -> SideCondition RewritingVariableName -> MultiAnd (OrPattern RewritingVariableName) -> simplifier (OrPattern RewritingVariableName) -simplify notSimplifier sideCondition orPatterns = +simplify resultSort notSimplifier sideCondition orPatterns = OrPattern.observeAllT $ do patterns <- MultiAnd.traverse scatter orPatterns - makeEvaluate notSimplifier sideCondition patterns + makeEvaluate resultSort notSimplifier sideCondition patterns {- | 'makeEvaluate' simplifies a 'MultiAnd' of 'Pattern's. See the comment for 'simplify' to find more details. @@ -115,24 +117,26 @@ makeEvaluate :: forall simplifier. HasCallStack => MonadSimplify simplifier => + Sort -> NotSimplifier (UnifierT simplifier) -> SideCondition RewritingVariableName -> MultiAnd (Pattern RewritingVariableName) -> LogicT simplifier (Pattern RewritingVariableName) -makeEvaluate notSimplifier sideCondition patterns +makeEvaluate resultSort notSimplifier sideCondition patterns | isBottom patterns = empty - | Pattern.isTop patterns = return Pattern.top - | otherwise = makeEvaluateNonBool notSimplifier sideCondition patterns + | Pattern.isTop patterns = return (Pattern.topOf resultSort) + | otherwise = makeEvaluateNonBool resultSort notSimplifier sideCondition patterns makeEvaluateNonBool :: forall simplifier. HasCallStack => MonadSimplify simplifier => + Sort -> NotSimplifier (UnifierT simplifier) -> SideCondition RewritingVariableName -> MultiAnd (Pattern RewritingVariableName) -> LogicT simplifier (Pattern RewritingVariableName) -makeEvaluateNonBool notSimplifier sideCondition patterns = do +makeEvaluateNonBool resultSort notSimplifier sideCondition patterns = do let unify pattern1 term2 = do let (term1, condition1) = Pattern.splitTerm pattern1 unified <- termAnd notSimplifier term1 term2 @@ -140,7 +144,7 @@ makeEvaluateNonBool notSimplifier sideCondition patterns = do unified <- foldlM unify - Pattern.top + (Pattern.topOf resultSort) (term <$> toList patterns) let substitutions = Pattern.substitution unified @@ -172,8 +176,9 @@ applyAndIdempotenceAndFindContradictions :: applyAndIdempotenceAndFindContradictions patt = if noContradictions then foldl1' mkAndSimplified . Set.toList $ Set.union terms negatedTerms - else mkBottom_ + else mkBottom sort where + sort = TermLike.termLikeSort patt (terms, negatedTerms) = splitIntoTermsAndNegations patt noContradictions = Set.disjoint (Set.map mkNot terms) negatedTerms mkAndSimplified a b = diff --git a/kore/src/Kore/Step/Simplification/AndTerms.hs b/kore/src/Kore/Step/Simplification/AndTerms.hs index 4b16a95d62..d0f53706ac 100644 --- a/kore/src/Kore/Step/Simplification/AndTerms.hs +++ b/kore/src/Kore/Step/Simplification/AndTerms.hs @@ -420,32 +420,28 @@ bottomTermEquals :: TermLike RewritingVariableName -> TermLike RewritingVariableName -> unifier (Pattern RewritingVariableName) -bottomTermEquals - sideCondition - first - second = - do - -- MonadUnify - secondCeil <- makeEvaluateTermCeil sideCondition second - case toList secondCeil of - [] -> return Pattern.top - [Conditional{predicate = PredicateTrue, substitution}] - | substitution == mempty -> do - explainBottom - "Cannot unify bottom with non-bottom pattern." - first - second - empty - _ -> - return - Conditional - { term = mkTop_ - , predicate = - makeNotPredicate $ - OrCondition.toPredicate $ - OrPattern.map Condition.toPredicate secondCeil - , substitution = mempty - } +bottomTermEquals sideCondition first second = do + let sort1 = termLikeSort first + secondCeil <- makeEvaluateTermCeil sideCondition second + case toList secondCeil of + [] -> return (Pattern.topOf sort1) + [Conditional{predicate = PredicateTrue, substitution}] + | substitution == mempty -> do + explainBottom + "Cannot unify bottom with non-bottom pattern." + first + second + empty + _ -> + return + Conditional + { term = mkTop sort1 + , predicate = + makeNotPredicate $ + OrCondition.toPredicate $ + OrPattern.map Condition.toPredicate secondCeil + , substitution = mempty + } data UnifyVariables = UnifyVariables {variable1, variable2 :: !(ElementVariable RewritingVariableName)} diff --git a/kore/src/Kore/Step/Simplification/Ceil.hs b/kore/src/Kore/Step/Simplification/Ceil.hs index d9a6929c6c..f9c0bf4064 100644 --- a/kore/src/Kore/Step/Simplification/Ceil.hs +++ b/kore/src/Kore/Step/Simplification/Ceil.hs @@ -62,7 +62,6 @@ import Kore.Internal.TermLike import Kore.Rewriting.RewritingVariable ( RewritingVariableName, ) -import qualified Kore.Sort as Sort import qualified Kore.Step.Function.Evaluator as Axiom ( evaluatePattern, ) @@ -129,9 +128,11 @@ makeEvaluate :: Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) makeEvaluate sideCondition child - | Pattern.isTop child = return OrPattern.top + | Pattern.isTop child = return (OrPattern.top childSort) | Pattern.isBottom child = return OrPattern.bottom | otherwise = makeEvaluateNonBoolCeil sideCondition child + where + childSort = Pattern.patternSort child makeEvaluateNonBoolCeil :: MonadSimplify simplifier => @@ -142,9 +143,9 @@ makeEvaluateNonBoolCeil sideCondition patt@Conditional{term} | isTop term = return $ OrPattern.fromPattern - patt{term = mkTop_} -- erase the term's sort. + patt{term = mkTop pattSort} | otherwise = do - termCeil <- makeEvaluateTerm sideCondition term + termCeil <- makeEvaluateTerm pattSort sideCondition term result <- And.simplifyEvaluatedMultiPredicate sideCondition @@ -153,7 +154,9 @@ makeEvaluateNonBoolCeil sideCondition patt@Conditional{term} , termCeil ] ) - return (OrPattern.map Pattern.fromCondition_ result) + return (OrPattern.map (Pattern.fromCondition pattSort) result) + where + pattSort = Pattern.patternSort patt -- TODO: Ceil(function) should be an and of all the function's conditions, both -- implicit and explicit. @@ -162,15 +165,16 @@ makeEvaluateNonBoolCeil sideCondition patt@Conditional{term} makeEvaluateTerm :: forall simplifier. MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> TermLike RewritingVariableName -> simplifier (OrCondition RewritingVariableName) -makeEvaluateTerm sideCondition ceilChild = +makeEvaluateTerm resultSort sideCondition ceilChild = runCeilSimplifierWith ceilSimplifier sideCondition Ceil - { ceilResultSort = Sort.predicateSort + { ceilResultSort = resultSort , ceilOperandSort = termLikeSort ceilChild , ceilChild } @@ -185,7 +189,7 @@ makeEvaluateTerm sideCondition ceilChild = -- \ceil conditions are reduced to Bool expressions using in_keys. newAxiomCeilSimplifier , newApplicationCeilSimplifier - , newBuiltinCeilSimplifier + , newBuiltinCeilSimplifier resultSort , newInjCeilSimplifier ] @@ -257,21 +261,22 @@ newInjCeilSimplifier = CeilSimplifier $ \input -> newBuiltinCeilSimplifier :: MonadReader (SideCondition RewritingVariableName) simplifier => MonadSimplify simplifier => + Sort -> CeilSimplifier simplifier (TermLike RewritingVariableName) (OrCondition RewritingVariableName) -newBuiltinCeilSimplifier = CeilSimplifier $ \input -> +newBuiltinCeilSimplifier ceilSort = CeilSimplifier $ \input -> case ceilChild input of InternalList_ internal -> do sideCondition <- Reader.ask - makeEvaluateInternalList sideCondition internal + makeEvaluateInternalList ceilSort sideCondition internal InternalMap_ internalMap -> do sideCondition <- Reader.ask - makeEvaluateInternalMap sideCondition internalMap + makeEvaluateInternalMap ceilSort sideCondition internalMap InternalSet_ internalSet -> do sideCondition <- Reader.ask - makeEvaluateInternalSet sideCondition internalSet + makeEvaluateInternalSet ceilSort sideCondition internalSet _ -> empty newAxiomCeilSimplifier :: @@ -307,15 +312,16 @@ newAxiomCeilSimplifier = CeilSimplifier $ \input -> do makeEvaluateInternalMap :: forall simplifier. MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> InternalMap Key (TermLike RewritingVariableName) -> MaybeT simplifier (OrCondition RewritingVariableName) -makeEvaluateInternalMap sideCondition internalMap = +makeEvaluateInternalMap resultSort sideCondition internalMap = runCeilSimplifierWith AssocComm.newMapCeilSimplifier sideCondition Ceil - { ceilResultSort = Sort.predicateSort + { ceilResultSort = resultSort , ceilOperandSort = builtinAcSort , ceilChild = internalMap } @@ -326,15 +332,16 @@ makeEvaluateInternalMap sideCondition internalMap = makeEvaluateInternalSet :: forall simplifier. MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> InternalSet Key (TermLike RewritingVariableName) -> MaybeT simplifier (OrCondition RewritingVariableName) -makeEvaluateInternalSet sideCondition internalSet = +makeEvaluateInternalSet resultSort sideCondition internalSet = runCeilSimplifierWith AssocComm.newSetCeilSimplifier sideCondition Ceil - { ceilResultSort = Sort.predicateSort + { ceilResultSort = resultSort , ceilOperandSort = builtinAcSort , ceilChild = internalSet } @@ -344,11 +351,12 @@ makeEvaluateInternalSet sideCondition internalSet = makeEvaluateInternalList :: forall simplifier. MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> InternalList (TermLike RewritingVariableName) -> simplifier (OrCondition RewritingVariableName) -makeEvaluateInternalList sideCondition internal = do - children <- mapM (makeEvaluateTerm sideCondition) (toList internal) +makeEvaluateInternalList listSort sideCondition internal = do + children <- mapM (makeEvaluateTerm listSort sideCondition) (toList internal) let ceils :: [OrCondition RewritingVariableName] ceils = children And.simplifyEvaluatedMultiPredicate sideCondition (MultiAnd.make ceils) @@ -379,12 +387,13 @@ makeSimplifiedCeil do childCeils <- if needsChildCeils - then mapM (makeEvaluateTerm sideCondition) (toList termLikeF) + then mapM (makeEvaluateTerm ceilSort sideCondition) (toList termLikeF) else return [] And.simplifyEvaluatedMultiPredicate sideCondition (MultiAnd.make (unsimplified : childCeils)) where + ceilSort = termLikeSort termLike needsChildCeils = case termLikeF of ApplyAliasF _ -> False EndiannessF _ -> True diff --git a/kore/src/Kore/Step/Simplification/Equals.hs b/kore/src/Kore/Step/Simplification/Equals.hs index 14f0786592..625501156d 100644 --- a/kore/src/Kore/Step/Simplification/Equals.hs +++ b/kore/src/Kore/Step/Simplification/Equals.hs @@ -161,11 +161,17 @@ simplify :: SideCondition RewritingVariableName -> Equals Sort (OrPattern RewritingVariableName) -> simplifier (OrPattern RewritingVariableName) -simplify sideCondition Equals{equalsFirst = first, equalsSecond = second} = - simplifyEvaluated sideCondition first' second' - where - (first', second') = - minMaxBy (on compareForEquals OrPattern.toTermLike) first second +simplify + sideCondition + Equals + { equalsFirst = first + , equalsSecond = second + , equalsOperandSort = sort + , equalsResultSort = resultSort + } = simplifyEvaluated resultSort sideCondition first' second' + where + (first', second') = + minMaxBy (on compareForEquals (OrPattern.toTermLike sort)) first second {- TODO (virgil): Preserve pattern sorts under simplification. @@ -182,12 +188,13 @@ carry around. -} simplifyEvaluated :: MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> OrPattern RewritingVariableName -> OrPattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -simplifyEvaluated sideCondition first second - | first == second = return OrPattern.top +simplifyEvaluated sort sideCondition first second + | first == second = return (OrPattern.top sort) -- TODO: Maybe simplify equalities with top and bottom to ceil and floor | otherwise = do let isFunctionConditional Conditional{term} = isFunctionPattern term @@ -202,11 +209,11 @@ simplifyEvaluated sideCondition first second makeEvaluateFunctionalOr sideCondition secondP firstPatterns _ | OrPattern.isPredicate first && OrPattern.isPredicate second -> - Iff.simplifyEvaluated sideCondition first second + Iff.simplifyEvaluated sort sideCondition first second | otherwise -> makeEvaluate - (OrPattern.toPattern first) - (OrPattern.toPattern second) + (OrPattern.toPattern sort first) + (OrPattern.toPattern sort second) sideCondition where firstPatterns = toList first @@ -220,34 +227,37 @@ makeEvaluateFunctionalOr :: [Pattern RewritingVariableName] -> simplifier (OrPattern RewritingVariableName) makeEvaluateFunctionalOr sideCondition first seconds = do - firstCeil <- makeEvaluateCeil sideCondition first - secondCeilsWithProofs <- mapM (makeEvaluateCeil sideCondition) seconds - firstNotCeil <- Not.simplifyEvaluated sideCondition firstCeil + let sort = Pattern.patternSort first + firstCeil <- makeEvaluateCeil sort sideCondition first + secondCeilsWithProofs <- mapM (makeEvaluateCeil sort sideCondition) seconds + firstNotCeil <- Not.simplifyEvaluated sort sideCondition firstCeil let secondCeils = secondCeilsWithProofs - secondNotCeils <- traverse (Not.simplifyEvaluated sideCondition) secondCeils + secondNotCeils <- traverse (Not.simplifyEvaluated sort sideCondition) secondCeils let oneNotBottom = foldl' Or.simplifyEvaluated OrPattern.bottom secondCeils allAreBottom <- And.simplify - Not.notSimplifier + sort + (Not.notSimplifier sort) sideCondition (MultiAnd.make (firstNotCeil : secondNotCeils)) firstEqualsSeconds <- mapM - (makeEvaluateEqualsIfSecondNotBottom first) + (makeEvaluateEqualsIfSecondNotBottom sort first) (zip seconds secondCeils) oneIsNotBottomEquals <- - And.simplify - Not.notSimplifier + (And.simplify sort) + (Not.notSimplifier sort) sideCondition (MultiAnd.make (firstCeil : oneNotBottom : firstEqualsSeconds)) return (MultiOr.merge allAreBottom oneIsNotBottomEquals) where makeEvaluateEqualsIfSecondNotBottom + sort Conditional{term = firstTerm} (Conditional{term = secondTerm}, secondCeil) = do equality <- makeEvaluateTermsAssumesNoBottom firstTerm secondTerm - Implies.simplifyEvaluated sideCondition secondCeil equality + Implies.simplifyEvaluated sort sideCondition secondCeil equality {- | evaluates an 'Equals' given its two 'Pattern' children. @@ -260,13 +270,13 @@ makeEvaluate :: SideCondition RewritingVariableName -> simplifier (OrPattern RewritingVariableName) makeEvaluate - first@Conditional{term = Top_ _} + first@Conditional{term = Top_ sort} second@Conditional{term = Top_ _} _ = return ( Iff.makeEvaluate - first{term = mkTop_} -- remove the term's sort - second{term = mkTop_} -- remove the term's sort + first{term = mkTop sort} -- remove the term's sort + second{term = mkTop sort} -- remove the term's sort ) makeEvaluate Conditional @@ -281,32 +291,35 @@ makeEvaluate } sideCondition = do + let sort = termLikeSort firstTerm result <- makeEvaluateTermsToPredicate firstTerm secondTerm sideCondition - return (MultiOr.map Pattern.fromCondition_ result) + return (MultiOr.map (Pattern.fromCondition sort) result) makeEvaluate first@Conditional{term = firstTerm} second@Conditional{term = secondTerm} sideCondition = do - let first' = first{term = if termsAreEqual then mkTop_ else firstTerm} - firstCeil <- makeEvaluateCeil sideCondition first' - let second' = second{term = if termsAreEqual then mkTop_ else secondTerm} - secondCeil <- makeEvaluateCeil sideCondition second' - firstCeilNegation <- Not.simplifyEvaluated sideCondition firstCeil - secondCeilNegation <- Not.simplifyEvaluated sideCondition secondCeil + let termSort = termLikeSort firstTerm + let first' = first{term = if termsAreEqual then mkTop termSort else firstTerm} + firstCeil <- makeEvaluateCeil sort sideCondition first' + let second' = second{term = if termsAreEqual then mkTop termSort else secondTerm} + secondCeil <- makeEvaluateCeil sort sideCondition second' + firstCeilNegation <- Not.simplifyEvaluated sort sideCondition firstCeil + secondCeilNegation <- Not.simplifyEvaluated sort sideCondition secondCeil termEquality <- makeEvaluateTermsAssumesNoBottom firstTerm secondTerm negationAnd <- - And.simplify - Not.notSimplifier + (And.simplify sort) + (Not.notSimplifier sort) sideCondition (MultiAnd.make [firstCeilNegation, secondCeilNegation]) equalityAnd <- - And.simplify - Not.notSimplifier + (And.simplify sort) + (Not.notSimplifier sort) sideCondition (MultiAnd.make [termEquality, firstCeil, secondCeil]) return $ Or.simplifyEvaluated equalityAnd negationAnd where + sort = termLikeSort firstTerm termsAreEqual = firstTerm == secondTerm -- Do not export this. This not valid as a standalone function, it @@ -322,10 +335,11 @@ makeEvaluateTermsAssumesNoBottom firstTerm secondTerm = do makeEvaluateTermsAssumesNoBottomMaybe firstTerm secondTerm (return . fromMaybe def) result where + sort = termLikeSort firstTerm def = OrPattern.fromPattern Conditional - { term = mkTop_ + { term = mkTop sort , predicate = Predicate.markSimplified $ makeEqualsPredicate firstTerm secondTerm @@ -342,7 +356,8 @@ makeEvaluateTermsAssumesNoBottomMaybe :: MaybeT simplifier (OrPattern RewritingVariableName) makeEvaluateTermsAssumesNoBottomMaybe first second = do result <- termEquals first second - return (MultiOr.map Pattern.fromCondition_ result) + let sort = termLikeSort first + return (MultiOr.map (Pattern.fromCondition sort) result) {- | Combines two terms with 'Equals' into a predicate-substitution. @@ -415,8 +430,9 @@ termEqualsAnd :: termEqualsAnd p1 p2 = MaybeT $ run $ maybeTermEqualsWorker p1 p2 where + termSort = termLikeSort p1 run it = - (runUnifierT Not.notSimplifier . runMaybeT) it + (runUnifierT (Not.notSimplifier termSort) . runMaybeT) it >>= Logic.scatter maybeTermEqualsWorker :: @@ -426,7 +442,7 @@ termEqualsAnd p1 p2 = TermLike RewritingVariableName -> MaybeT unifier (Pattern RewritingVariableName) maybeTermEqualsWorker = - maybeTermEquals Not.notSimplifier termEqualsAndWorker + maybeTermEquals (Not.notSimplifier termSort) termEqualsAndWorker termEqualsAndWorker :: forall unifier. @@ -438,7 +454,7 @@ termEqualsAnd p1 p2 = scatterResults =<< runUnification (maybeTermEqualsWorker first second) where - runUnification = runUnifierT Not.notSimplifier . runMaybeT + runUnification = runUnifierT (Not.notSimplifier termSort) . runMaybeT scatterResults = maybe (return equalsPattern) -- default if no results diff --git a/kore/src/Kore/Step/Simplification/Floor.hs b/kore/src/Kore/Step/Simplification/Floor.hs index d703ec4a6f..1272d184f0 100644 --- a/kore/src/Kore/Step/Simplification/Floor.hs +++ b/kore/src/Kore/Step/Simplification/Floor.hs @@ -44,8 +44,8 @@ floor(a and b) = floor(a) and floor(b). simplify :: Floor Sort (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName -simplify Floor{floorChild = child} = - simplifyEvaluatedFloor child +simplify Floor{floorResultSort = resultSort, floorChild = child} = + simplifyEvaluatedFloor resultSort child {- TODO (virgil): Preserve pattern sorts under simplification. @@ -61,35 +61,38 @@ to carry around. -} simplifyEvaluatedFloor :: + Sort -> OrPattern RewritingVariableName -> OrPattern RewritingVariableName -simplifyEvaluatedFloor child = +simplifyEvaluatedFloor resultSort child = case toList child of - [childP] -> makeEvaluateFloor childP - _ -> makeEvaluateFloor (OrPattern.toPattern child) + [childP] -> makeEvaluateFloor resultSort childP + _ -> makeEvaluateFloor resultSort (OrPattern.toPattern resultSort child) {- | 'makeEvaluateFloor' simplifies a 'Floor' of 'Pattern'. See 'simplify' for details. -} makeEvaluateFloor :: + Sort -> Pattern RewritingVariableName -> OrPattern RewritingVariableName -makeEvaluateFloor child - | Pattern.isTop child = OrPattern.top +makeEvaluateFloor resultSort child + | Pattern.isTop child = OrPattern.top resultSort | Pattern.isBottom child = OrPattern.bottom - | otherwise = makeEvaluateNonBoolFloor child + | otherwise = makeEvaluateNonBoolFloor resultSort child makeEvaluateNonBoolFloor :: + Sort -> Pattern RewritingVariableName -> OrPattern RewritingVariableName -makeEvaluateNonBoolFloor patt@Conditional{term = Top_ _} = - OrPattern.fromPattern patt{term = mkTop_} -- remove the term's sort +makeEvaluateNonBoolFloor resultSort patt@Conditional{term = Top_ _} = + OrPattern.fromPattern patt{term = mkTop resultSort} -- remove the term's sort -- TODO(virgil): Also evaluate functional patterns to bottom for non-singleton -- sorts, and maybe other cases also -makeEvaluateNonBoolFloor patt = +makeEvaluateNonBoolFloor resultSort patt = floorCondition <> condition - & Pattern.fromCondition_ + & (Pattern.fromCondition resultSort) & OrPattern.fromPattern where (term, condition) = Pattern.splitTerm patt diff --git a/kore/src/Kore/Step/Simplification/Forall.hs b/kore/src/Kore/Step/Simplification/Forall.hs index 6805c5d5da..0579e04500 100644 --- a/kore/src/Kore/Step/Simplification/Forall.hs +++ b/kore/src/Kore/Step/Simplification/Forall.hs @@ -29,13 +29,16 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Pattern ( - bottom, + -- bottom, + bottomOf, fromTermLike, isBottom, isTop, + patternSort, + -- top, splitTerm, toTermLike, - top, + topOf, ) import Kore.Internal.Predicate ( makeForallPredicate, @@ -115,8 +118,8 @@ makeEvaluate :: Pattern RewritingVariableName -> Pattern RewritingVariableName makeEvaluate variable patt - | Pattern.isTop patt = Pattern.top - | Pattern.isBottom patt = Pattern.bottom + | Pattern.isTop patt = Pattern.topOf sort + | Pattern.isBottom patt = Pattern.bottomOf sort | not variableInTerm && not variableInCondition = patt | predicateIsBoolean = TermLike.markSimplified (mkForall variable term) @@ -133,6 +136,7 @@ makeEvaluate variable patt mkForall variable $ Pattern.toTermLike patt where + sort = Pattern.patternSort patt (term, predicate) = Pattern.splitTerm patt someVariable = mkSomeVariable variable someVariableName = variableName someVariable diff --git a/kore/src/Kore/Step/Simplification/Iff.hs b/kore/src/Kore/Step/Simplification/Iff.hs index f9356fb4ef..f382397884 100644 --- a/kore/src/Kore/Step/Simplification/Iff.hs +++ b/kore/src/Kore/Step/Simplification/Iff.hs @@ -56,8 +56,8 @@ simplify :: SideCondition RewritingVariableName -> Iff Sort (OrPattern RewritingVariableName) -> simplifier (OrPattern RewritingVariableName) -simplify sideCondition Iff{iffFirst = first, iffSecond = second} = - simplifyEvaluated sideCondition first second +simplify sideCondition Iff{iffFirst = first, iffSecond = second, iffSort = sort} = + simplifyEvaluated sort sideCondition first second {- | evaluates an 'Iff' given its two 'OrPattern' children. @@ -79,30 +79,29 @@ carry around. -} simplifyEvaluated :: MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> OrPattern RewritingVariableName -> OrPattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -simplifyEvaluated - sideCondition - first - second - | OrPattern.isTrue first = return second - | OrPattern.isFalse first = Not.simplifyEvaluated sideCondition second - | OrPattern.isTrue second = return first - | OrPattern.isFalse second = Not.simplifyEvaluated sideCondition first - | otherwise = case (firstPatterns, secondPatterns) of - ([firstP], [secondP]) -> return $ makeEvaluate firstP secondP - _ -> do - fwd <- Implies.simplifyEvaluated sideCondition first second - bwd <- Implies.simplifyEvaluated sideCondition second first - And.simplify - Not.notSimplifier - sideCondition - (MultiAnd.make [fwd, bwd]) - where - firstPatterns = toList first - secondPatterns = toList second +simplifyEvaluated sort sideCondition first second + | OrPattern.isTrue first = return second + | OrPattern.isFalse first = Not.simplifyEvaluated sort sideCondition second + | OrPattern.isTrue second = return first + | OrPattern.isFalse second = Not.simplifyEvaluated sort sideCondition first + | otherwise = case (firstPatterns, secondPatterns) of + ([firstP], [secondP]) -> return $ makeEvaluate firstP secondP + _ -> do + fwd <- Implies.simplifyEvaluated sort sideCondition first second + bwd <- Implies.simplifyEvaluated sort sideCondition second first + And.simplify + sort + (Not.notSimplifier sort) + sideCondition + (MultiAnd.make [fwd, bwd]) + where + firstPatterns = toList first + secondPatterns = toList second {- | evaluates an 'Iff' given its two 'Pattern' children. diff --git a/kore/src/Kore/Step/Simplification/Implies.hs b/kore/src/Kore/Step/Simplification/Implies.hs index b1c4f042f0..e7677c75eb 100644 --- a/kore/src/Kore/Step/Simplification/Implies.hs +++ b/kore/src/Kore/Step/Simplification/Implies.hs @@ -60,8 +60,8 @@ simplify :: simplifier (OrPattern RewritingVariableName) simplify sideCondition - Implies{impliesFirst = first, impliesSecond = second} = - simplifyEvaluated sideCondition first second + Implies{impliesFirst = first, impliesSecond = second, impliesSort = sort} = + simplifyEvaluated sort sideCondition first second {- | simplifies an Implies given its two 'OrPattern' children. @@ -84,35 +84,38 @@ carry around. -} simplifyEvaluated :: MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> OrPattern RewritingVariableName -> OrPattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -simplifyEvaluated sideCondition first second +simplifyEvaluated sort sideCondition first second | OrPattern.isTrue first = return second - | OrPattern.isFalse first = return OrPattern.top - | OrPattern.isTrue second = return OrPattern.top - | OrPattern.isFalse second = Not.simplifyEvaluated sideCondition first + | OrPattern.isFalse first = return (OrPattern.top sort) + | OrPattern.isTrue second = return (OrPattern.top sort) + | OrPattern.isFalse second = Not.simplifyEvaluated sort sideCondition first | otherwise = OrPattern.observeAllT $ Logic.scatter second - >>= simplifyEvaluateHalfImplies sideCondition first + >>= simplifyEvaluateHalfImplies sort sideCondition first simplifyEvaluateHalfImplies :: MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> OrPattern RewritingVariableName -> Pattern RewritingVariableName -> LogicT simplifier (Pattern RewritingVariableName) simplifyEvaluateHalfImplies + sort sideCondition first second | OrPattern.isTrue first = return second - | OrPattern.isFalse first = return Pattern.top - | Pattern.isTop second = return Pattern.top + | OrPattern.isFalse first = return (Pattern.topOf sort) + | Pattern.isTop second = return (Pattern.topOf sort) | Pattern.isBottom second = - Not.simplifyEvaluated sideCondition first + Not.simplifyEvaluated sort sideCondition first >>= Logic.scatter | otherwise = case toList first of @@ -129,10 +132,12 @@ distributeEvaluateImplies :: simplifier (OrPattern RewritingVariableName) distributeEvaluateImplies sideCondition firsts second = And.simplify - Not.notSimplifier + sort + (Not.notSimplifier sort) sideCondition (MultiAnd.make implications) where + sort = Pattern.patternSort second implications = map (\first -> makeEvaluateImplies first second) firsts makeEvaluateImplies :: @@ -145,13 +150,15 @@ makeEvaluateImplies | Pattern.isTop first = OrPattern.fromPatterns [second] | Pattern.isBottom first = - OrPattern.fromPatterns [Pattern.top] + OrPattern.fromPatterns [Pattern.topOf sort] | Pattern.isTop second = - OrPattern.fromPatterns [Pattern.top] + OrPattern.fromPatterns [Pattern.topOf sort] | Pattern.isBottom second = Not.makeEvaluate first | otherwise = makeEvaluateImpliesNonBool first second + where + sort = Pattern.patternSort first makeEvaluateImpliesNonBool :: Pattern RewritingVariableName -> diff --git a/kore/src/Kore/Step/Simplification/In.hs b/kore/src/Kore/Step/Simplification/In.hs index 9e3188f7b1..2a831faec2 100644 --- a/kore/src/Kore/Step/Simplification/In.hs +++ b/kore/src/Kore/Step/Simplification/In.hs @@ -98,9 +98,11 @@ makeEvaluateIn sideCondition first second | Pattern.isTop second = Ceil.makeEvaluate sideCondition first | Pattern.isBottom first || Pattern.isBottom second = return OrPattern.bottom | otherwise = - And.makeEvaluate - Not.notSimplifier + (And.makeEvaluate pattSort) + (Not.notSimplifier pattSort) sideCondition (MultiAnd.make [first, second]) & OrPattern.observeAllT >>= Ceil.simplifyEvaluated sideCondition + where + pattSort = patternSort first diff --git a/kore/src/Kore/Step/Simplification/InternalMap.hs b/kore/src/Kore/Step/Simplification/InternalMap.hs index de6a9cd95e..a48152d328 100644 --- a/kore/src/Kore/Step/Simplification/InternalMap.hs +++ b/kore/src/Kore/Step/Simplification/InternalMap.hs @@ -25,19 +25,21 @@ import Prelude.Kore -- | Simplify an 'InternalMap' pattern. simplify :: + Sort -> InternalMap Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName -simplify = +simplify sort = traverse (Logic.scatter >>> Compose) - >>> fmap (normalizeInternalMap >>> markSimplified) + >>> fmap (normalizeInternalMap sort >>> markSimplified) >>> getCompose >>> fmap Pattern.syncSort >>> MultiOr.observeAll normalizeInternalMap :: + Sort -> InternalMap Key (TermLike RewritingVariableName) -> TermLike RewritingVariableName -normalizeInternalMap map' = +normalizeInternalMap sort map' = case Lens.traverseOf (field @"builtinAcChild") Builtin.renormalize map' of Just normalizedMap -> -- If the InternalMap consists of a single compound, remove the @@ -45,7 +47,7 @@ normalizeInternalMap map' = getSingleOpaque normalizedMap -- Otherwise, inject the InternalMap into TermLike. & fromMaybe (mkInternalMap normalizedMap) - _ -> mkBottom_ + _ -> mkBottom sort where getSingleOpaque = asSingleOpaqueElem . getNormalizedAc getNormalizedAc = getNormalizedMap . builtinAcChild diff --git a/kore/src/Kore/Step/Simplification/InternalSet.hs b/kore/src/Kore/Step/Simplification/InternalSet.hs index 8680970dce..8df09b1598 100644 --- a/kore/src/Kore/Step/Simplification/InternalSet.hs +++ b/kore/src/Kore/Step/Simplification/InternalSet.hs @@ -25,19 +25,21 @@ import Prelude.Kore -- | Simplify an 'InternalMap' pattern. simplify :: + Sort -> InternalSet Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName -simplify = +simplify sort = traverse (Logic.scatter >>> Compose) - >>> fmap (normalizeInternalSet >>> markSimplified) + >>> fmap (normalizeInternalSet sort >>> markSimplified) >>> getCompose >>> fmap Pattern.syncSort >>> MultiOr.observeAll normalizeInternalSet :: + Sort -> InternalSet Key (TermLike RewritingVariableName) -> TermLike RewritingVariableName -normalizeInternalSet map' = +normalizeInternalSet returnSort map' = case Lens.traverseOf (field @"builtinAcChild") Builtin.renormalize map' of Just normalizedSet -> -- If the InternalSet consists of a single compound, remove the @@ -45,7 +47,7 @@ normalizeInternalSet map' = getSingleOpaque normalizedSet -- Otherwise, inject the InternalSet into TermLike. & fromMaybe (mkInternalSet normalizedSet) - _ -> mkBottom_ + _ -> mkBottom returnSort where getSingleOpaque = asSingleOpaqueElem . getNormalizedAc getNormalizedAc = getNormalizedSet . builtinAcChild diff --git a/kore/src/Kore/Step/Simplification/Not.hs b/kore/src/Kore/Step/Simplification/Not.hs index 31366a2b11..2a2100c581 100644 --- a/kore/src/Kore/Step/Simplification/Not.hs +++ b/kore/src/Kore/Step/Simplification/Not.hs @@ -55,6 +55,7 @@ import qualified Kore.Internal.Substitution as Substitution import Kore.Internal.TermLike import qualified Kore.Internal.TermLike as TermLike ( markSimplified, + termLikeSort, ) import Kore.Rewriting.RewritingVariable ( RewritingVariableName, @@ -81,8 +82,10 @@ simplify :: SideCondition RewritingVariableName -> Not Sort (OrPattern RewritingVariableName) -> simplifier (OrPattern RewritingVariableName) -simplify sideCondition Not{notChild} = - simplifyEvaluated sideCondition notChild +simplify sideCondition Not{notChild, notSort} = + simplifyEvaluated sort sideCondition notChild + where + sort = notSort {- |'simplifyEvaluated' simplifies a 'Not' pattern given its 'OrPattern' child. @@ -105,15 +108,16 @@ to carry around. -} simplifyEvaluated :: MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> OrPattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -simplifyEvaluated sideCondition simplified = +simplifyEvaluated resultSort sideCondition simplified = OrPattern.observeAllT $ do let not' = Not{notChild = simplified, notSort = ()} andPattern <- scatterAnd (MultiAnd.map makeEvaluateNot (distributeNot not')) - mkMultiAndPattern sideCondition andPattern + mkMultiAndPattern resultSort sideCondition andPattern simplifyEvaluatedPredicate :: MonadSimplify simplifier => @@ -198,9 +202,11 @@ makeTermNot (Not_ _ term) = MultiOr.singleton term makeTermNot (And_ _ term1 term2) = MultiOr.merge (makeTermNot term1) (makeTermNot term2) makeTermNot term - | isBottom term = MultiOr.singleton mkTop_ - | isTop term = MultiOr.singleton mkBottom_ + | isBottom term = MultiOr.singleton (mkTop sort) + | isTop term = MultiOr.singleton (mkBottom sort) | otherwise = MultiOr.singleton $ TermLike.markSimplified $ mkNot term + where + sort = TermLike.termLikeSort term -- | Distribute 'Not' over 'MultiOr' using de Morgan's identity. distributeNot :: @@ -223,10 +229,11 @@ scatterAnd = scatter . MultiAnd.distributeAnd -- | Conjoin and simplify a 'MultiAnd' of 'Pattern'. mkMultiAndPattern :: MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> MultiAnd (Pattern RewritingVariableName) -> LogicT simplifier (Pattern RewritingVariableName) -mkMultiAndPattern = And.makeEvaluate notSimplifier +mkMultiAndPattern resultSort = And.makeEvaluate resultSort (notSimplifier resultSort) -- | Conjoin and simplify a 'MultiAnd' of 'Condition'. mkMultiAndPredicate :: @@ -239,6 +246,7 @@ mkMultiAndPredicate predicates = notSimplifier :: MonadSimplify simplifier => + Sort -> NotSimplifier simplifier -notSimplifier = - NotSimplifier simplifyEvaluated +notSimplifier sort = + NotSimplifier (simplifyEvaluated sort) diff --git a/kore/src/Kore/Step/Simplification/Rewrites.hs b/kore/src/Kore/Step/Simplification/Rewrites.hs new file mode 100644 index 0000000000..c718b9c353 --- /dev/null +++ b/kore/src/Kore/Step/Simplification/Rewrites.hs @@ -0,0 +1,78 @@ +{- | +Module : Kore.Step.Simplification.Rewrites +Description : Tools for Rewrites pattern simplification. +Copyright : (c) Runtime Verification, 2018 +License : NCSA +Maintainer : virgil.serbanuta@runtimeverification.com +Stability : experimental +Portability : portable +-} +module Kore.Step.Simplification.Rewrites ( + simplify, +) where + +import Kore.Internal.OrPattern ( + OrPattern, + ) +import qualified Kore.Internal.OrPattern as OrPattern +import Kore.Internal.Pattern as Pattern +import Kore.Internal.TermLike +import qualified Kore.Internal.TermLike as TermLike ( + markSimplified, + ) +import Kore.Rewriting.RewritingVariable ( + RewritingVariableName, + ) +import Prelude.Kore + +{- | Simplify a 'Rewrites' pattern with a 'OrPattern' child. + +Right now this does not do any actual simplification. + +TODO(virgil): Should I even bother to simplify Rewrites? Maybe to implies+next? +-} +simplify :: + Sort -> + Rewrites Sort (OrPattern RewritingVariableName) -> + OrPattern RewritingVariableName +simplify + sort + Rewrites + { rewritesFirst = first + , rewritesSecond = second + } = + simplifyEvaluatedRewrites sort first second + +{- TODO (virgil): Preserve pattern sorts under simplification. + +One way to preserve the required sort annotations is to make +'simplifyEvaluatedRewrites' take an argument of type + +> CofreeF (Or Sort) (Attribute.Pattern variable) (OrPattern variable) + +instead of two 'OrPattern' arguments. The type of +'makeEvaluateRewrites' may be changed analogously. The 'Attribute.Pattern' +annotation will eventually cache information besides the pattern sort, which +will make it even more useful to carry around. + +-} +simplifyEvaluatedRewrites :: + Sort -> + OrPattern RewritingVariableName -> + OrPattern RewritingVariableName -> + OrPattern RewritingVariableName +simplifyEvaluatedRewrites sort first second = + makeEvaluateRewrites + (OrPattern.toPattern sort first) + (OrPattern.toPattern sort second) + +makeEvaluateRewrites :: + Pattern RewritingVariableName -> + Pattern RewritingVariableName -> + OrPattern RewritingVariableName +makeEvaluateRewrites first second = + OrPattern.fromTermLike $ + TermLike.markSimplified $ + mkRewrites + (Pattern.toTermLike first) + (Pattern.toTermLike second) diff --git a/kore/src/Kore/Step/Simplification/Simplify.hs b/kore/src/Kore/Step/Simplification/Simplify.hs index e212d40050..576e96b219 100644 --- a/kore/src/Kore/Step/Simplification/Simplify.hs +++ b/kore/src/Kore/Step/Simplification/Simplify.hs @@ -94,6 +94,7 @@ import qualified Kore.Internal.SideCondition.SideCondition as SideCondition ( ) import Kore.Internal.Symbol import Kore.Internal.TermLike ( + Sort, TermAttributes, TermLike, TermLikeF (..), @@ -557,16 +558,17 @@ makeEvaluateTermCeil sideCondition child = makeEvaluateCeil :: MonadSimplify simplifier => + Sort -> SideCondition RewritingVariableName -> Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) -makeEvaluateCeil sideCondition child = +makeEvaluateCeil sort sideCondition child = do let (childTerm, childCondition) = Pattern.splitTerm child ceilCondition <- Predicate.makeCeilPredicate childTerm & Condition.fromPredicate & simplifyCondition sideCondition - Pattern.andCondition Pattern.top (ceilCondition <> childCondition) + Pattern.andCondition (Pattern.topOf sort) (ceilCondition <> childCondition) & pure & OrPattern.observeAllT diff --git a/kore/src/Kore/Step/Simplification/SubstitutionSimplifier.hs b/kore/src/Kore/Step/Simplification/SubstitutionSimplifier.hs index fe0ef349d0..48625bf330 100644 --- a/kore/src/Kore/Step/Simplification/SubstitutionSimplifier.hs +++ b/kore/src/Kore/Step/Simplification/SubstitutionSimplifier.hs @@ -165,8 +165,10 @@ simplifyAnds :: NonEmpty (TermLike RewritingVariableName) -> monad (Pattern RewritingVariableName) simplifyAnds MakeAnd{makeAnd} sideCondition (NonEmpty.sort -> patterns) = - foldM simplifyAnds' Pattern.top patterns + foldM simplifyAnds' (Pattern.topOf resultSort) patterns where + resultSort :: TermLike.Sort + resultSort = TermLike.termLikeSort (NonEmpty.head patterns) simplifyAnds' :: Pattern RewritingVariableName -> TermLike RewritingVariableName -> diff --git a/kore/src/Kore/Step/Simplification/TermLike.hs b/kore/src/Kore/Step/Simplification/TermLike.hs index 3c5a6ced84..c37dfea701 100644 --- a/kore/src/Kore/Step/Simplification/TermLike.hs +++ b/kore/src/Kore/Step/Simplification/TermLike.hs @@ -330,12 +330,13 @@ simplify sideCondition = \termLike -> , resultPredicate == condition = return $ OrPattern.fromPattern $ - Pattern.fromCondition_ $ + Pattern.fromCondition resultSort $ Condition.markPredicateSimplifiedConditional sideConditionRepresentation resultPredicate | otherwise = continuation where + resultSort = Pattern.patternSort result (resultTerm, resultPredicate) = Pattern.splitTerm result resultSubstitutionIsEmpty = case resultPredicate of @@ -356,6 +357,7 @@ simplify sideCondition = \termLike -> refreshElementBinder = TermLike.refreshElementBinder avoiding refreshSetBinder = TermLike.refreshSetBinder avoiding (_ :< termLikeF) = Recursive.project termLike + termSort = termLikeSort termLike in case termLikeF of -- Unimplemented cases ApplyAliasF _ -> doNotSimplify @@ -367,7 +369,7 @@ simplify sideCondition = \termLike -> -- AndF andF -> do let conjuncts = foldMap MultiAnd.fromTermLike andF - And.simplify Not.notSimplifier sideCondition + (And.simplify termSort) (Not.notSimplifier termSort) sideCondition =<< MultiAnd.traverse (simplifyTermLike sideCondition) conjuncts @@ -400,9 +402,9 @@ simplify sideCondition = \termLike -> InternalListF internalF -> InternalList.simplify <$> simplifyChildren internalF InternalMapF internalMapF -> - InternalMap.simplify <$> simplifyChildren internalMapF + (InternalMap.simplify termSort) <$> simplifyChildren internalMapF InternalSetF internalSetF -> - InternalSet.simplify <$> simplifyChildren internalSetF + (InternalSet.simplify termSort) <$> simplifyChildren internalSetF DomainValueF domainValueF -> DomainValue.simplify <$> simplifyChildren domainValueF FloorF floorF -> Floor.simplify <$> simplifyChildren floorF @@ -423,7 +425,7 @@ simplify sideCondition = \termLike -> -- 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 + TopF topF -> Top.simplify termSort <$> simplifyChildren topF -- StringLiteralF stringLiteralF -> return $ StringLiteral.simplify (getConst stringLiteralF) diff --git a/kore/src/Kore/Step/Simplification/Top.hs b/kore/src/Kore/Step/Simplification/Top.hs index f29f236431..2d33d16170 100644 --- a/kore/src/Kore/Step/Simplification/Top.hs +++ b/kore/src/Kore/Step/Simplification/Top.hs @@ -26,6 +26,7 @@ import Prelude.Kore () -- TODO (virgil): Preserve pattern sorts under simplification. simplify :: + Sort -> Top Sort child -> OrPattern RewritingVariableName -simplify _ = OrPattern.top +simplify sort _ = OrPattern.top sort diff --git a/kore/src/Kore/Step/Step.hs b/kore/src/Kore/Step/Step.hs index 42300ee51b..7d713c9af7 100644 --- a/kore/src/Kore/Step/Step.hs +++ b/kore/src/Kore/Step/Step.hs @@ -145,9 +145,10 @@ unifyRule initial rule = do -- Unify the left-hand side of the rule with the term of the initial -- configuration. let ruleLeft = matchingPattern rule + let initialSort = Pattern.patternSort initial unification <- unificationProcedure sideCondition initialTerm ruleLeft - & evalEnvUnifierT Not.notSimplifier + & evalEnvUnifierT (Not.notSimplifier initialSort) -- Combine the unification solution with the rule's requirement clause, let ruleRequires = precondition rule requires' = Condition.fromPredicate ruleRequires diff --git a/kore/src/Kore/Syntax/And.hs b/kore/src/Kore/Syntax/And.hs index 2964f1ab37..d126997ae3 100644 --- a/kore/src/Kore/Syntax/And.hs +++ b/kore/src/Kore/Syntax/And.hs @@ -58,6 +58,6 @@ instance Ord variable => Synthetic (FreeVariables variable) (And sort) where instance Synthetic Sort (And Sort) where synthetic And{andSort, andFirst, andSecond} = andSort - & seq (matchSort andSort andFirst) - . seq (matchSort andSort andSecond) + & seq (sameSort andSort andFirst) + . seq (sameSort andSort andSecond) {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Ceil.hs b/kore/src/Kore/Syntax/Ceil.hs index 980656e058..ca2ce85435 100644 --- a/kore/src/Kore/Syntax/Ceil.hs +++ b/kore/src/Kore/Syntax/Ceil.hs @@ -62,5 +62,5 @@ instance Synthetic (FreeVariables variable) (Ceil sort) where instance Synthetic Sort (Ceil Sort) where synthetic Ceil{ceilOperandSort, ceilResultSort, ceilChild} = ceilResultSort - & seq (matchSort ceilOperandSort ceilChild) + & seq (sameSort ceilOperandSort ceilChild) {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/DomainValue.hs b/kore/src/Kore/Syntax/DomainValue.hs index f7246792cf..fdaed36e6e 100644 --- a/kore/src/Kore/Syntax/DomainValue.hs +++ b/kore/src/Kore/Syntax/DomainValue.hs @@ -56,7 +56,7 @@ instance Synthetic (FreeVariables variable) (DomainValue sort) where instance Synthetic Sort (DomainValue Sort) where synthetic DomainValue{domainValueSort, domainValueChild} = domainValueSort - & seq (matchSort stringMetaSort domainValueChild) + & seq (sameSort stringMetaSort domainValueChild) {-# INLINE synthetic #-} instance TopBottom a => TopBottom (DomainValue Sort a) where diff --git a/kore/src/Kore/Syntax/Equals.hs b/kore/src/Kore/Syntax/Equals.hs index 6c3ab0776e..1aaf535f3f 100644 --- a/kore/src/Kore/Syntax/Equals.hs +++ b/kore/src/Kore/Syntax/Equals.hs @@ -115,8 +115,8 @@ instance Ord variable => Synthetic (FreeVariables variable) (Equals sort) where instance Synthetic Sort (Equals Sort) where synthetic equals = equalsResultSort - & seq (matchSort equalsOperandSort equalsFirst) - . seq (matchSort equalsOperandSort equalsSecond) + & seq (sameSort equalsOperandSort equalsFirst) + . seq (sameSort equalsOperandSort equalsSecond) where Equals{equalsOperandSort, equalsResultSort} = equals Equals{equalsFirst, equalsSecond} = equals diff --git a/kore/src/Kore/Syntax/Exists.hs b/kore/src/Kore/Syntax/Exists.hs index 7de4989fab..9c265a0597 100644 --- a/kore/src/Kore/Syntax/Exists.hs +++ b/kore/src/Kore/Syntax/Exists.hs @@ -74,5 +74,5 @@ instance instance Synthetic Sort (Exists Sort variable) where synthetic Exists{existsSort, existsChild} = - existsSort `matchSort` existsChild + existsSort `sameSort` existsChild {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Floor.hs b/kore/src/Kore/Syntax/Floor.hs index 4b54bfb2c1..47765564a1 100644 --- a/kore/src/Kore/Syntax/Floor.hs +++ b/kore/src/Kore/Syntax/Floor.hs @@ -60,5 +60,5 @@ instance Synthetic (FreeVariables variable) (Floor sort) where instance Synthetic Sort (Floor Sort) where synthetic Floor{floorOperandSort, floorResultSort, floorChild} = floorResultSort - & seq (matchSort floorOperandSort floorChild) + & seq (sameSort floorOperandSort floorChild) {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Forall.hs b/kore/src/Kore/Syntax/Forall.hs index 66d616ab86..d843e83185 100644 --- a/kore/src/Kore/Syntax/Forall.hs +++ b/kore/src/Kore/Syntax/Forall.hs @@ -74,5 +74,5 @@ instance instance Synthetic Sort (Forall Sort variable) where synthetic Forall{forallSort, forallChild} = - forallSort `matchSort` forallChild + forallSort `sameSort` forallChild {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Iff.hs b/kore/src/Kore/Syntax/Iff.hs index 3780a797aa..7123105de9 100644 --- a/kore/src/Kore/Syntax/Iff.hs +++ b/kore/src/Kore/Syntax/Iff.hs @@ -70,6 +70,6 @@ instance Ord variable => Synthetic (FreeVariables variable) (Iff sort) where instance Synthetic Sort (Iff Sort) where synthetic Iff{iffSort, iffFirst, iffSecond} = iffSort - & seq (matchSort iffSort iffFirst) - . seq (matchSort iffSort iffSecond) + & seq (sameSort iffSort iffFirst) + . seq (sameSort iffSort iffSecond) {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Implies.hs b/kore/src/Kore/Syntax/Implies.hs index 9c1009908c..9ebaf64acf 100644 --- a/kore/src/Kore/Syntax/Implies.hs +++ b/kore/src/Kore/Syntax/Implies.hs @@ -70,6 +70,6 @@ instance Ord variable => Synthetic (FreeVariables variable) (Implies sort) where instance Synthetic Sort (Implies Sort) where synthetic Implies{impliesSort, impliesFirst, impliesSecond} = impliesSort - & seq (matchSort impliesSort impliesFirst) - . seq (matchSort impliesSort impliesSecond) + & seq (sameSort impliesSort impliesFirst) + . seq (sameSort impliesSort impliesSecond) {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/In.hs b/kore/src/Kore/Syntax/In.hs index 2686b449ac..7fae82be7f 100644 --- a/kore/src/Kore/Syntax/In.hs +++ b/kore/src/Kore/Syntax/In.hs @@ -91,8 +91,8 @@ instance Ord variable => Synthetic (FreeVariables variable) (In sort) where instance Synthetic Sort (In Sort) where synthetic in' = inResultSort - & seq (matchSort inOperandSort inContainedChild) - . seq (matchSort inOperandSort inContainingChild) + & seq (sameSort inOperandSort inContainedChild) + . seq (sameSort inOperandSort inContainingChild) where In{inResultSort, inOperandSort} = in' In{inContainedChild, inContainingChild} = in' diff --git a/kore/src/Kore/Syntax/Mu.hs b/kore/src/Kore/Syntax/Mu.hs index b7f803677f..98c86ec480 100644 --- a/kore/src/Kore/Syntax/Mu.hs +++ b/kore/src/Kore/Syntax/Mu.hs @@ -59,7 +59,7 @@ instance instance Synthetic Sort (Mu variable) where synthetic Mu{muVariable, muChild} = muSort - & seq (matchSort muSort muChild) + & seq (sameSort muSort muChild) where Variable{variableSort = muSort} = muVariable {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Next.hs b/kore/src/Kore/Syntax/Next.hs index 2b0af3e024..ecfa1b830a 100644 --- a/kore/src/Kore/Syntax/Next.hs +++ b/kore/src/Kore/Syntax/Next.hs @@ -47,5 +47,5 @@ instance Synthetic (FreeVariables variable) (Next sort) where instance Synthetic Sort (Next Sort) where synthetic Next{nextSort, nextChild} = - nextSort `matchSort` nextChild + nextSort `sameSort` nextChild {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Not.hs b/kore/src/Kore/Syntax/Not.hs index 17c1f2d032..b149e775de 100644 --- a/kore/src/Kore/Syntax/Not.hs +++ b/kore/src/Kore/Syntax/Not.hs @@ -61,5 +61,5 @@ instance Synthetic (FreeVariables variable) (Not child) where instance Synthetic Sort (Not Sort) where synthetic Not{notSort, notChild} = - notSort `matchSort` notChild + notSort `sameSort` notChild {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Nu.hs b/kore/src/Kore/Syntax/Nu.hs index 3cb7be52e6..d45ac8d89c 100644 --- a/kore/src/Kore/Syntax/Nu.hs +++ b/kore/src/Kore/Syntax/Nu.hs @@ -59,7 +59,7 @@ instance instance Synthetic Sort (Nu variable) where synthetic Nu{nuVariable, nuChild} = nuSort - & seq (matchSort nuSort nuChild) + & seq (sameSort nuSort nuChild) where Variable{variableSort = nuSort} = nuVariable {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Or.hs b/kore/src/Kore/Syntax/Or.hs index 09b6700699..22a137570c 100644 --- a/kore/src/Kore/Syntax/Or.hs +++ b/kore/src/Kore/Syntax/Or.hs @@ -83,6 +83,6 @@ instance Ord variable => Synthetic (FreeVariables variable) (Or sort) where instance Synthetic Sort (Or Sort) where synthetic Or{orSort, orFirst, orSecond} = orSort - & seq (matchSort orSort orFirst) - . seq (matchSort orSort orSecond) + & seq (sameSort orSort orFirst) + . seq (sameSort orSort orSecond) {-# INLINE synthetic #-} diff --git a/kore/src/Kore/Syntax/Rewrites.hs b/kore/src/Kore/Syntax/Rewrites.hs index fd0c872bb8..239d6625e2 100644 --- a/kore/src/Kore/Syntax/Rewrites.hs +++ b/kore/src/Kore/Syntax/Rewrites.hs @@ -55,5 +55,5 @@ instance Ord variable => Synthetic (FreeVariables variable) (Rewrites sort) wher instance Synthetic Sort (Rewrites Sort) where synthetic Rewrites{rewritesSort, rewritesFirst, rewritesSecond} = rewritesSort - & seq (matchSort rewritesSort rewritesFirst) - . seq (matchSort rewritesSort rewritesSecond) + & seq (sameSort rewritesSort rewritesFirst) + . seq (sameSort rewritesSort rewritesSecond) diff --git a/kore/src/Kore/Unification/Procedure.hs b/kore/src/Kore/Unification/Procedure.hs index 6dac3886fa..9df7d37208 100644 --- a/kore/src/Kore/Unification/Procedure.hs +++ b/kore/src/Kore/Unification/Procedure.hs @@ -57,7 +57,7 @@ unificationProcedure sideCondition p1 p2 | p1Sort /= p2Sort = Monad.Unify.explainAndReturnBottom "Cannot unify different sorts." p1 p2 | otherwise = infoAttemptUnification p1 p2 $ do - pat <- termUnification Not.notSimplifier p1 p2 + pat <- termUnification (Not.notSimplifier p1Sort) p1 p2 TopBottom.guardAgainstBottom pat let (term, conditions) = Conditional.splitTerm pat orCeil <- makeEvaluateTermCeil sideCondition term From 27cca028f99b2f449b015896f79360294f50d5b6 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 13:56:52 -0500 Subject: [PATCH 02/74] Kore.Repl.Interpreter: Unparse \bottom with variable sort --- kore/src/Kore/Repl/Interpreter.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/kore/src/Kore/Repl/Interpreter.hs b/kore/src/Kore/Repl/Interpreter.hs index 6e1a09311e..87ee66da56 100644 --- a/kore/src/Kore/Repl/Interpreter.hs +++ b/kore/src/Kore/Repl/Interpreter.hs @@ -167,6 +167,7 @@ import Kore.Rewriting.RewritingVariable ( RewritingVariableName, getRewritingPattern, ) +import Kore.Sort import qualified Kore.Step.RulePattern as RulePattern import Kore.Step.Simplification.Data ( MonadSimplify, @@ -1393,8 +1394,11 @@ prettyClaimStateComponent transformation omitList = , provenValue = makeAuxReplOutput "Proven." } where + -- Dummy sort used to unparse configurations. + -- This is only used for unparsing \bottom. + dummySort = SortVariableSort (SortVariable "R") prettyComponent = - unparseToString . OrPattern.toTermLike _ + unparseToString . OrPattern.toTermLike dummySort . MultiOr.map (fmap hide . getRewritingPattern) . transformation hide :: From 7668b69827f80064b9aacdbe83c7646c47261976 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 13:59:09 -0500 Subject: [PATCH 03/74] Kore.Exec: Unparse \bottom with variable sort --- kore/src/Kore/Exec.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/kore/src/Kore/Exec.hs b/kore/src/Kore/Exec.hs index 2ab5debf5a..d27a86734b 100644 --- a/kore/src/Kore/Exec.hs +++ b/kore/src/Kore/Exec.hs @@ -266,10 +266,13 @@ exec <$> finalConfigs exitCode <- getExitCode verifiedModule finalConfigs' let finalTerm = - sameTermLikeSort initialSort $ - OrPattern.toTermLike - _ - (MultiOr.map getRewritingPattern finalConfigs') + MultiOr.map getRewritingPattern finalConfigs' + & OrPattern.toTermLike dummySort + & sameTermLikeSort initialSort + where + -- Dummy sort used to unparse configurations. + -- This is only used for unparsing \bottom. + dummySort = SortVariableSort (SortVariable "R") return (exitCode, finalTerm) where dropStrategy = snd From bcab28cde8f81ff8191b6324a512c9e7d5b633ec Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:17:04 -0500 Subject: [PATCH 04/74] Test.Kore.ASTVerifier.DefinitionVerifier.Imports: Use explicit sorts --- .../Test/Kore/ASTVerifier/DefinitionVerifier/Imports.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/ASTVerifier/DefinitionVerifier/Imports.hs b/kore/test/Test/Kore/ASTVerifier/DefinitionVerifier/Imports.hs index 1ca2703a37..414a8ab41e 100644 --- a/kore/test/Test/Kore/ASTVerifier/DefinitionVerifier/Imports.hs +++ b/kore/test/Test/Kore/ASTVerifier/DefinitionVerifier/Imports.hs @@ -405,7 +405,7 @@ sortVisibilityTests = SentenceAxiom { sentenceAxiomParameters = [] , sentenceAxiomPattern = - externalize $ mkAnd (mkTop sort) mkTop_ + externalize $ mkAnd (mkTop sort) (mkTop sort) , sentenceAxiomAttributes = Attributes [] } sortReferenceInNextPatternSentence = @@ -678,7 +678,8 @@ symbolVisibilityTests = SentenceAxiom { sentenceAxiomParameters = [] , sentenceAxiomPattern = - externalize $ mkAnd symbolPattern mkTop_ + mkAnd symbolPattern (mkTop $ termLikeSort symbolPattern) + & externalize , sentenceAxiomAttributes = Attributes [] } symbolReferenceInExistsPatternSentence = @@ -901,7 +902,8 @@ aliasVisibilityTests = SentenceAxiom { sentenceAxiomParameters = [] , sentenceAxiomPattern = - externalize $ mkAnd aliasPattern mkTop_ + mkAnd aliasPattern (mkTop $ termLikeSort aliasPattern) + & externalize , sentenceAxiomAttributes = Attributes [] } aliasReferenceInExistsPatternSentence = From 25457c70f4182b100c91bc16136d144d8a9d5c8a Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:19:25 -0500 Subject: [PATCH 05/74] Test.Kore.Step.Simplification.Forall: Use explicit sorts --- .../Test/Kore/Step/Simplification/Forall.hs | 40 +++++++++---------- 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/Forall.hs b/kore/test/Test/Kore/Step/Simplification/Forall.hs index 5f18c39011..47d9e005e2 100644 --- a/kore/test/Test/Kore/Step/Simplification/Forall.hs +++ b/kore/test/Test/Kore/Step/Simplification/Forall.hs @@ -61,21 +61,17 @@ test_forallSimplification = -- forall(top) = top assertEqual "forall(top)" - ( OrPattern.fromPatterns - [Pattern.top] - ) + (OrPattern.top Mock.topSort) ( evaluate ( makeForall Mock.xConfig - [Pattern.top] + [Pattern.topOf Mock.topSort] ) ) -- forall(bottom) = bottom assertEqual "forall(bottom)" - ( OrPattern.fromPatterns - [] - ) + (OrPattern.bottom) ( evaluate ( makeForall Mock.xConfig @@ -89,18 +85,18 @@ test_forallSimplification = -- forall(top) = top assertEqual "forall(top)" - Pattern.top + (Pattern.topOf Mock.topSort) ( makeEvaluate Mock.xConfig - (Pattern.top :: Pattern RewritingVariableName) + (Pattern.topOf Mock.topSort :: Pattern RewritingVariableName) ) -- forall(bottom) = bottom assertEqual "forall(bottom)" - Pattern.bottom + (Pattern.bottomOf Mock.topSort) ( makeEvaluate Mock.xConfig - (Pattern.bottom :: Pattern RewritingVariableName) + (Pattern.bottomOf Mock.topSort :: Pattern RewritingVariableName) ) ) , testCase @@ -115,11 +111,13 @@ test_forallSimplification = ( mkAnd ( mkAnd (Mock.f $ mkElemVar Mock.xConfig) - (mkCeil_ (Mock.h (mkElemVar Mock.xConfig))) + ( (mkCeil Mock.testSort) + (Mock.h (mkElemVar Mock.xConfig)) + ) ) ( mkAnd - (mkEquals_ (mkElemVar Mock.xConfig) gOfA) - (mkEquals_ (mkElemVar Mock.yConfig) fOfA) + (mkEquals Mock.testSort (mkElemVar Mock.xConfig) gOfA) + (mkEquals Mock.testSort (mkElemVar Mock.yConfig) fOfA) ) ) , predicate = makeTruePredicate @@ -165,7 +163,7 @@ test_forallSimplification = ( assertEqual "forall on term" Conditional - { term = mkForall Mock.xConfig (mkAnd fOfX (mkCeil_ gOfA)) + { term = mkForall Mock.xConfig (mkAnd fOfX (mkCeil Mock.testSort gOfA)) , predicate = makeTruePredicate , substitution = mempty } @@ -210,9 +208,9 @@ test_forallSimplification = ( mkAnd ( mkAnd fOfA - (mkCeil_ fOfX) + (mkCeil Mock.testSort fOfX) ) - (mkEquals_ (mkElemVar Mock.yConfig) fOfA) + (mkEquals Mock.testSort (mkElemVar Mock.yConfig) fOfA) ) , predicate = makeTruePredicate , substitution = mempty @@ -236,7 +234,7 @@ test_forallSimplification = ( assertEqual "forall on predicate" Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeForallPredicate Mock.xConfig @@ -249,7 +247,7 @@ test_forallSimplification = ( makeEvaluate Mock.xConfig Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeCeilPredicate fOfX , substitution = Substitution.wrap $ @@ -268,8 +266,8 @@ test_forallSimplification = mkForall Mock.xConfig ( mkAnd - (mkAnd fOfX (mkEquals_ fOfX gOfA)) - (mkEquals_ (mkElemVar Mock.yConfig) hOfA) + (mkAnd fOfX (mkEquals Mock.testSort fOfX gOfA)) + (mkEquals Mock.testSort (mkElemVar Mock.yConfig) hOfA) ) , predicate = makeTruePredicate , substitution = mempty From 20fb406c684552373e5a6417937750fe7b149b0c Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:19:38 -0500 Subject: [PATCH 06/74] Test.Kore.Step.Simplification.InternalList: Use explicit sorts --- kore/test/Test/Kore/Step/Simplification/InternalList.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/InternalList.hs b/kore/test/Test/Kore/Step/Simplification/InternalList.hs index fd3b7d865e..6191af3f70 100644 --- a/kore/test/Test/Kore/Step/Simplification/InternalList.hs +++ b/kore/test/Test/Kore/Step/Simplification/InternalList.hs @@ -67,7 +67,7 @@ test_simplify = ceilb = makeCeilPredicate (Mock.f Mock.b) & Condition.fromPredicate - bottom = OrPattern.fromPatterns [Pattern.bottom] + bottom = OrPattern.fromPatterns [Pattern.bottomOf Mock.listSort] becomes :: HasCallStack => TestName -> @@ -91,5 +91,7 @@ mkList children = , internalListChild = Seq.fromList children } -evaluate :: InternalList (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName +evaluate :: + InternalList (OrPattern RewritingVariableName) -> + OrPattern RewritingVariableName evaluate = simplify From 35ecdf09ddd69fa38c8eeb0a9a92f99c199f7f4d Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:19:49 -0500 Subject: [PATCH 07/74] Test.Kore.Step.Simplification.InternalMap: Use explicit sorts --- kore/test/Test/Kore/Step/Simplification/InternalMap.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/InternalMap.hs b/kore/test/Test/Kore/Step/Simplification/InternalMap.hs index d69dd60713..6e0eaeec5e 100644 --- a/kore/test/Test/Kore/Step/Simplification/InternalMap.hs +++ b/kore/test/Test/Kore/Step/Simplification/InternalMap.hs @@ -99,7 +99,7 @@ test_simplify = ceilb = makeCeilPredicate (Mock.f Mock.b) & Condition.fromPredicate - bottom = OrPattern.fromPatterns [Pattern.bottom] + bottom = OrPattern.fromPatterns [Pattern.bottomOf Mock.topSort] becomes :: HasCallStack => TestName -> @@ -111,7 +111,7 @@ test_simplify = assertEqual "" (OrPattern.fromPatterns expect) - (evaluate origin) + (evaluate Mock.topSort origin) mkMap :: [(child, child)] -> [child] -> InternalMap Key child mkMap = mkMapAux [] @@ -140,6 +140,7 @@ mkMapAux concreteElements elements opaque = } evaluate :: + Sort -> InternalMap Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName evaluate = simplify From 8592b92a20b2b854083b8ea6d22c48f436cbffe4 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:19:59 -0500 Subject: [PATCH 08/74] Test.Kore.Step.Simplification.InternalSet: Use explicit sorts --- kore/test/Test/Kore/Step/Simplification/InternalSet.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/InternalSet.hs b/kore/test/Test/Kore/Step/Simplification/InternalSet.hs index b72e42243d..1f80fae066 100644 --- a/kore/test/Test/Kore/Step/Simplification/InternalSet.hs +++ b/kore/test/Test/Kore/Step/Simplification/InternalSet.hs @@ -73,7 +73,7 @@ test_simplify = ceila = makeCeilPredicate (Mock.f Mock.a) & Condition.fromPredicate - bottom = OrPattern.fromPatterns [Pattern.bottom] + bottom = OrPattern.fromPatterns [Pattern.bottomOf Mock.topSort] becomes :: HasCallStack => TestName -> @@ -82,7 +82,7 @@ test_simplify = TestTree becomes name origin (OrPattern.fromPatterns -> expects) = testCase name $ do - let actuals = evaluate origin + let actuals = evaluate Mock.topSort origin assertEqual "" expects actuals mkSet :: [child] -> [child] -> InternalSet Key child @@ -114,6 +114,7 @@ mkSetAux concreteElements elements opaque = mkSetValue = \x -> (x, SetValue) evaluate :: + Sort -> InternalSet Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName evaluate = simplify From 86dcdb684a3b3cf0efd83c517a04c3c514ad34d6 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:20:08 -0500 Subject: [PATCH 09/74] Test.Kore.Step.Simplification.Top: Use explicit sorts --- kore/test/Test/Kore/Step/Simplification/Top.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/Top.hs b/kore/test/Test/Kore/Step/Simplification/Top.hs index ec9bb4052c..91593bcbc9 100644 --- a/kore/test/Test/Kore/Step/Simplification/Top.hs +++ b/kore/test/Test/Kore/Step/Simplification/Top.hs @@ -27,12 +27,13 @@ test_topSimplification = "Top evaluates to top" ( assertEqual "" - (OrPattern.fromPattern Pattern.top) - (evaluate Top{topSort = testSort}) + (OrPattern.fromPattern (Pattern.topOf testSort)) + (evaluate testSort Top{topSort = testSort}) ) ] evaluate :: + Sort -> Top Sort (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName evaluate = simplify From c3881c329ab39c6da18c0d257b8361b3929ea492 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:20:46 -0500 Subject: [PATCH 10/74] Test.Kore.Step.Simplification.Bottom: Use explicit sorts --- kore/test/Test/Kore/Step/Simplification/Bottom.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/Bottom.hs b/kore/test/Test/Kore/Step/Simplification/Bottom.hs index 18e9033987..7477a9848c 100644 --- a/kore/test/Test/Kore/Step/Simplification/Bottom.hs +++ b/kore/test/Test/Kore/Step/Simplification/Bottom.hs @@ -6,9 +6,7 @@ import Kore.Internal.OrPattern ( OrPattern, ) import qualified Kore.Internal.OrPattern as OrPattern -import qualified Kore.Internal.Pattern as Pattern ( - bottom, - ) +import qualified Kore.Internal.Pattern as Pattern import Kore.Rewriting.RewritingVariable ( RewritingVariableName, ) @@ -28,7 +26,7 @@ test_bottomSimplification = "Bottom evaluates to bottom" ( assertEqual "" - (OrPattern.fromPatterns [Pattern.bottom]) + (OrPattern.fromPatterns [Pattern.bottomOf Mock.testSort]) (evaluate Bottom{bottomSort = Mock.testSort}) ) ] From 5c06061baf16f94147cc88da2bcc81d3eb15b776 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:59:18 -0500 Subject: [PATCH 11/74] NotSimplifier: Use Not.simplify --- kore/src/Kore/Builtin/EqTerm.hs | 7 ++- kore/src/Kore/Builtin/Int.hs | 18 ++++--- kore/src/Kore/Builtin/KEqual.hs | 17 ++++--- kore/src/Kore/Builtin/Map.hs | 12 +++-- kore/src/Kore/Reachability/Claim.hs | 6 ++- kore/src/Kore/Repl/Data.hs | 8 +-- kore/src/Kore/Repl/State.hs | 3 +- kore/src/Kore/Step/Search.hs | 8 ++- kore/src/Kore/Step/Simplification/Equals.hs | 42 ++++++---------- kore/src/Kore/Step/Simplification/Iff.hs | 17 +++---- kore/src/Kore/Step/Simplification/Implies.hs | 44 +++++++--------- kore/src/Kore/Step/Simplification/In.hs | 4 +- kore/src/Kore/Step/Simplification/Not.hs | 50 +++---------------- .../Kore/Step/Simplification/NotSimplifier.hs | 6 ++- kore/src/Kore/Step/Simplification/TermLike.hs | 2 +- kore/src/Kore/Step/Step.hs | 3 +- kore/src/Kore/Unification/Procedure.hs | 2 +- 17 files changed, 99 insertions(+), 150 deletions(-) diff --git a/kore/src/Kore/Builtin/EqTerm.hs b/kore/src/Kore/Builtin/EqTerm.hs index 2f20ca24c6..9f49da1602 100644 --- a/kore/src/Kore/Builtin/EqTerm.hs +++ b/kore/src/Kore/Builtin/EqTerm.hs @@ -68,10 +68,13 @@ unifyEqTerm unifyChildren (NotSimplifier notSimplifier) eqTerm termLike2 lift $ do solution <- unifyChildren operand1 operand2 & OrPattern.gather let solution' = MultiOr.map eraseTerm solution - (if value2 then pure else notSimplifier SideCondition.top) solution' - >>= Unify.scatter + if value2 + then Unify.scatter solution' + else mkNotSimplified solution' >>= Unify.scatter | otherwise = empty where sort = TermLike.termLikeSort termLike2 EqTerm{operand1, operand2} = eqTerm eraseTerm = Pattern.fromCondition sort . Pattern.withoutTerm + mkNotSimplified notChild = + notSimplifier SideCondition.top Not{notSort = sort, notChild} diff --git a/kore/src/Kore/Builtin/Int.hs b/kore/src/Kore/Builtin/Int.hs index 98b70d6bf3..6289b334ac 100644 --- a/kore/src/Kore/Builtin/Int.hs +++ b/kore/src/Kore/Builtin/Int.hs @@ -122,6 +122,7 @@ import Kore.Internal.Predicate ( ) import qualified Kore.Internal.SideCondition as SideCondition import Kore.Internal.Symbol ( + applicationSortsResult, symbolHook, ) import Kore.Internal.TermLike as TermLike @@ -506,13 +507,16 @@ unifyIntEq :: NotSimplifier unifier -> UnifyIntEq -> unifier (Pattern RewritingVariableName) -unifyIntEq unifyChildren (NotSimplifier notSimplifier) unifyData = - do - solution <- unifyChildren operand1 operand2 & OrPattern.gather - let solution' = MultiOr.map eraseTerm solution - (if value then pure else notSimplifier SideCondition.top) solution' - >>= Unify.scatter +unifyIntEq unifyChildren (NotSimplifier notSimplifier) unifyData = do + solution <- unifyChildren operand1 operand2 & OrPattern.gather + let solution' = MultiOr.map eraseTerm solution + if value + then Unify.scatter solution' + else mkNotSimplified solution' >>= Unify.scatter where UnifyIntEq{eqTerm, value} = unifyData - EqTerm{operand1, operand2} = eqTerm + EqTerm{symbol, operand1, operand2} = eqTerm eraseTerm = fmap (mkTop . termLikeSort) + notSort = applicationSortsResult . symbolSorts $ symbol + mkNotSimplified notChild = + notSimplifier SideCondition.top Not{notSort, notChild} diff --git a/kore/src/Kore/Builtin/KEqual.hs b/kore/src/Kore/Builtin/KEqual.hs index 5c653cd074..4f2e2dd9c6 100644 --- a/kore/src/Kore/Builtin/KEqual.hs +++ b/kore/src/Kore/Builtin/KEqual.hs @@ -263,16 +263,19 @@ unifyKequalsEq :: NotSimplifier unifier -> UnifyKequalsEq -> unifier (Pattern RewritingVariableName) -unifyKequalsEq unifyChildren (NotSimplifier notSimplifier) unifyData = - do - solution <- unifyChildren operand1 operand2 & OrPattern.gather - let solution' = MultiOr.map eraseTerm solution - (if value then pure else notSimplifier SideCondition.top) solution' - >>= Unify.scatter +unifyKequalsEq unifyChildren (NotSimplifier notSimplifier) unifyData = do + solution <- unifyChildren operand1 operand2 & OrPattern.gather + let solution' = MultiOr.map eraseTerm solution + if value + then Unify.scatter solution' + else mkNotSimplified solution' >>= Unify.scatter where UnifyKequalsEq{eqTerm, value} = unifyData - EqTerm{operand1, operand2} = eqTerm + EqTerm{symbol, operand1, operand2} = eqTerm eraseTerm = fmap (mkTop . termLikeSort) + sort = applicationSortsResult . symbolSorts $ symbol + mkNotSimplified notChild = + notSimplifier SideCondition.top Not{notSort = sort, notChild} -- | The @KEQUAL.ite@ hooked symbol applied to @term@-type arguments. data IfThenElse term = IfThenElse diff --git a/kore/src/Kore/Builtin/Map.hs b/kore/src/Kore/Builtin/Map.hs index db1b47a0c9..a67cfa216a 100644 --- a/kore/src/Kore/Builtin/Map.hs +++ b/kore/src/Kore/Builtin/Map.hs @@ -88,6 +88,7 @@ import Kore.Internal.Symbol ( ) import Kore.Internal.TermLike ( Key, + Not (..), TermLike, retractKey, termLikeSort, @@ -641,11 +642,12 @@ unifyNotInKeys unifyChildren (NotSimplifier notSimplifier) a b = -- Erasing the unified term is valid here because -- the terms are all wrapped in \ceil below. unificationSolutions <- - fmap eraseTerm - <$> Unify.gather (unifyChildren t1 t2) - notSimplifier - SideCondition.top - (OrPattern.fromPatterns unificationSolutions) + fmap eraseTerm <$> Unify.gather (unifyChildren t1 t2) + (notSimplifier SideCondition.top) + Not + { notSort = sort1 + , notChild = OrPattern.fromPatterns unificationSolutions + } >>= Unify.scatter collectConditions terms = fold terms & Pattern.fromCondition sort1 diff --git a/kore/src/Kore/Reachability/Claim.hs b/kore/src/Kore/Reachability/Claim.hs index 0759a03214..a6a8f067a5 100644 --- a/kore/src/Kore/Reachability/Claim.hs +++ b/kore/src/Kore/Reachability/Claim.hs @@ -97,6 +97,7 @@ import Kore.Internal.Symbol ( Symbol, ) import Kore.Internal.TermLike ( + Not (..), Sort, isFunctionPattern, mkIn, @@ -557,8 +558,11 @@ checkImplicationWorker (ClaimPattern.refreshExistentials -> claimPattern) = Exists.makeEvaluate sideCondition existentials removed >>= Logic.scatter & OrPattern.observeAllT - & (>>= (Not.simplifyEvaluated sort) sideCondition) + & (>>= mkNotSimplified) & wereAnyUnified + where + mkNotSimplified notChild = + Not.simplify sideCondition Not{notSort = sort, notChild} wereAnyUnified :: StateT AnyUnified m a -> m (AnyUnified, a) wereAnyUnified act = swap <$> runStateT act mempty diff --git a/kore/src/Kore/Repl/Data.hs b/kore/src/Kore/Repl/Data.hs index 9f3bf86b6b..3336fbd4cc 100644 --- a/kore/src/Kore/Repl/Data.hs +++ b/kore/src/Kore/Repl/Data.hs @@ -104,9 +104,6 @@ import qualified Kore.Reachability as Reachability import Kore.Rewriting.RewritingVariable ( RewritingVariableName, ) -import Kore.Sort ( - Sort, - ) import Kore.Step.Simplification.Data ( MonadSimplify (..), ) @@ -694,17 +691,16 @@ makeKoreReplOutput str = runUnifierWithExplanation :: forall m a. MonadSimplify m => - Sort -> UnifierWithExplanation m a -> m (Either ReplOutput (NonEmpty a)) -runUnifierWithExplanation currSort (UnifierWithExplanation unifier) = +runUnifierWithExplanation (UnifierWithExplanation unifier) = failWithExplanation <$> unificationResults where unificationResults :: m ([a], First ReplOutput) unificationResults = flip runAccumT mempty - . Monad.Unify.runUnifierT (Not.notSimplifier currSort) + . Monad.Unify.runUnifierT Not.notSimplifier $ unifier failWithExplanation :: ([a], First ReplOutput) -> diff --git a/kore/src/Kore/Repl/State.hs b/kore/src/Kore/Repl/State.hs index e648e13ba0..2739dfc243 100644 --- a/kore/src/Kore/Repl/State.hs +++ b/kore/src/Kore/Repl/State.hs @@ -620,9 +620,8 @@ runUnifier :: runUnifier sideCondition first second = do unifier <- asks unifier mvar <- asks logger - let firstSort = TermLike.termLikeSort first liftSimplifierWithLogger mvar - . (runUnifierWithExplanation firstSort) + . runUnifierWithExplanation $ unifier sideCondition first second getNodeState :: InnerGraph -> Graph.Node -> Maybe (NodeState, Graph.Node) diff --git a/kore/src/Kore/Step/Search.hs b/kore/src/Kore/Step/Search.hs index 1bfbac6414..c2e2df756a 100644 --- a/kore/src/Kore/Step/Search.hs +++ b/kore/src/Kore/Step/Search.hs @@ -35,7 +35,6 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Conditional -import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.SideCondition ( SideCondition, ) @@ -132,9 +131,9 @@ matchWith :: MaybeT m (OrCondition RewritingVariableName) matchWith sideCondition e1 e2 = do unifiers <- - lift $ - Unifier.runUnifierT (Not.notSimplifier sort) $ - unificationProcedure sideCondition t1 t2 + unificationProcedure sideCondition t1 t2 + & Unifier.runUnifierT Not.notSimplifier + & lift let mergeAndEvaluate :: Condition RewritingVariableName -> m (OrCondition RewritingVariableName) @@ -178,4 +177,3 @@ matchWith sideCondition e1 e2 = do where t1 = Conditional.term e1 t2 = Conditional.term e2 - sort = Pattern.patternSort e1 diff --git a/kore/src/Kore/Step/Simplification/Equals.hs b/kore/src/Kore/Step/Simplification/Equals.hs index 625501156d..eea8c41e09 100644 --- a/kore/src/Kore/Step/Simplification/Equals.hs +++ b/kore/src/Kore/Step/Simplification/Equals.hs @@ -59,11 +59,7 @@ import qualified Kore.Step.Simplification.Iff as Iff ( import qualified Kore.Step.Simplification.Implies as Implies ( simplifyEvaluated, ) -import qualified Kore.Step.Simplification.Not as Not ( - notSimplifier, - simplifyEvaluated, - simplifyEvaluatedPredicate, - ) +import qualified Kore.Step.Simplification.Not as Not import qualified Kore.Step.Simplification.Or as Or ( simplifyEvaluated, ) @@ -230,24 +226,21 @@ makeEvaluateFunctionalOr sideCondition first seconds = do let sort = Pattern.patternSort first firstCeil <- makeEvaluateCeil sort sideCondition first secondCeilsWithProofs <- mapM (makeEvaluateCeil sort sideCondition) seconds - firstNotCeil <- Not.simplifyEvaluated sort sideCondition firstCeil + let mkNotSimplified notChild = + Not.simplify sideCondition Not{notSort = sort, notChild} + firstNotCeil <- mkNotSimplified firstCeil let secondCeils = secondCeilsWithProofs - secondNotCeils <- traverse (Not.simplifyEvaluated sort sideCondition) secondCeils + secondNotCeils <- traverse mkNotSimplified secondCeils let oneNotBottom = foldl' Or.simplifyEvaluated OrPattern.bottom secondCeils allAreBottom <- - And.simplify - sort - (Not.notSimplifier sort) - sideCondition + (And.simplify sort Not.notSimplifier sideCondition) (MultiAnd.make (firstNotCeil : secondNotCeils)) firstEqualsSeconds <- mapM (makeEvaluateEqualsIfSecondNotBottom sort first) (zip seconds secondCeils) oneIsNotBottomEquals <- - (And.simplify sort) - (Not.notSimplifier sort) - sideCondition + (And.simplify sort Not.notSimplifier sideCondition) (MultiAnd.make (firstCeil : oneNotBottom : firstEqualsSeconds)) return (MultiOr.merge allAreBottom oneIsNotBottomEquals) where @@ -304,18 +297,16 @@ makeEvaluate firstCeil <- makeEvaluateCeil sort sideCondition first' let second' = second{term = if termsAreEqual then mkTop termSort else secondTerm} secondCeil <- makeEvaluateCeil sort sideCondition second' - firstCeilNegation <- Not.simplifyEvaluated sort sideCondition firstCeil - secondCeilNegation <- Not.simplifyEvaluated sort sideCondition secondCeil + let mkNotSimplified notChild = + Not.simplify sideCondition Not{notSort = termSort, notChild} + firstCeilNegation <- mkNotSimplified firstCeil + secondCeilNegation <- mkNotSimplified secondCeil termEquality <- makeEvaluateTermsAssumesNoBottom firstTerm secondTerm negationAnd <- - (And.simplify sort) - (Not.notSimplifier sort) - sideCondition + (And.simplify sort Not.notSimplifier sideCondition) (MultiAnd.make [firstCeilNegation, secondCeilNegation]) equalityAnd <- - (And.simplify sort) - (Not.notSimplifier sort) - sideCondition + (And.simplify sort Not.notSimplifier sideCondition) (MultiAnd.make [termEquality, firstCeil, secondCeil]) return $ Or.simplifyEvaluated equalityAnd negationAnd where @@ -430,9 +421,8 @@ termEqualsAnd :: termEqualsAnd p1 p2 = MaybeT $ run $ maybeTermEqualsWorker p1 p2 where - termSort = termLikeSort p1 run it = - (runUnifierT (Not.notSimplifier termSort) . runMaybeT) it + (runUnifierT Not.notSimplifier . runMaybeT) it >>= Logic.scatter maybeTermEqualsWorker :: @@ -442,7 +432,7 @@ termEqualsAnd p1 p2 = TermLike RewritingVariableName -> MaybeT unifier (Pattern RewritingVariableName) maybeTermEqualsWorker = - maybeTermEquals (Not.notSimplifier termSort) termEqualsAndWorker + maybeTermEquals Not.notSimplifier termEqualsAndWorker termEqualsAndWorker :: forall unifier. @@ -454,7 +444,7 @@ termEqualsAnd p1 p2 = scatterResults =<< runUnification (maybeTermEqualsWorker first second) where - runUnification = runUnifierT (Not.notSimplifier termSort) . runMaybeT + runUnification = runUnifierT Not.notSimplifier . runMaybeT scatterResults = maybe (return equalsPattern) -- default if no results diff --git a/kore/src/Kore/Step/Simplification/Iff.hs b/kore/src/Kore/Step/Simplification/Iff.hs index f382397884..10db7f47bc 100644 --- a/kore/src/Kore/Step/Simplification/Iff.hs +++ b/kore/src/Kore/Step/Simplification/Iff.hs @@ -37,11 +37,7 @@ import qualified Kore.Step.Simplification.And as And ( import qualified Kore.Step.Simplification.Implies as Implies ( simplifyEvaluated, ) -import qualified Kore.Step.Simplification.Not as Not ( - makeEvaluate, - notSimplifier, - simplifyEvaluated, - ) +import qualified Kore.Step.Simplification.Not as Not import Kore.Step.Simplification.Simplify import Prelude.Kore @@ -86,18 +82,17 @@ simplifyEvaluated :: simplifier (OrPattern RewritingVariableName) simplifyEvaluated sort sideCondition first second | OrPattern.isTrue first = return second - | OrPattern.isFalse first = Not.simplifyEvaluated sort sideCondition second + | OrPattern.isFalse first = + Not.simplify sideCondition Not{notSort = sort, notChild = second} | OrPattern.isTrue second = return first - | OrPattern.isFalse second = Not.simplifyEvaluated sort sideCondition first + | OrPattern.isFalse second = + Not.simplify sideCondition Not{notSort = sort, notChild = first} | otherwise = case (firstPatterns, secondPatterns) of ([firstP], [secondP]) -> return $ makeEvaluate firstP secondP _ -> do fwd <- Implies.simplifyEvaluated sort sideCondition first second bwd <- Implies.simplifyEvaluated sort sideCondition second first - And.simplify - sort - (Not.notSimplifier sort) - sideCondition + (And.simplify sort Not.notSimplifier sideCondition) (MultiAnd.make [fwd, bwd]) where firstPatterns = toList first diff --git a/kore/src/Kore/Step/Simplification/Implies.hs b/kore/src/Kore/Step/Simplification/Implies.hs index e7677c75eb..5a31e79fd1 100644 --- a/kore/src/Kore/Step/Simplification/Implies.hs +++ b/kore/src/Kore/Step/Simplification/Implies.hs @@ -28,11 +28,7 @@ import Kore.Rewriting.RewritingVariable ( RewritingVariableName, ) import qualified Kore.Step.Simplification.And as And -import qualified Kore.Step.Simplification.Not as Not ( - makeEvaluate, - notSimplifier, - simplifyEvaluated, - ) +import qualified Kore.Step.Simplification.Not as Not import Kore.Step.Simplification.Simplify import Logic ( LogicT, @@ -93,7 +89,8 @@ simplifyEvaluated sort sideCondition first second | OrPattern.isTrue first = return second | OrPattern.isFalse first = return (OrPattern.top sort) | OrPattern.isTrue second = return (OrPattern.top sort) - | OrPattern.isFalse second = Not.simplifyEvaluated sort sideCondition first + | OrPattern.isFalse second = + Not.simplify sideCondition Not{notSort = sort, notChild = first} | otherwise = OrPattern.observeAllT $ Logic.scatter second @@ -106,23 +103,19 @@ simplifyEvaluateHalfImplies :: OrPattern RewritingVariableName -> Pattern RewritingVariableName -> LogicT simplifier (Pattern RewritingVariableName) -simplifyEvaluateHalfImplies - sort - sideCondition - first - second - | OrPattern.isTrue first = return second - | OrPattern.isFalse first = return (Pattern.topOf sort) - | Pattern.isTop second = return (Pattern.topOf sort) - | Pattern.isBottom second = - Not.simplifyEvaluated sort sideCondition first - >>= Logic.scatter - | otherwise = - case toList first of - [firstP] -> Logic.scatter $ makeEvaluateImplies firstP second - firstPatterns -> - distributeEvaluateImplies sideCondition firstPatterns second - >>= Logic.scatter +simplifyEvaluateHalfImplies sort sideCondition first second + | OrPattern.isTrue first = return second + | OrPattern.isFalse first = return (Pattern.topOf sort) + | Pattern.isTop second = return (Pattern.topOf sort) + | Pattern.isBottom second = + Not.simplify sideCondition Not{notSort = sort, notChild = first} + >>= Logic.scatter + | otherwise = + case toList first of + [firstP] -> Logic.scatter $ makeEvaluateImplies firstP second + firstPatterns -> + distributeEvaluateImplies sideCondition firstPatterns second + >>= Logic.scatter distributeEvaluateImplies :: MonadSimplify simplifier => @@ -131,10 +124,7 @@ distributeEvaluateImplies :: Pattern RewritingVariableName -> simplifier (OrPattern RewritingVariableName) distributeEvaluateImplies sideCondition firsts second = - And.simplify - sort - (Not.notSimplifier sort) - sideCondition + (And.simplify sort Not.notSimplifier sideCondition) (MultiAnd.make implications) where sort = Pattern.patternSort second diff --git a/kore/src/Kore/Step/Simplification/In.hs b/kore/src/Kore/Step/Simplification/In.hs index 2a831faec2..6048a55ac6 100644 --- a/kore/src/Kore/Step/Simplification/In.hs +++ b/kore/src/Kore/Step/Simplification/In.hs @@ -98,9 +98,7 @@ makeEvaluateIn sideCondition first second | Pattern.isTop second = Ceil.makeEvaluate sideCondition first | Pattern.isBottom first || Pattern.isBottom second = return OrPattern.bottom | otherwise = - (And.makeEvaluate pattSort) - (Not.notSimplifier pattSort) - sideCondition + (And.makeEvaluate pattSort Not.notSimplifier sideCondition) (MultiAnd.make [first, second]) & OrPattern.observeAllT >>= Ceil.simplifyEvaluated sideCondition diff --git a/kore/src/Kore/Step/Simplification/Not.hs b/kore/src/Kore/Step/Simplification/Not.hs index 2a2100c581..a8333625dd 100644 --- a/kore/src/Kore/Step/Simplification/Not.hs +++ b/kore/src/Kore/Step/Simplification/Not.hs @@ -11,7 +11,6 @@ module Kore.Step.Simplification.Not ( makeEvaluate, makeEvaluatePredicate, simplify, - simplifyEvaluated, simplifyEvaluatedPredicate, notSimplifier, ) where @@ -82,42 +81,11 @@ simplify :: SideCondition RewritingVariableName -> Not Sort (OrPattern RewritingVariableName) -> simplifier (OrPattern RewritingVariableName) -simplify sideCondition Not{notChild, notSort} = - simplifyEvaluated sort sideCondition notChild - where - sort = notSort - -{- |'simplifyEvaluated' simplifies a 'Not' pattern given its -'OrPattern' child. - -See 'simplify' for details. --} - -{- TODO (virgil): Preserve pattern sorts under simplification. - -One way to preserve the required sort annotations is to make 'simplifyEvaluated' -take an argument of type - -> CofreeF (Not Sort) (Attribute.Pattern variable) (OrPattern variable) - -instead of an 'OrPattern' argument. The type of 'makeEvaluate' may -be changed analogously. The 'Attribute.Pattern' annotation will eventually -cache information besides the pattern sort, which will make it even more useful -to carry around. - --} -simplifyEvaluated :: - MonadSimplify simplifier => - Sort -> - SideCondition RewritingVariableName -> - OrPattern RewritingVariableName -> - simplifier (OrPattern RewritingVariableName) -simplifyEvaluated resultSort sideCondition simplified = +simplify sideCondition not'@Not{notSort} = OrPattern.observeAllT $ do - let not' = Not{notChild = simplified, notSort = ()} - andPattern <- - scatterAnd (MultiAnd.map makeEvaluateNot (distributeNot not')) - mkMultiAndPattern resultSort sideCondition andPattern + let evaluated = MultiAnd.map makeEvaluateNot (distributeNot not') + andPattern <- scatterAnd evaluated + mkMultiAndPattern notSort sideCondition andPattern simplifyEvaluatedPredicate :: MonadSimplify simplifier => @@ -233,7 +201,7 @@ mkMultiAndPattern :: SideCondition RewritingVariableName -> MultiAnd (Pattern RewritingVariableName) -> LogicT simplifier (Pattern RewritingVariableName) -mkMultiAndPattern resultSort = And.makeEvaluate resultSort (notSimplifier resultSort) +mkMultiAndPattern resultSort = And.makeEvaluate resultSort notSimplifier -- | Conjoin and simplify a 'MultiAnd' of 'Condition'. mkMultiAndPredicate :: @@ -244,9 +212,5 @@ mkMultiAndPredicate predicates = -- implements And semantics. return $ fold predicates -notSimplifier :: - MonadSimplify simplifier => - Sort -> - NotSimplifier simplifier -notSimplifier sort = - NotSimplifier (simplifyEvaluated sort) +notSimplifier :: MonadSimplify simplifier => NotSimplifier simplifier +notSimplifier = NotSimplifier simplify diff --git a/kore/src/Kore/Step/Simplification/NotSimplifier.hs b/kore/src/Kore/Step/Simplification/NotSimplifier.hs index e39c28238c..c0721173a7 100644 --- a/kore/src/Kore/Step/Simplification/NotSimplifier.hs +++ b/kore/src/Kore/Step/Simplification/NotSimplifier.hs @@ -15,10 +15,14 @@ import Kore.Internal.SideCondition ( import Kore.Rewriting.RewritingVariable ( RewritingVariableName, ) +import Kore.Syntax ( + Not, + Sort, + ) newtype NotSimplifier simplifier = NotSimplifier { runNotSimplifier :: SideCondition RewritingVariableName -> - OrPattern RewritingVariableName -> + Not Sort (OrPattern RewritingVariableName) -> simplifier (OrPattern RewritingVariableName) } diff --git a/kore/src/Kore/Step/Simplification/TermLike.hs b/kore/src/Kore/Step/Simplification/TermLike.hs index c37dfea701..c7a44211c4 100644 --- a/kore/src/Kore/Step/Simplification/TermLike.hs +++ b/kore/src/Kore/Step/Simplification/TermLike.hs @@ -369,7 +369,7 @@ simplify sideCondition = \termLike -> -- AndF andF -> do let conjuncts = foldMap MultiAnd.fromTermLike andF - (And.simplify termSort) (Not.notSimplifier termSort) sideCondition + (And.simplify termSort Not.notSimplifier sideCondition) =<< MultiAnd.traverse (simplifyTermLike sideCondition) conjuncts diff --git a/kore/src/Kore/Step/Step.hs b/kore/src/Kore/Step/Step.hs index 7d713c9af7..42300ee51b 100644 --- a/kore/src/Kore/Step/Step.hs +++ b/kore/src/Kore/Step/Step.hs @@ -145,10 +145,9 @@ unifyRule initial rule = do -- Unify the left-hand side of the rule with the term of the initial -- configuration. let ruleLeft = matchingPattern rule - let initialSort = Pattern.patternSort initial unification <- unificationProcedure sideCondition initialTerm ruleLeft - & evalEnvUnifierT (Not.notSimplifier initialSort) + & evalEnvUnifierT Not.notSimplifier -- Combine the unification solution with the rule's requirement clause, let ruleRequires = precondition rule requires' = Condition.fromPredicate ruleRequires diff --git a/kore/src/Kore/Unification/Procedure.hs b/kore/src/Kore/Unification/Procedure.hs index 9df7d37208..6dac3886fa 100644 --- a/kore/src/Kore/Unification/Procedure.hs +++ b/kore/src/Kore/Unification/Procedure.hs @@ -57,7 +57,7 @@ unificationProcedure sideCondition p1 p2 | p1Sort /= p2Sort = Monad.Unify.explainAndReturnBottom "Cannot unify different sorts." p1 p2 | otherwise = infoAttemptUnification p1 p2 $ do - pat <- termUnification (Not.notSimplifier p1Sort) p1 p2 + pat <- termUnification Not.notSimplifier p1 p2 TopBottom.guardAgainstBottom pat let (term, conditions) = Conditional.splitTerm pat orCeil <- makeEvaluateTermCeil sideCondition term From 2468aae8b0e4ea1dc5210f567fa8a3ab47ab24b5 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sat, 26 Jun 2021 14:59:38 -0500 Subject: [PATCH 12/74] Test.Kore.Step.Simplification: Use explicit sorts --- kore/test/Test/Kore/Step/Simplification/OrPattern.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/OrPattern.hs b/kore/test/Test/Kore/Step/Simplification/OrPattern.hs index 3328811f29..946cff9f96 100644 --- a/kore/test/Test/Kore/Step/Simplification/OrPattern.hs +++ b/kore/test/Test/Kore/Step/Simplification/OrPattern.hs @@ -38,8 +38,8 @@ import Test.Tasty.HUnit.Ext test_orPatternSimplification :: [TestTree] test_orPatternSimplification = [ testCase "Identity for top" $ do - actual <- runSimplifyPredicates makeTruePredicate OrPattern.top - assertEqual "" OrPattern.top actual + actual <- runSimplifyPredicates makeTruePredicate (OrPattern.top Mock.topSort) + assertEqual "" (OrPattern.top Mock.topSort) actual , testCase "Identity for bottom" $ do actual <- runSimplifyPredicates makeTruePredicate OrPattern.bottom assertEqual "" OrPattern.bottom actual From 623281986972a10fd8beec5b52a966d883c970c7 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 06:29:51 -0500 Subject: [PATCH 13/74] Test.Kore.Step.Simplification.Floor: Use explicit sorts --- .../Test/Kore/Step/Simplification/Floor.hs | 37 ++++++++++--------- 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/Floor.hs b/kore/test/Test/Kore/Step/Simplification/Floor.hs index a7d931c17c..5a620f6b57 100644 --- a/kore/test/Test/Kore/Step/Simplification/Floor.hs +++ b/kore/test/Test/Kore/Step/Simplification/Floor.hs @@ -14,11 +14,7 @@ import Kore.Internal.Pattern ( Conditional (..), Pattern, ) -import qualified Kore.Internal.Pattern as Pattern ( - bottom, - fromCondition, - top, - ) +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( makeAndPredicate, makeEqualsPredicate, @@ -41,6 +37,7 @@ import Test.Kore ( testId, ) import Test.Kore.Step.MockSymbols ( + subSort, testSort, ) import Test.Kore.Step.Simplification @@ -56,7 +53,7 @@ test_floorSimplification = "" ( OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop testSort , predicate = makeFloorPredicate (mkOr a b) , substitution = mempty } @@ -75,11 +72,11 @@ test_floorSimplification = assertEqual "floor(top)" ( OrPattern.fromPatterns - [Pattern.top] + [Pattern.topOf testSort] ) ( evaluate ( makeFloor - [Pattern.top] + [Pattern.topOf subSort] ) ) -- floor(bottom) = bottom @@ -99,7 +96,7 @@ test_floorSimplification = assertEqual "floor(top)" ( OrPattern.fromPatterns - [Pattern.top] + [Pattern.topOf testSort] ) ( evaluate ( makeFloor @@ -113,19 +110,19 @@ test_floorSimplification = assertEqual "floor(top)" ( OrPattern.fromPatterns - [Pattern.top] + [Pattern.topOf testSort] ) ( makeEvaluate - (Pattern.top :: Pattern RewritingVariableName) + testSort + (Pattern.topOf subSort :: Pattern RewritingVariableName) ) -- floor(bottom) = bottom assertEqual "floor(bottom)" - ( OrPattern.fromPatterns - [] - ) + OrPattern.bottom ( makeEvaluate - (Pattern.bottom :: Pattern RewritingVariableName) + testSort + (Pattern.bottomOf subSort :: Pattern RewritingVariableName) ) ) , testCase @@ -136,7 +133,7 @@ test_floorSimplification = "floor(top)" ( OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop testSort , predicate = makeAndPredicate (makeFloorPredicate a) @@ -149,6 +146,7 @@ test_floorSimplification = ] ) ( makeEvaluate + testSort Conditional { term = a , predicate = makeEqualsPredicate fOfA gOfA @@ -211,5 +209,8 @@ evaluate :: OrPattern RewritingVariableName evaluate = simplify . fmap simplifiedOrPattern -makeEvaluate :: Pattern RewritingVariableName -> OrPattern RewritingVariableName -makeEvaluate = makeEvaluateFloor . simplifiedPattern +makeEvaluate :: + Sort -> + Pattern RewritingVariableName -> + OrPattern RewritingVariableName +makeEvaluate sort = makeEvaluateFloor sort . simplifiedPattern From e49b86ee731b533288da404bf1ef4bbf4bdb0591 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 06:38:43 -0500 Subject: [PATCH 14/74] Test.Kore.Step.Simplification.Equals: Use explicit sorts --- .../Test/Kore/Step/Simplification/Equals.hs | 203 +++++++----------- 1 file changed, 82 insertions(+), 121 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/Equals.hs b/kore/test/Test/Kore/Step/Simplification/Equals.hs index ce1474fa8a..c30ee01cab 100644 --- a/kore/test/Test/Kore/Step/Simplification/Equals.hs +++ b/kore/test/Test/Kore/Step/Simplification/Equals.hs @@ -22,6 +22,7 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Conditional +import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( makeAndPredicate, makeCeilPredicate, @@ -30,7 +31,6 @@ import Kore.Internal.Predicate ( makeImpliesPredicate, makeNotPredicate, makeTruePredicate, - pattern PredicateFalse, ) import qualified Kore.Internal.SideCondition as SideCondition ( top, @@ -46,8 +46,8 @@ import Kore.Step.Simplification.Equals ( makeEvaluateTermsToPredicate, simplify, ) -import Kore.Unparser import Prelude.Kore +import qualified Pretty import qualified Test.Kore.Step.MockSymbols as Mock import Test.Kore.Step.Simplification import Test.Tasty @@ -56,7 +56,7 @@ import Test.Tasty.HUnit.Ext test_equalsSimplification_Or_Pattern :: [TestTree] test_equalsSimplification_Or_Pattern = [ testCase "bottom == bottom" $ do - let expect = OrPattern.fromPatterns [Conditional.top] + let expect = OrPattern.top testSort actual <- evaluateOr Equals @@ -67,7 +67,7 @@ test_equalsSimplification_Or_Pattern = } assertEqual "" expect actual , testCase "a == a" $ do - let expect = OrPattern.fromPatterns [Conditional.top] + let expect = OrPattern.top testSort actual <- evaluateOr Equals @@ -113,7 +113,7 @@ test_equalsSimplification_Or_Pattern = let expect = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop testSort , predicate = makeEqualsPredicate fOfA gOfA , substitution = mempty } @@ -143,47 +143,32 @@ test_equalsSimplification_Or_Pattern = assertEqual "" expect actual , testCase "f vs g or h" $ do let expectEvaluateEquals = - OrPattern.fromPatterns - [ Conditional - { term = mkTop_ - , predicate = - (MultiAnd.toPredicate . MultiAnd.make) - [ makeCeilPredicate Mock.cf - , makeCeilPredicate Mock.cg - , makeImpliesPredicate - (makeCeilPredicate Mock.cg) - (makeEqualsPredicate Mock.cf Mock.cg) - , makeImpliesPredicate - (makeCeilPredicate Mock.ch) - (makeEqualsPredicate Mock.cf Mock.ch) - ] - , substitution = mempty - } - , Conditional - { term = mkTop_ - , predicate = - (MultiAnd.toPredicate . MultiAnd.make) - [ makeCeilPredicate Mock.cf - , makeCeilPredicate Mock.ch - , makeImpliesPredicate - (makeCeilPredicate Mock.cg) - (makeEqualsPredicate Mock.cf Mock.cg) - , makeImpliesPredicate - (makeCeilPredicate Mock.ch) - (makeEqualsPredicate Mock.cf Mock.ch) - ] - , substitution = mempty - } - , Conditional - { term = mkTop_ - , predicate = - (MultiAnd.toPredicate . MultiAnd.make) - [ makeNotPredicate $ makeCeilPredicate Mock.cf - , makeNotPredicate $ makeCeilPredicate Mock.cg - , makeNotPredicate $ makeCeilPredicate Mock.ch - ] - , substitution = mempty - } + (OrPattern.fromPatterns . map (Pattern.fromCondition testSort)) + [ (Condition.fromPredicate . MultiAnd.toPredicate . MultiAnd.make) + [ makeCeilPredicate Mock.cf + , makeCeilPredicate Mock.cg + , makeImpliesPredicate + (makeCeilPredicate Mock.cg) + (makeEqualsPredicate Mock.cf Mock.cg) + , makeImpliesPredicate + (makeCeilPredicate Mock.ch) + (makeEqualsPredicate Mock.cf Mock.ch) + ] + , (Condition.fromPredicate . MultiAnd.toPredicate . MultiAnd.make) + [ makeCeilPredicate Mock.cf + , makeCeilPredicate Mock.ch + , makeImpliesPredicate + (makeCeilPredicate Mock.cg) + (makeEqualsPredicate Mock.cf Mock.cg) + , makeImpliesPredicate + (makeCeilPredicate Mock.ch) + (makeEqualsPredicate Mock.cf Mock.ch) + ] + , (Condition.fromPredicate . MultiAnd.toPredicate . MultiAnd.make) + [ makeNotPredicate $ makeCeilPredicate Mock.cf + , makeNotPredicate $ makeCeilPredicate Mock.cg + , makeNotPredicate $ makeCeilPredicate Mock.ch + ] ] first = OrPattern.fromPatterns @@ -218,43 +203,28 @@ test_equalsSimplification_Or_Pattern = } , testCase "f vs g or h where f /= g" $ do let expectEvaluateEquals = - OrPattern.fromPatterns - [ Conditional - { term = mkTop_ - , predicate = - (MultiAnd.toPredicate . MultiAnd.make) - [ makeCeilPredicate Mock.cf - , makeCeilPredicate Mock.cg - , makeImpliesPredicate - (makeCeilPredicate Mock.ch) - (makeEqualsPredicate Mock.cf Mock.ch) - , makeNotPredicate (makeCeilPredicate Mock.cg) - ] - , substitution = mempty - } - , Conditional - { term = mkTop_ - , predicate = - (MultiAnd.toPredicate . MultiAnd.make) - [ makeCeilPredicate Mock.cf - , makeCeilPredicate Mock.ch - , makeImpliesPredicate - (makeCeilPredicate Mock.ch) - (makeEqualsPredicate Mock.cf Mock.ch) - , makeNotPredicate $ makeCeilPredicate Mock.cg - ] - , substitution = mempty - } - , Conditional - { term = mkTop_ - , predicate = - (MultiAnd.toPredicate . MultiAnd.make) - [ makeNotPredicate $ makeCeilPredicate Mock.cf - , makeNotPredicate $ makeCeilPredicate Mock.cg - , makeNotPredicate $ makeCeilPredicate Mock.ch - ] - , substitution = mempty - } + (OrPattern.fromPatterns . map (Pattern.fromCondition testSort)) + [ (Condition.fromPredicate . MultiAnd.toPredicate . MultiAnd.make) + [ makeCeilPredicate Mock.cf + , makeCeilPredicate Mock.cg + , makeImpliesPredicate + (makeCeilPredicate Mock.ch) + (makeEqualsPredicate Mock.cf Mock.ch) + , makeNotPredicate (makeCeilPredicate Mock.cg) + ] + , (Condition.fromPredicate . MultiAnd.toPredicate . MultiAnd.make) + [ makeCeilPredicate Mock.cf + , makeCeilPredicate Mock.ch + , makeImpliesPredicate + (makeCeilPredicate Mock.ch) + (makeEqualsPredicate Mock.cf Mock.ch) + , makeNotPredicate $ makeCeilPredicate Mock.cg + ] + , (Condition.fromPredicate . MultiAnd.toPredicate . MultiAnd.make) + [ makeNotPredicate $ makeCeilPredicate Mock.cf + , makeNotPredicate $ makeCeilPredicate Mock.cg + , makeNotPredicate $ makeCeilPredicate Mock.ch + ] ] first = OrPattern.fromPatterns @@ -322,9 +292,9 @@ test_equalsSimplification_Or_Pattern = } ] expectEvaluateEquals = - OrPattern.fromPatterns + (OrPattern.fromPatterns . map (Pattern.fromCondition testSort)) [ Conditional - { term = mkTop_ + { term = () , predicate = (MultiAnd.toPredicate . MultiAnd.make) [ definedF @@ -341,7 +311,7 @@ test_equalsSimplification_Or_Pattern = [(inject Mock.xConfig, Mock.a)] } , Conditional - { term = mkTop_ + { term = () , predicate = (MultiAnd.toPredicate . MultiAnd.make) [ definedF @@ -356,7 +326,7 @@ test_equalsSimplification_Or_Pattern = , substitution = mempty } , Conditional - { term = mkTop_ + { term = () , predicate = (MultiAnd.toPredicate . MultiAnd.make) [ makeNotPredicate definedGWithSubstitution @@ -384,7 +354,7 @@ test_equalsSimplification_Pattern = let expect = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop testSort , predicate = makeIffPredicate (makeEqualsPredicate fOfA fOfB) @@ -395,12 +365,12 @@ test_equalsSimplification_Pattern = actual <- evaluate Conditional - { term = mkTop_ + { term = mkTop testSort , predicate = makeEqualsPredicate fOfA fOfB , substitution = mempty } Conditional - { term = mkTop_ + { term = mkTop testSort , predicate = makeEqualsPredicate gOfA gOfB , substitution = mempty } @@ -409,7 +379,7 @@ test_equalsSimplification_Pattern = let expect = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop testSort , predicate = makeIffPredicate (makeEqualsPredicate fOfA fOfB) @@ -432,9 +402,9 @@ test_equalsSimplification_Pattern = assertEqual "" expect actual , testCase "constructor-patt vs constructor-patt" $ do let expect = - OrPattern.fromPatterns + (OrPattern.fromPatterns . map (Pattern.fromCondition testSort)) [ Conditional - { term = mkTop_ + { term = () , predicate = (MultiAnd.toPredicate . MultiAnd.make) [ makeCeilPredicate hOfA @@ -446,7 +416,7 @@ test_equalsSimplification_Pattern = , substitution = mempty } , Conditional - { term = mkTop_ + { term = () , predicate = makeAndPredicate ( makeNotPredicate @@ -485,8 +455,8 @@ test_equalsSimplification_TermLike = "bottom == bottom" ( assertTermEquals Condition.topCondition - mkBottom_ - mkBottom_ + (mkBottom testSort) + (mkBottom testSort) ) , testCase "domain-value == domain-value" @@ -540,7 +510,7 @@ test_equalsSimplification_TermLike = "a != bottom" ( assertTermEquals Condition.bottomCondition - mkBottom_ + (mkBottom testSort) Mock.a ) , testCase @@ -1023,15 +993,18 @@ assertBidirectionalEqualityResult actualEvaluateEquals <- evaluateOr orderedEquality let assertEqual' name expect actual = let message = - unlines - [ firstName ++ " vs " ++ secondName ++ ":" - , "Expected " <> name - , unparseToString - (OrPattern.toTermLike <$> orderedEquality) - , "would simplify to:" - , unlines (unparseToString <$> toList expect) - , "but instead found:" - , unlines (unparseToString <$> toList actual) + (show . Pretty.vsep) + [ Pretty.hsep + [ Pretty.pretty firstName + , "vs" + , Pretty.pretty secondName <> Pretty.colon + ] + , "Expected" Pretty.<+> name + , (Pretty.indent 4) (Pretty.pretty orderedEquality) + , "would simplify to" + , (Pretty.indent 4) (Pretty.pretty expect) + , "but instead found" + , (Pretty.indent 4) (Pretty.pretty actual) ] in assertEqual message expect actual assertEqual' @@ -1073,7 +1046,7 @@ assertTermEqualsMultiGeneric :: assertTermEqualsMultiGeneric expectPure first second = do let expectExpanded = OrPattern.fromPatterns - (map predSubstToPattern expectPure) + (map (Pattern.fromCondition testSort) expectPure) actualExpanded <- evaluate (termToPattern first) (termToPattern second) assertEqual "Pattern" @@ -1087,26 +1060,14 @@ assertTermEqualsMultiGeneric expectPure first second = do where termToPattern :: TermLike RewritingVariableName -> Pattern RewritingVariableName - termToPattern (Bottom_ _) = - Conditional.bottom + termToPattern (Bottom_ sort) = + Conditional.bottomOf sort termToPattern term = Conditional { term = term , predicate = makeTruePredicate , substitution = mempty } - predSubstToPattern :: - Condition RewritingVariableName -> Pattern RewritingVariableName - predSubstToPattern - Conditional{predicate = PredicateFalse} = - Conditional.bottom - predSubstToPattern - Conditional{predicate, substitution} = - Conditional - { term = mkTop_ - , predicate = predicate - , substitution = substitution - } fOfA :: TermLike RewritingVariableName fOfA = Mock.f Mock.a From 8bb8a1950ca73982eea297b26c1706fb58aaec51 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 06:42:15 -0500 Subject: [PATCH 15/74] Add instance Pretty (Pattern _) --- kore/src/Kore/Internal/Conditional.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/kore/src/Kore/Internal/Conditional.hs b/kore/src/Kore/Internal/Conditional.hs index d4bd2b5980..a5a20bb377 100644 --- a/kore/src/Kore/Internal/Conditional.hs +++ b/kore/src/Kore/Internal/Conditional.hs @@ -322,6 +322,20 @@ instance Substitution.singleSubstitutionToPredicate <$> Substitution.unwrap substitution +instance + InternalVariable variable => + Pretty (Conditional variable (TermLike variable)) + where + pretty Conditional{term, predicate, substitution} = + prettyConditional' + (unparse term) + (pretty predicate) + (pretty <$> termLikeSubstitution) + where + termLikeSubstitution = + Substitution.singleSubstitutionToPredicate + <$> Substitution.unwrap substitution + instance ( InternalVariable variable , SQL.Column term From b07a43b2c273cc911a3406ecde27cd6ea59e2c33 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:05:58 -0500 Subject: [PATCH 16/74] Test.Kore.Step.Simplification.AndTerms: Use explicit sorts --- .../Test/Kore/Step/Simplification/AndTerms.hs | 58 +++++++++---------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/AndTerms.hs b/kore/test/Test/Kore/Step/Simplification/AndTerms.hs index fa91f17ed4..d7934c8cf9 100644 --- a/kore/test/Test/Kore/Step/Simplification/AndTerms.hs +++ b/kore/test/Test/Kore/Step/Simplification/AndTerms.hs @@ -81,25 +81,19 @@ test_andTermsSimplification = "Predicates" [ testCase "\\and{s}(f{}(a), \\top{s}())" $ do let expected = Pattern.fromTermLike fOfA - actual <- simplifyUnify fOfA mkTop_ + actual <- simplifyUnify fOfA (mkTop Mock.testSort) assertEqual "" ([expected], [expected]) actual , testCase "\\and{s}(\\top{s}(), f{}(a))" $ do let expected = Pattern.fromTermLike fOfA - actual <- simplifyUnify mkTop_ fOfA + actual <- simplifyUnify (mkTop Mock.testSort) fOfA assertEqual "" ([expected], [expected]) actual , testCase "\\and{s}(f{}(a), \\bottom{s}())" $ do - let expect = - ( [Pattern.bottom] - , [Pattern.bottom] - ) - actual <- simplifyUnify fOfA mkBottom_ + let expect = ([], []) + actual <- simplifyUnify fOfA (mkBottom Mock.testSort) assertEqual "" expect actual , testCase "\\and{s}(\\bottom{s}(), f{}(a))" $ do - let expect = - ( [Pattern.bottom] - , [Pattern.bottom] - ) - actual <- simplifyUnify mkBottom_ fOfA + let expect = ([], []) + actual <- simplifyUnify (mkBottom Mock.testSort) fOfA assertEqual "" expect actual ] , testCase "equal patterns and" $ do @@ -933,7 +927,7 @@ test_andTermsSimplification = , testCase "different lengths" $ do let term7 = Mock.builtinList [Mock.a, Mock.a] term8 = Mock.builtinList [Mock.a] - expect = [Pattern.bottom] + expect = [] actual <- unify term7 term8 assertEqual "" expect actual , testCase "fallback for external List symbols" $ do @@ -1123,29 +1117,41 @@ test_andTermsSimplification = "alias expansion" [ testCase "alias() vs top" $ do let x = mkVariable "x" - alias = mkAlias' "alias1" x mkTop_ + alias = mkAlias' "alias1" x $ mkTop Mock.testSort left = applyAlias' alias $ mkTop Mock.testSort & mkRewritingTerm - actual <- simplifyUnify left mkTop_ - assertExpectTop actual + actual <- simplifyUnify left (mkTop Mock.testSort) + let expect = + ( [Pattern.topOf Mock.testSort] + , [Pattern.topOf Mock.testSort] + ) + assertEqual "" expect actual , testCase "alias1() vs alias2()" $ do let x = mkVariable "x" - leftAlias = mkAlias' "leftAlias" x mkTop_ + leftAlias = mkAlias' "leftAlias" x $ mkTop Mock.testSort left = applyAlias' leftAlias $ mkTop Mock.testSort - rightAlias = mkAlias' "rightAlias" x mkTop_ + rightAlias = mkAlias' "rightAlias" x $ mkTop Mock.testSort right = applyAlias' rightAlias $ mkTop Mock.testSort actual <- simplifyUnify left right - assertExpectTop actual + let expect = + ( [Pattern.topOf Mock.testSort] + , [Pattern.topOf Mock.testSort] + ) + assertEqual "" expect actual , testCase "alias1(alias2()) vs top" $ do let x = mkVariable "x" y = mkVariable "y" - alias1 = mkAlias' "alias1" x mkTop_ + alias1 = mkAlias' "alias1" x (mkTop Mock.testSort) alias1App = applyAlias' alias1 $ mkSetVar (SetVariableName <$> y) alias2 = mkAlias' "alias2" x alias1App alias2App = applyAlias' alias2 $ mkTop Mock.testSort - actual <- simplifyUnify alias2App mkTop_ - assertExpectTop actual + expect = + ( [Pattern.topOf Mock.testSort] + , [Pattern.topOf Mock.testSort] + ) + actual <- simplifyUnify alias2App (mkTop $ termLikeSort alias2App) + assertEqual "" expect actual , testCase "alias1() vs injHead" $ do let expect = Conditional @@ -1245,7 +1251,7 @@ test_andTermsSimplification = , testCase "And unification" $ do let input1 = Mock.keqBool (cf xVar) a input2 = Mock.builtinBool False - expected = [Pattern.top] + expected = [Pattern.topOf Mock.boolSort] actual <- simplify input1 input2 assertEqual "" expected actual , testCase @@ -1302,12 +1308,6 @@ applyAlias' :: TermLike variable applyAlias' alias arg = applyAlias alias [] [arg] -assertExpectTop :: - ([Pattern RewritingVariableName], [Pattern RewritingVariableName]) -> - IO () -assertExpectTop = - assertEqual "" ([Pattern.top], [Pattern.top]) - test_equalsTermsSimplification :: [TestTree] test_equalsTermsSimplification = [ testCase "adds ceil when producing substitutions" $ do From 96d2b4cfa55b8b7c2437e766ca36665d82031cf9 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:08:40 -0500 Subject: [PATCH 17/74] Test.Kore.Builtin.Int: Use explicit sorts --- kore/test/Test/Kore/Builtin/Int.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Int.hs b/kore/test/Test/Kore/Builtin/Int.hs index 160473d3e4..0b323f494f 100644 --- a/kore/test/Test/Kore/Builtin/Int.hs +++ b/kore/test/Test/Kore/Builtin/Int.hs @@ -400,12 +400,13 @@ test_euclidian_division_theorem = (asInternal <$> [a, b]) & evaluateT & fmap extractValue + extractValue :: OrPattern RewritingVariableName -> Integer - extractValue (OrPattern.toTermLike -> term) = + extractValue (OrPattern.toTermLike intSort -> term) = case term of InternalInt_ InternalInt{internalIntValue} -> internalIntValue - _ -> error "Expecting builtin int." + _ -> error "Expecting builtin Int" -- Bitwise operations test_and :: TestTree @@ -485,7 +486,7 @@ test_unifyEqual_NotEqual = testCaseWithoutSMT "unifyEqual BuiltinInteger: Not Equal" $ do let dv1 = asInternal 1 dv2 = asInternal 2 - actual <- evaluate $ mkEquals_ dv1 dv2 + actual <- evaluate $ mkEquals kSort dv1 dv2 assertEqual' "" OrPattern.bottom actual -- | "\equal"ed internal Integers that are equal @@ -493,8 +494,8 @@ test_unifyEqual_Equal :: TestTree test_unifyEqual_Equal = testCaseWithoutSMT "unifyEqual BuiltinInteger: Equal" $ do let dv1 = asInternal 2 - actual <- evaluate $ mkEquals_ dv1 dv1 - assertEqual' "" OrPattern.top actual + actual <- evaluate $ mkEquals kSort dv1 dv1 + assertEqual' "" (OrPattern.top kSort) actual -- | "\and"ed internal Integers that are not equal test_unifyAnd_NotEqual :: TestTree @@ -518,8 +519,8 @@ test_unifyAndEqual_Equal :: TestTree test_unifyAndEqual_Equal = testCaseWithoutSMT "unifyAnd BuiltinInteger: Equal" $ do let dv = asInternal 0 - actual <- evaluate $ mkEquals_ dv $ mkAnd dv dv - assertEqual' "" OrPattern.top actual + actual <- evaluate $ mkEquals kSort dv $ mkAnd dv dv + assertEqual' "" (OrPattern.top kSort) actual -- | Internal Integer "\and"ed with builtin function applied to variable test_unifyAnd_Fn :: TestTree @@ -574,7 +575,7 @@ test_unifyIntEq = makeEqualsPredicate (mkElemVar x) (mkElemVar y) & makeNotPredicate & Condition.fromPredicate - & Pattern.fromCondition_ + & Pattern.fromCondition boolSort -- unit test do actual <- unifyIntEq term1 term2 @@ -591,7 +592,7 @@ test_unifyIntEq = term2 = eqInt (mkElemVar x) (mkElemVar y) expect = Condition.assign (inject x) (mkElemVar y) - & Pattern.fromCondition_ + & Pattern.fromCondition boolSort -- unit test do actual <- unifyIntEq term1 term2 @@ -618,7 +619,7 @@ test_unifyIntEq = (addInt (mkElemVar y) (asInternal 1)) & makeNotPredicate & Condition.fromPredicate - & Pattern.fromCondition_ + & Pattern.fromCondition boolSort -- unit test do actual <- unifyIntEq term1 term2 From 41ff9fad2db79d211f23f881ae618472db59f4f2 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:09:25 -0500 Subject: [PATCH 18/74] Test.Kore.Exec: Use explicit sorts --- kore/test/Test/Kore/Exec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Exec.hs b/kore/test/Test/Kore/Exec.hs index 292c690ab6..7bb14f195d 100644 --- a/kore/test/Test/Kore/Exec.hs +++ b/kore/test/Test/Kore/Exec.hs @@ -558,7 +558,7 @@ applyAliasToNoArgs sort name = , aliasParams = [] , aliasSorts = applicationSorts [] sort , aliasLeft = [] - , aliasRight = mkTop_ + , aliasRight = mkTop sort } [] From 29e63222552e97d2e846979c9ffb61ccaacf6f24 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:10:36 -0500 Subject: [PATCH 19/74] Test.Kore.Internal.Pattern: Use explicit sorts --- kore/test/Test/Kore/Internal/Pattern.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/kore/test/Test/Kore/Internal/Pattern.hs b/kore/test/Test/Kore/Internal/Pattern.hs index c9d3063415..37acda754f 100644 --- a/kore/test/Test/Kore/Internal/Pattern.hs +++ b/kore/test/Test/Kore/Internal/Pattern.hs @@ -226,7 +226,7 @@ test_hasSimplifiedChildren = (setSimplifiedPred simplified mockPredicate2) ) patt = - Pattern.fromCondition_ + Pattern.fromCondition Mock.testSort . Condition.fromPredicate $ predicate assertEqual @@ -247,7 +247,7 @@ test_hasSimplifiedChildren = (setSimplifiedPred simplified mockPredicate2) ) patt = - Pattern.fromCondition_ + Pattern.fromCondition Mock.testSort . Condition.fromPredicate $ predicate assertEqual @@ -285,7 +285,7 @@ test_hasSimplifiedChildren = (setSimplifiedPred simplified mockPredicate1) (setSimplifiedPred simplified mockPredicate2) patt = - Pattern.fromCondition_ + Pattern.fromCondition Mock.testSort . Condition.fromPredicate $ predicate assertEqual @@ -309,17 +309,17 @@ test_hasSimplifiedChildren = ( Predicate.makeFloorPredicate ( Mock.functional20 (mkNu Mock.setX Mock.c) - (Mock.functionalConstr10 mkTop_) + (Mock.functionalConstr10 (mkTop Mock.testSort)) ) & Predicate.setSimplified fullySimplified ) ( Predicate.makeCeilPredicate - (Mock.tdivInt mkTop_ mkTop_) + (Mock.tdivInt (mkTop Mock.intSort) (mkTop Mock.intSort)) & Predicate.setSimplified fullySimplified ) & Predicate.setSimplified partiallySimplified patt = - Pattern.fromCondition_ + Pattern.fromCondition Mock.testSort . Condition.fromPredicate $ predicate assertEqual From 2427530b113b2168cf6fdafdd191e9b00fd8c537 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:11:16 -0500 Subject: [PATCH 20/74] Test.Kore.Equation.Application: Use explicit sorts --- kore/test/Test/Kore/Equation/Application.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Equation/Application.hs b/kore/test/Test/Kore/Equation/Application.hs index 6c61b148e2..6ce9d0a33b 100644 --- a/kore/test/Test/Kore/Equation/Application.hs +++ b/kore/test/Test/Kore/Equation/Application.hs @@ -249,7 +249,7 @@ test_attemptEquation = "F(x) => G(x) doesn't apply to F(top)" (axiom_ (f x) (g x)) SideCondition.top - (f mkTop_) + (f (mkTop Mock.testSort)) , applies "F(x) => G(x) [concrete] applies to F(a)" (axiom_ (f x) (g x) & concrete [x]) @@ -436,7 +436,7 @@ test_attemptEquationUnification = "F(x) => G(x) doesn't apply to F(top)" (functionAxiomUnification_ fSymbol [x] (g x)) SideCondition.top - (f mkTop_) + (f (mkTop Mock.testSort)) , applies "F(x) => G(x) [concrete] applies to F(a)" (functionAxiomUnification_ fSymbol [x] (g x) & concrete [x]) From 8ee4b65e67d732b792afc9150f37c5d252d0a906 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:12:05 -0500 Subject: [PATCH 21/74] Test.Kore.Internal.OrPattern: Use explicit sorts --- kore/test/Test/Kore/Internal/OrPattern.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/Internal/OrPattern.hs b/kore/test/Test/Kore/Internal/OrPattern.hs index b29bf714ae..aff3116557 100644 --- a/kore/test/Test/Kore/Internal/OrPattern.hs +++ b/kore/test/Test/Kore/Internal/OrPattern.hs @@ -122,7 +122,7 @@ test_distributeAnd = , testCase "\\top and (a or b) => a or b " $ do let conjunction = MultiAnd.make - [ MultiOr.singleton TermLike.mkTop_ + [ MultiOr.singleton (TermLike.mkTop Mock.testSort) , MultiOr.make [a, b] ] expect = @@ -135,7 +135,7 @@ test_distributeAnd = let conjunction = MultiAnd.make [ MultiOr.singleton a - , MultiOr.make [b, TermLike.mkBottom_] + , MultiOr.make [b, TermLike.mkBottom Mock.testSort] ] expect = MultiOr.make @@ -197,7 +197,7 @@ test_distributeApplication = let app = sigma2 [ MultiOr.singleton a - , MultiOr.make [b, TermLike.mkBottom_] + , MultiOr.make [b, TermLike.mkBottom Mock.testSort] ] expect = MultiOr.make From 0f29ed637d8b0c45950625d34d9f17c00a813ae6 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:13:07 -0500 Subject: [PATCH 22/74] Test.Kore.Builtin.KEqual: Use explicit sorts --- kore/test/Test/Kore/Builtin/KEqual.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/KEqual.hs b/kore/test/Test/Kore/Builtin/KEqual.hs index 9feac25dc7..0815ff047f 100644 --- a/kore/test/Test/Kore/Builtin/KEqual.hs +++ b/kore/test/Test/Kore/Builtin/KEqual.hs @@ -83,11 +83,12 @@ test_KEqual = actual <- evaluate original assertEqual' "" expect actual , testCaseWithoutSMT "kseq(x, dotk) equals kseq(x, dotk)" $ do - let expect = OrPattern.top + let expect = OrPattern.top kSort xConfigElemVarKItemSort = configElementVariableFromId "x" kItemSort original = - mkEquals_ + mkEquals + kSort (Test.Bool.asInternal True) ( keqBool (kseq (mkElemVar xConfigElemVarKItemSort) dotk) @@ -96,11 +97,12 @@ test_KEqual = actual <- evaluate original assertEqual' "" expect actual , testCaseWithoutSMT "kseq(inj(x), dotk) equals kseq(inj(x), dotk)" $ do - let expect = OrPattern.top + let expect = OrPattern.top kSort xConfigElemVarIdSort = configElementVariableFromId "x" idSort original = - mkEquals_ + mkEquals + kSort (Test.Bool.asInternal True) ( keqBool (kseq (inj kItemSort (mkElemVar xConfigElemVarIdSort)) dotk) @@ -109,9 +111,10 @@ test_KEqual = actual <- evaluate original assertEqual' "" expect actual , testCaseWithoutSMT "distinct constructor-like terms" $ do - let expect = OrPattern.top + let expect = OrPattern.top kSort original = - mkEquals_ + mkEquals + kSort (Test.Bool.asInternal False) ( keqBool (kseq (inj kItemSort dvX) dotk) @@ -192,7 +195,7 @@ test_KEqualSimplification = keqBool (kseq (inj kItemSort dvX) dotk) (kseq (inj kItemSort dvT) dotk) - expect = [Just Pattern.top] + expect = [Just (Pattern.topOf kSort)] actual <- runKEqualSimplification term1 term2 assertEqual' "" expect actual ] From 35121a463f8b7c687dac98fc46e81f6b64e1d9a3 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:17:53 -0500 Subject: [PATCH 23/74] Test.Kore.Builtin.List: Use explicit sorts --- kore/test/Test/Kore/Builtin/Builtin.hs | 10 ++++ kore/test/Test/Kore/Builtin/List.hs | 73 ++++++++++++-------------- 2 files changed, 45 insertions(+), 38 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index c9ddada39a..d733dcdbc8 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -11,6 +11,7 @@ module Test.Kore.Builtin.Builtin ( simplify, evaluate, evaluateT, + evaluateExpectTopK, evaluateToList, indexedModule, verifiedModule, @@ -60,6 +61,7 @@ import Kore.Internal.InternalSet import Kore.Internal.OrPattern ( OrPattern, ) +import qualified Kore.Internal.OrPattern as OrPattern import Kore.Internal.Pattern ( Pattern, ) @@ -255,6 +257,14 @@ evaluateT :: t smt (OrPattern RewritingVariableName) evaluateT = lift . evaluate +evaluateExpectTopK :: + (MonadSMT smt, MonadLog smt, MonadProf smt, MonadMask smt) => + TermLike RewritingVariableName -> + Hedgehog.PropertyT smt () +evaluateExpectTopK termLike = do + actual <- evaluateT termLike + OrPattern.top kSort Hedgehog.=== actual + evaluateToList :: TermLike RewritingVariableName -> NoSMT [Pattern RewritingVariableName] diff --git a/kore/test/Test/Kore/Builtin/List.hs b/kore/test/Test/Kore/Builtin/List.hs index 085a2acea4..af0f7cb406 100644 --- a/kore/test/Test/Kore/Builtin/List.hs +++ b/kore/test/Test/Kore/Builtin/List.hs @@ -82,9 +82,9 @@ test_getUnit = [ mkApplySymbol unitListSymbol [] , Test.Int.asInternal k ] - predicate = mkEquals_ mkBottom_ patGet + predicate = mkEquals kSort (mkBottom intSort) patGet (===) OrPattern.bottom =<< evaluateT patGet - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_getFirstElement :: TestTree test_getFirstElement = @@ -102,11 +102,11 @@ test_getFirstElement = case values of Seq.Empty -> Nothing v Seq.:<| _ -> Just v - patFirst = maybe mkBottom_ Test.Int.asInternal value - predicate = mkEquals_ patGet patFirst + patFirst = maybe (mkBottom intSort) Test.Int.asInternal value + predicate = mkEquals kSort patGet patFirst let expectGet = Test.Int.asPartialPattern value (===) (MultiOr.singleton expectGet) =<< evaluateT patGet - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_getLastElement :: TestTree test_getLastElement = @@ -125,11 +125,11 @@ test_getLastElement = case values of Seq.Empty -> Nothing _ Seq.:|> v -> Just v - patFirst = maybe mkBottom_ Test.Int.asInternal value - predicate = mkEquals_ patGet patFirst + patFirst = maybe (mkBottom intSort) Test.Int.asInternal value + predicate = mkEquals kSort patGet patFirst let expectGet = Test.Int.asPartialPattern value (===) (MultiOr.singleton expectGet) =<< evaluateT patGet - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_GetUpdate :: TestTree test_GetUpdate = @@ -147,17 +147,14 @@ test_GetUpdate = if 0 <= ix && ix < len then do let patGet = getList patUpdated $ Test.Int.asInternal ix - predicate = - mkEquals_ - patGet - value + predicate = mkEquals kSort patGet value expect = Pattern.fromTermLike value - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate (===) (MultiOr.singleton expect) =<< evaluateT patGet else do - let predicate = mkEquals_ mkBottom_ patUpdated + let predicate = mkEquals kSort (mkBottom listSort) patUpdated (===) OrPattern.bottom =<< evaluateT patUpdated - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_inUnit :: TestTree test_inUnit = @@ -170,9 +167,9 @@ test_inUnit = let patValue = Test.Int.asInternal value patIn = inList patValue unitList patFalse = Test.Bool.asInternal False - predicate = mkEquals_ patFalse patIn + predicate = mkEquals kSort patFalse patIn (===) (Test.Bool.asOrPattern False) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_inElement :: TestTree test_inElement = @@ -186,9 +183,9 @@ test_inElement = patElement = elementList patValue patIn = inList patValue patElement patTrue = Test.Bool.asInternal True - predicate = mkEquals_ patIn patTrue + predicate = mkEquals kSort patIn patTrue (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_inConcat :: TestTree test_inConcat = @@ -205,9 +202,9 @@ test_inConcat = patConcat = concatList patValues patElement patIn = inList patValue patConcat patTrue = Test.Bool.asInternal True - predicate = mkEquals_ patIn patTrue + predicate = mkEquals kSort patIn patTrue (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_concatUnit :: TestTree test_concatUnit = @@ -221,13 +218,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 + predicate1 = mkEquals kSort patValues patConcat1 + predicate2 = mkEquals kSort patValues patConcat2 expectValues <- evaluateT patValues (===) expectValues =<< evaluateT patConcat1 (===) expectValues =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + evaluateExpectTopK predicate1 + evaluateExpectTopK predicate2 test_concatUnitSymbolic :: TestTree test_concatUnitSymbolic = @@ -241,13 +238,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 + predicate1 = mkEquals kSort patSymbolic patConcat1 + predicate2 = mkEquals kSort patSymbolic patConcat2 expectSymbolic <- evaluateT patSymbolic (===) expectSymbolic =<< evaluateT patConcat1 (===) expectSymbolic =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + evaluateExpectTopK predicate1 + evaluateExpectTopK predicate2 test_concatAssociates :: TestTree test_concatAssociates = @@ -268,11 +265,11 @@ test_concatAssociates = mkApplySymbol concatListSymbol [patConcat12, patList3] patConcat1_23 = mkApplySymbol concatListSymbol [patList1, patConcat23] - predicate = mkEquals_ patConcat12_3 patConcat1_23 + predicate = mkEquals kSort patConcat12_3 patConcat1_23 evalConcat12_3 <- evaluateT patConcat12_3 evalConcat1_23 <- evaluateT patConcat1_23 (===) evalConcat12_3 evalConcat1_23 - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate test_concatSymbolic :: TestTree test_concatSymbolic = @@ -388,7 +385,7 @@ test_simplify :: TestTree test_simplify = testPropertyWithSolver "simplify elements" $ do let x = mkElemVar (configElementVariableFromId (testId "x") intSort) - original = asInternal [mkAnd x mkTop_] + original = asInternal [mkAnd x (mkTop intSort)] expected = MultiOr.singleton $ asPattern [x] (===) expected =<< evaluateT original @@ -413,26 +410,26 @@ test_size = [ testPropertyWithSolver "size(unit(_)) = 0" $ do let original = sizeList unitList zero = mkInt 0 - predicate = mkEquals_ zero original + predicate = mkEquals kSort zero original (===) (OrPattern.fromTermLike zero) =<< evaluateT original - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate , testPropertyWithSolver "size(element(_)) = 1" $ do k <- forAll genInteger let original = sizeList (elementList $ mkInt k) one = mkInt 1 - predicate = mkEquals_ one original + predicate = mkEquals kSort one original (===) (OrPattern.fromTermLike one) =<< evaluateT original - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK 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 + predicate = mkEquals kSort sizeConcat addSize expect1 <- evaluateT sizeConcat expect2 <- evaluateT addSize (===) expect1 expect2 - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ] test_make :: [TestTree] From 69cb850163c24aff9d2a4f86d7d9016ffe223da7 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:25:41 -0500 Subject: [PATCH 24/74] Test.Kore.Builtin.Map: Use explicit sorts --- kore/test/Test/Kore/Builtin/Map.hs | 81 +++++++++++++++++------------- 1 file changed, 45 insertions(+), 36 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Map.hs b/kore/test/Test/Kore/Builtin/Map.hs index d30b797a50..3e7c1b6318 100644 --- a/kore/test/Test/Kore/Builtin/Map.hs +++ b/kore/test/Test/Kore/Builtin/Map.hs @@ -154,21 +154,28 @@ genMapSortedVariable sort genElement = ) <&> HashMap.fromList +mkEquals_ :: + InternalVariable variable => + TermLike variable -> + TermLike variable -> + TermLike variable +mkEquals_ = mkEquals kSort + test_lookupUnit :: [TestTree] test_lookupUnit = [ testPropertyWithoutSolver "lookup{}(unit{}(), key) === \\bottom{}()" $ do key <- forAll genIntegerPattern let patLookup = lookupMap unitMap key - predicate = mkEquals_ mkBottom_ patLookup + predicate = mkEquals_ (mkBottom intSort) patLookup (===) OrPattern.bottom =<< evaluateT patLookup - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK 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 + evaluateExpectTopK predicate ] test_lookupUpdate :: [TestTree] @@ -181,7 +188,7 @@ test_lookupUpdate = predicate = mkEquals_ patLookup patVal expect = OrPattern.fromTermLike patVal (===) expect =<< evaluateT patLookup - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate , testPropertyWithoutSolver "lookupOrDefault{}(update{}(map, key, val), key, def) === val" $ do patKey <- forAll genIntegerPattern patDef <- forAll genIntegerPattern @@ -192,7 +199,7 @@ test_lookupUpdate = predicate = mkEquals_ patLookup patVal expect = OrPattern.fromTermLike patVal (===) expect =<< evaluateT patLookup - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ] test_removeUnit :: TestTree @@ -205,7 +212,7 @@ test_removeUnit = predicate = mkEquals_ unitMap patRemove expect <- evaluateT unitMap (===) expect =<< evaluateT patRemove - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_sizeUnit :: TestTree @@ -223,7 +230,7 @@ test_sizeUnit = predicate = mkEquals_ patExpected patActual expect <- evaluateT patExpected (===) expect =<< evaluateT patActual - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_removeKeyNotIn :: TestTree @@ -239,7 +246,7 @@ test_removeKeyNotIn = predicate = mkEquals_ map' patRemove expect <- evaluateT map' (===) expect =<< evaluateT patRemove - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_removeKeyIn :: TestTree @@ -256,7 +263,7 @@ test_removeKeyIn = predicate = mkEquals_ patRemove map' expect <- evaluateT map' (===) expect =<< evaluateT patRemove - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_removeAllMapUnit :: TestTree @@ -269,7 +276,7 @@ test_removeAllMapUnit = predicate = mkEquals_ unitMap patRemoveAll expect <- evaluateT unitMap (===) expect =<< evaluateT patRemoveAll - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_removeAllSetUnit :: TestTree @@ -282,7 +289,7 @@ test_removeAllSetUnit = predicate = mkEquals_ map' patRemoveAll expect <- evaluateT map' (===) expect =<< evaluateT patRemoveAll - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_removeAll :: TestTree @@ -306,7 +313,7 @@ test_removeAll = predicate = mkEquals_ patRemoveAll1 patRemoveAll2 expect <- evaluateT patRemoveAll2 (===) expect =<< evaluateT patRemoveAll1 - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_concatUnit :: TestTree @@ -323,8 +330,8 @@ test_concatUnit = expect <- evaluateT patMap (===) expect =<< evaluateT patConcat1 (===) expect =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + evaluateExpectTopK predicate1 + evaluateExpectTopK predicate2 ) test_lookupConcatUniqueKeys :: TestTree @@ -353,7 +360,7 @@ test_lookupConcatUniqueKeys = expect2 = OrPattern.fromTermLike patVal2 (===) expect1 =<< evaluateT patLookup1 (===) expect2 =<< evaluateT patLookup2 - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_concatDuplicateKeys :: TestTree @@ -367,9 +374,9 @@ test_concatDuplicateKeys = let patMap1 = elementMap patKey patVal1 patMap2 = elementMap patKey patVal2 patConcat = concatMap patMap1 patMap2 - predicate = mkEquals_ mkBottom_ patConcat + predicate = mkEquals_ (mkBottom listSort) patConcat (===) OrPattern.bottom =<< evaluateT patConcat - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_concatCommutes :: TestTree @@ -385,7 +392,7 @@ test_concatCommutes = actual1 <- evaluateT patConcat1 actual2 <- evaluateT patConcat2 (===) actual1 actual2 - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_concatAssociates :: TestTree @@ -404,7 +411,7 @@ test_concatAssociates = actual12_3 <- evaluateT patConcat12_3 actual1_23 <- evaluateT patConcat1_23 (===) actual12_3 actual1_23 - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_inKeysUnit :: TestTree @@ -417,7 +424,7 @@ test_inKeysUnit = patInKeys = inKeysMap patKey patUnit predicate = mkEquals_ (Test.Bool.asInternal False) patInKeys (===) (Test.Bool.asOrPattern False) =<< evaluateT patInKeys - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_keysUnit :: TestTree @@ -431,7 +438,7 @@ test_keysUnit = predicate = mkEquals_ patExpect patKeys expect <- evaluate patExpect assertEqual "" expect =<< evaluate patKeys - assertEqual "" OrPattern.top =<< evaluate predicate + assertEqual "" (OrPattern.top kSort) =<< evaluate predicate test_keysElement :: TestTree test_keysElement = @@ -446,7 +453,7 @@ test_keysElement = predicate = mkEquals_ patKeys patSymbolic expect <- evaluateT patKeys (===) expect =<< evaluateT patSymbolic - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_keys :: TestTree @@ -462,7 +469,7 @@ test_keys = predicate = mkEquals_ patConcreteKeys patSymbolicKeys expect <- evaluateT patConcreteKeys (===) expect =<< evaluateT patSymbolicKeys - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_keysListUnit :: TestTree @@ -476,7 +483,7 @@ test_keysListUnit = predicate = mkEquals_ patExpect patKeys expect <- evaluate patExpect assertEqual "" expect =<< evaluate patKeys - assertEqual "" OrPattern.top =<< evaluate predicate + assertEqual "" (OrPattern.top kSort) =<< evaluate predicate test_keysListElement :: TestTree test_keysListElement = @@ -491,7 +498,7 @@ test_keysListElement = predicate = mkEquals_ patKeys patSymbolic expect <- evaluateT patKeys (===) expect =<< evaluateT patSymbolic - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_keysList :: TestTree @@ -507,7 +514,7 @@ test_keysList = predicate = mkEquals_ patConcreteKeys patSymbolicKeys expect <- evaluateT patConcreteKeys (===) expect =<< evaluateT patSymbolicKeys - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_inKeysElement :: TestTree @@ -521,7 +528,7 @@ test_inKeysElement = patInKeys = inKeysMap patKey patMap predicate = mkEquals_ (Test.Bool.asInternal True) patInKeys (===) (Test.Bool.asOrPattern True) =<< evaluateT patInKeys - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_values :: TestTree @@ -538,7 +545,7 @@ test_values = predicate = mkEquals_ patConcreteValues patValues expect <- evaluateT patValues (===) expect =<< evaluateT patConcreteValues - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_inclusion :: [TestTree] @@ -559,7 +566,7 @@ test_inclusion = (mkNot (mkEquals_ patKey1 patKey2)) (mkEquals_ (Test.Bool.asInternal True) patInclusion) (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "MAP.inclusion success: empty map <= empty map" @@ -567,7 +574,7 @@ test_inclusion = let patInclusion = inclusionMap unitMap unitMap predicate = mkEquals_ (Test.Bool.asInternal True) patInclusion (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "MAP.inclusion success: empty map <= any map" @@ -576,7 +583,7 @@ test_inclusion = let patInclusion = inclusionMap unitMap patSomeMap predicate = mkEquals_ (Test.Bool.asInternal True) patInclusion (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "MAP.inclusion failure: !(some map <= empty map)" @@ -587,7 +594,7 @@ test_inclusion = patInclusion = inclusionMap patSomeMap unitMap predicate = mkEquals_ (Test.Bool.asInternal False) patInclusion (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "MAP.inclusion failure: lhs key not included in rhs map" @@ -605,7 +612,7 @@ test_inclusion = (mkNot (mkEquals_ patKey1 patKey2)) (mkEquals_ (Test.Bool.asInternal False) patInclusion) (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "MAP.inclusion failure: lhs key maps differently in rhs map" @@ -627,7 +634,7 @@ test_inclusion = (mkNot (mkEquals_ patKey1 patKey2)) (mkEquals_ (Test.Bool.asInternal False) patInclusion) (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) ] @@ -637,7 +644,9 @@ test_simplify = testCaseWithoutSMT "simplify builtin Map elements" $ do let x = mkIntConfigVar (testId "x") key = Test.Int.asKey 1 - original = asTermLike $ HashMap.fromList [(key, mkAnd x mkTop_)] + original = + HashMap.fromList [(key, mkAnd x (mkTop intSort))] + & asTermLike expected = MultiOr.singleton . asPattern $ HashMap.fromList [(key, x)] actual <- evaluate original @@ -697,7 +706,7 @@ test_unifyConcrete = expect <- evaluateT patExpect actual <- evaluateT patActual (===) expect actual - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) -- Given a function to scramble the arguments to concat, i.e., From fe6a55f249998b637846e28d4ad1b2240d37d37d Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:26:54 -0500 Subject: [PATCH 25/74] Test.Kore.Builtin.Set: Use explicit sorts --- kore/test/Test/Kore/Builtin/Set.hs | 48 +++++++++++++++++------------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/Set.hs b/kore/test/Test/Kore/Builtin/Set.hs index bed3f46d7a..8ef68149de 100644 --- a/kore/test/Test/Kore/Builtin/Set.hs +++ b/kore/test/Test/Kore/Builtin/Set.hs @@ -213,6 +213,13 @@ test_unit = (OrPattern.fromTermLike expect) actual +mkEquals_ :: + InternalVariable variable => + TermLike variable -> + TermLike variable -> + TermLike variable +mkEquals_ = mkEquals kSort + test_getUnit :: TestTree test_getUnit = testPropertyWithSolver @@ -228,7 +235,7 @@ test_getUnit = patFalse = Test.Bool.asInternal False predicate = mkEquals_ patFalse patIn (===) (Test.Bool.asOrPattern False) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_inElement :: TestTree @@ -242,7 +249,7 @@ test_inElement = patTrue = Test.Bool.asInternal True predicate = mkEquals_ patIn patTrue (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_inUnitSymbolic :: TestTree @@ -260,7 +267,7 @@ test_inUnitSymbolic = patFalse = Test.Bool.asInternal False predicate = mkEquals_ patFalse patIn (===) (Test.Bool.asOrPattern False) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_inElementSymbolic :: TestTree @@ -272,7 +279,7 @@ test_inElementSymbolic = let patElement = mkApplySymbol elementSetSymbolTestSort [patKey] patIn = mkApplySymbol inSetSymbolTestSort [patKey, patElement] patTrue = Test.Bool.asInternal True - conditionTerm = mkAnd patTrue (mkCeil_ patElement) + conditionTerm = mkAnd patTrue (mkCeil boolSort patElement) actual <- evaluateT patIn expected <- evaluateT conditionTerm actual === expected @@ -320,7 +327,7 @@ test_inConcat = patTrue = Test.Bool.asInternal True predicate = mkEquals_ patTrue patIn (===) (Test.Bool.asOrPattern True) =<< evaluateT patIn - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_concatUnit :: TestTree @@ -339,8 +346,8 @@ test_concatUnit = expect <- evaluateT patValues (===) expect =<< evaluateT patConcat1 (===) expect =<< evaluateT patConcat2 - (===) OrPattern.top =<< evaluateT predicate1 - (===) OrPattern.top =<< evaluateT predicate2 + evaluateExpectTopK predicate1 + evaluateExpectTopK predicate2 ) test_concatAssociates :: TestTree @@ -367,7 +374,7 @@ test_concatAssociates = concat12_3 <- evaluateT patConcat12_3 concat1_23 <- evaluateT patConcat1_23 (===) concat12_3 concat1_23 - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_concatNormalizes :: TestTree @@ -427,7 +434,7 @@ test_concatNormalizes = evalConcat <- evaluateT patConcat evalNormalized <- evaluateT patNormalized (===) evalConcat evalNormalized - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_difference :: TestTree @@ -446,7 +453,7 @@ test_difference = predicate = mkEquals_ patSet3 patDifference expect <- evaluateT patSet3 (===) expect =<< evaluateT patDifference - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_difference_symbolic :: [TestTree] @@ -536,7 +543,7 @@ test_toList = predicate = mkEquals_ expectedList actualList expect <- evaluateT expectedList (===) expect =<< evaluateT actualList - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) where implToList = @@ -560,7 +567,7 @@ test_size = predicate = mkEquals_ patExpected patActual expect <- evaluateT patExpected (===) expect =<< evaluateT patActual - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_intersection_unit :: TestTree @@ -570,7 +577,7 @@ test_intersection_unit = let original = intersectionSet as unitSet expect = OrPattern.fromTermLike $ asInternal HashSet.empty (===) expect =<< evaluateT original - (===) OrPattern.top =<< evaluateT (mkEquals_ original unitSet) + evaluateExpectTopK (mkEquals_ original unitSet) test_intersection_idem :: TestTree test_intersection_idem = @@ -580,7 +587,7 @@ test_intersection_idem = original = intersectionSet termLike termLike expect = OrPattern.fromTermLike $ asInternal as (===) expect =<< evaluateT original - (===) OrPattern.top =<< evaluateT (mkEquals_ original termLike) + evaluateExpectTopK (mkEquals_ original termLike) test_list2set :: TestTree test_list2set = @@ -595,8 +602,7 @@ test_list2set = original = list2setSet input expect = OrPattern.fromTermLike $ asInternal set (===) expect =<< evaluateT original - (===) OrPattern.top - =<< evaluateT (mkEquals_ original termLike) + evaluateExpectTopK (mkEquals_ original termLike) test_inclusion :: [TestTree] test_inclusion = @@ -614,7 +620,7 @@ test_inclusion = (mkNot (mkEquals_ patKey1 patKey2)) (mkEquals_ (Test.Bool.asInternal True) patInclusion) (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "SET.inclusion success: empty set <= any set" @@ -623,7 +629,7 @@ test_inclusion = let patInclusion = inclusionSet unitSet patSomeSet predicate = mkEquals_ (Test.Bool.asInternal True) patInclusion (===) (Test.Bool.asOrPattern True) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "SET.inclusion failure: not (some nonempty set <= empty set)" @@ -633,7 +639,7 @@ test_inclusion = patInclusion = inclusionSet patSomeSet unitSet predicate = mkEquals_ (Test.Bool.asInternal False) patInclusion (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) , testPropertyWithSolver "SET.inclusion failure: lhs key not included in rhs set" @@ -649,7 +655,7 @@ test_inclusion = (mkNot (mkEquals_ patKey1 patKey2)) (mkEquals_ (Test.Bool.asInternal False) patInclusion) (===) (Test.Bool.asOrPattern False) =<< evaluateT patInclusion - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) ] @@ -707,7 +713,7 @@ test_unifyConcreteIdem = predicate = mkEquals_ patSet patAnd expect <- evaluateT patSet (===) expect =<< evaluateT patAnd - (===) OrPattern.top =<< evaluateT predicate + evaluateExpectTopK predicate ) test_unifyConcreteDistinct :: TestTree From ec6d1c68377d63ca401865378ffdd70f69ba5c17 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:31:32 -0500 Subject: [PATCH 26/74] Test.Kore.Builtin.String: Use explicit sorts --- kore/test/Test/Kore/Builtin/String.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Builtin/String.hs b/kore/test/Test/Kore/Builtin/String.hs index 331e41c163..467058a603 100644 --- a/kore/test/Test/Kore/Builtin/String.hs +++ b/kore/test/Test/Kore/Builtin/String.hs @@ -474,7 +474,7 @@ test_unifyStringEq = makeEqualsPredicate (mkElemVar x) (mkElemVar y) & makeNotPredicate & Condition.fromPredicate - & Pattern.fromCondition_ + & Pattern.fromCondition boolSort -- unit test do actual <- unifyStringEq term1 term2 @@ -491,7 +491,7 @@ test_unifyStringEq = term2 = eqString (mkElemVar x) (mkElemVar y) expect = Condition.assign (inject x) (mkElemVar y) - & Pattern.fromCondition_ + & Pattern.fromCondition boolSort -- unit test do actual <- unifyStringEq term1 term2 From 21b019ecc264466e756fcb5b998944d31197e026 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:35:30 -0500 Subject: [PATCH 27/74] Test.Kore.Internal.Predicate: Use explicit sorts --- kore/test/Test/Kore/Internal/Predicate.hs | 31 ++++++++++++++--------- 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/kore/test/Test/Kore/Internal/Predicate.hs b/kore/test/Test/Kore/Internal/Predicate.hs index 2944eb302b..ef3139014b 100644 --- a/kore/test/Test/Kore/Internal/Predicate.hs +++ b/kore/test/Test/Kore/Internal/Predicate.hs @@ -165,8 +165,8 @@ test_predicate = "makePredicate yields wrapPredicate" ( traverse_ (uncurry makePredicateYieldsWrapPredicate) - [ ("Top", mkTop_) - , ("Bottom", mkBottom_) + [ ("Top", mkTop Mock.testSort) + , ("Bottom", mkBottom Mock.testSort) , ("And", mkAnd pa1 pa2) , ("Or", mkOr pa1 pa2) , ("Iff", mkIff pa1 pa2) @@ -183,24 +183,27 @@ test_predicate = , testGroup "keeps simplified bit" [ testCase "unsimplified stays unsimplified" $ - (mkEquals_ Mock.cf Mock.cg, NotSimplified) + (mkEquals Mock.topSort Mock.cf Mock.cg, NotSimplified) `makesPredicate` (makeEqualsPredicate Mock.cf Mock.cg, NotSimplified) , testCase "simplified stays simplified" $ - ( simplifiedTerm $ mkEquals_ Mock.cf Mock.cg + ( simplifiedTerm $ mkEquals Mock.topSort Mock.cf Mock.cg , IsSimplified ) `makesPredicate` (makeEqualsPredicate Mock.cf Mock.cg, IsSimplified) , testCase "Partial predicate stays simplified" $ ( simplifiedTerm $ - mkAnd mkTop_ (mkEquals_ Mock.cf Mock.cg) + mkAnd (mkTop Mock.topSort) (mkEquals Mock.topSort Mock.cf Mock.cg) , IsSimplified ) `makesPredicate` (makeEqualsPredicate Mock.cf Mock.cg, IsSimplified) , testCase "changed simplified becomes unsimplified" $ ( simplifiedTerm $ mkAnd - (mkAnd mkTop_ (mkEquals_ Mock.cf Mock.cg)) - (mkEquals_ Mock.cg Mock.ch) + ( mkAnd + (mkTop Mock.topSort) + (mkEquals Mock.topSort Mock.cf Mock.cg) + ) + (mkEquals Mock.topSort Mock.cg Mock.ch) , IsSimplified ) `makesPredicate` ( makeAndPredicate @@ -267,29 +270,33 @@ pr2 = pa1 :: TermLike VariableName pa1 = - mkEquals_ + mkEquals + Mock.topSort (mkElemVar $ a Mock.testSort) (mkElemVar $ b Mock.testSort) pa2 :: TermLike VariableName pa2 = - mkEquals_ + mkEquals + Mock.topSort (mkElemVar $ c Mock.testSort) (mkElemVar $ d Mock.testSort) ceilA :: TermLike VariableName ceilA = - mkCeil_ + mkCeil + Mock.topSort (mkElemVar $ a Mock.testSort) inA :: TermLike VariableName inA = - mkIn_ + mkIn + Mock.topSort (mkElemVar $ a Mock.testSort) (mkElemVar $ b Mock.testSort) floorA :: TermLike VariableName -floorA = mkFloor_ (mkElemVar $ a Mock.testSort) +floorA = mkFloor Mock.topSort (mkElemVar $ a Mock.testSort) a, b, c, d :: Sort -> ElementVariable VariableName a = mkElementVariable (testId "a") From bb25388d882a2035e4811100e5a0120eee7a1e59 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:36:30 -0500 Subject: [PATCH 28/74] Test.Kore.Internal.SideCondition: Use explicit sorts --- kore/test/Test/Kore/Internal/SideCondition.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/kore/test/Test/Kore/Internal/SideCondition.hs b/kore/test/Test/Kore/Internal/SideCondition.hs index b0f026e93f..df728bc476 100644 --- a/kore/test/Test/Kore/Internal/SideCondition.hs +++ b/kore/test/Test/Kore/Internal/SideCondition.hs @@ -38,12 +38,12 @@ test_assumeDefined :: [TestTree] test_assumeDefined = [ testCase "Fails on \\bottom" $ do let term :: TermLike VariableName - term = mkBottom_ + term = mkBottom Mock.topSort actual = assumeDefined term assertEqual "" Nothing actual , testCase "Fails on nested \\bottom" $ do let term :: TermLike VariableName - term = Mock.f mkBottom_ + term = Mock.f (mkBottom Mock.testSort) actual = assumeDefined term assertEqual "" Nothing actual , testCase "And: implies subterms are defined" $ do @@ -72,7 +72,7 @@ test_assumeDefined = assertEqual "" expected actual , testCase "Ceil: implies subterms are defined" $ do let term :: TermLike VariableName - term = mkCeil_ Mock.plain00 + term = mkCeil Mock.topSort Mock.plain00 expected = [term, Mock.plain00] & HashSet.fromList @@ -140,7 +140,8 @@ test_assumeDefined = , testCase "In: implies subterms are defined" $ do let term :: TermLike VariableName term = - mkIn_ + mkIn + Mock.topSort (Mock.f (mkElemVar Mock.x)) (Mock.functional10 (Mock.g Mock.a)) expected = From 16e5599f08556c530778d0f8c2c3a6e24c7abc25 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:37:30 -0500 Subject: [PATCH 29/74] Test.Kore.Reachability.Claim: Use explicit sorts --- kore/test/Test/Kore/Reachability/Claim.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/kore/test/Test/Kore/Reachability/Claim.hs b/kore/test/Test/Kore/Reachability/Claim.hs index 54ac078724..5dba5075f0 100644 --- a/kore/test/Test/Kore/Reachability/Claim.hs +++ b/kore/test/Test/Kore/Reachability/Claim.hs @@ -229,7 +229,7 @@ test_checkImplication = actual <- checkImplication goal assertEqual "" [NotImpliedStuck goal] actual , testCase "Implied if both sides are \\bottom" $ do - let config = Pattern.bottom + let config = Pattern.bottomOf Mock.topSort dest = OrPattern.bottom goal = mkGoal config dest [] actual <- checkImplication goal @@ -243,19 +243,19 @@ test_simplifyRightHandSide = Pattern.fromTermAndPredicate Mock.b ( makeEqualsPredicate - TermLike.mkTop_ + (TermLike.mkTop Mock.testSort) (Mock.builtinInt 3 `Mock.lessInt` Mock.builtinInt 2) ) claim = mkGoal - Pattern.top + (Pattern.topOf Mock.testSort) ( [Pattern.fromTermLike Mock.a, unsatisfiableBranch] & OrPattern.fromPatterns ) [] expected = mkGoal - Pattern.top + (Pattern.topOf Mock.testSort) (Mock.a & OrPattern.fromTermLike) [] actual <- From f6ee902f286b6a64b247b905db508e2b512f92d6 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:37:54 -0500 Subject: [PATCH 30/74] Test.Kore.Reachability.OnePathStrategy: Use explicit sorts --- kore/test/Test/Kore/Reachability/OnePathStrategy.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Reachability/OnePathStrategy.hs b/kore/test/Test/Kore/Reachability/OnePathStrategy.hs index 41f24835a4..3564d4b3b7 100644 --- a/kore/test/Test/Kore/Reachability/OnePathStrategy.hs +++ b/kore/test/Test/Kore/Reachability/OnePathStrategy.hs @@ -821,7 +821,7 @@ test_onePathStrategy = Mock.a ) ) - right' = Pattern.bottom + right' = Pattern.bottomOf Mock.testSort original = makeOnePathGoalFromPatterns left right expect = makeOnePathGoalFromPatterns left' right' [_actual] <- From 320f3877e81f671586bdb55230b0602f5eabe94b Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:38:35 -0500 Subject: [PATCH 31/74] Test.Kore.Reachability.Prove: Use explicit sorts --- kore/test/Test/Kore/Reachability/Prove.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Reachability/Prove.hs b/kore/test/Test/Kore/Reachability/Prove.hs index 3ec6c9fe24..8e3270a923 100644 --- a/kore/test/Test/Kore/Reachability/Prove.hs +++ b/kore/test/Test/Kore/Reachability/Prove.hs @@ -658,7 +658,7 @@ test_proveClaims = , testGroup "LHS is undefined" $ let mkTest name mkSimpleClaim = testCase name $ do - let claims = [mkSimpleClaim mkBottom_ Mock.a] + let claims = [mkSimpleClaim (mkBottom Mock.testSort) Mock.a] actual <- proveClaims_ Unlimited From 40da7a5a7d34b5ce9742043f00916ac05f67730e Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:39:30 -0500 Subject: [PATCH 32/74] Test.Kore.Repl.Interpreter: Use explicit sorts --- kore/test/Test/Kore/Repl/Interpreter.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Repl/Interpreter.hs b/kore/test/Test/Kore/Repl/Interpreter.hs index 0d263a7f67..0959823966 100644 --- a/kore/test/Test/Kore/Repl/Interpreter.hs +++ b/kore/test/Test/Kore/Repl/Interpreter.hs @@ -39,7 +39,7 @@ import qualified Kore.Internal.OrPattern as OrPattern import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.TermLike ( TermLike, - mkBottom_, + mkBottom, mkElemVar, ) import qualified Kore.Log as Log @@ -642,7 +642,10 @@ zeroToTen = emptyClaim :: SomeClaim emptyClaim = OnePath . OnePathClaim $ - claimWithName mkBottom_ mkBottom_ "emptyClaim" + claimWithName + (mkBottom kSort) + (mkBottom kSort) + "emptyClaim" zeroToZero :: SomeClaim zeroToZero = From c23b8df7aa9ea9bc16cf84deaa6d68516bed7510 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:41:31 -0500 Subject: [PATCH 33/74] Test.Kore.Step.AntiLeft: Use explicit sorts --- kore/test/Test/Kore/Step/AntiLeft.hs | 54 +++++++++++++++++++--------- 1 file changed, 37 insertions(+), 17 deletions(-) diff --git a/kore/test/Test/Kore/Step/AntiLeft.hs b/kore/test/Test/Kore/Step/AntiLeft.hs index 8b5d1a044c..81bb867f50 100644 --- a/kore/test/Test/Kore/Step/AntiLeft.hs +++ b/kore/test/Test/Kore/Step/AntiLeft.hs @@ -22,12 +22,12 @@ import Kore.Internal.Predicate ( import Kore.Internal.TermLike ( mkAnd, mkApplyAlias, - mkBottom_, - mkCeil_, + mkBottom, + mkCeil, mkElemVar, mkExists, mkOr, - mkTop_, + mkTop, ) import Kore.Internal.TermLike.TermLike ( TermLike, @@ -60,8 +60,11 @@ test_antiLeft = ( applyAliasToNoArgs "A" ( mkOr - (applyAliasToNoArgs "B" (mkAnd mkTop_ Mock.a)) - mkBottom_ + ( applyAliasToNoArgs + "B" + (mkAnd (mkTop Mock.testSort) Mock.a) + ) + (mkBottom Mock.testSort) ) ) ) @@ -80,9 +83,9 @@ test_antiLeft = ( mkOr ( applyAliasToNoArgs "B" - (mkAnd (mkCeil_ Mock.cg) Mock.a) + (mkAnd (mkCeil Mock.testSort Mock.cg) Mock.a) ) - mkBottom_ + (mkBottom Mock.testSort) ) ) ) @@ -99,10 +102,16 @@ test_antiLeft = ( applyAliasToNoArgs "A" ( mkOr - (applyAliasToNoArgs "B" (mkAnd mkTop_ Mock.a)) + ( applyAliasToNoArgs + "B" + (mkAnd (mkTop Mock.testSort) Mock.a) + ) ( mkOr - (applyAliasToNoArgs "C" (mkAnd mkTop_ Mock.b)) - mkBottom_ + ( applyAliasToNoArgs + "C" + (mkAnd (mkTop Mock.testSort) Mock.b) + ) + (mkBottom Mock.testSort) ) ) ) @@ -123,13 +132,19 @@ test_antiLeft = ( applyAliasToNoArgs "B" ( mkOr - (applyAliasToNoArgs "C" (mkAnd mkTop_ Mock.a)) - mkBottom_ + ( applyAliasToNoArgs + "C" + (mkAnd (mkTop Mock.testSort) Mock.a) + ) + (mkBottom Mock.testSort) ) ) ( mkOr - (applyAliasToNoArgs "D" (mkAnd mkTop_ Mock.b)) - mkBottom_ + ( applyAliasToNoArgs + "D" + (mkAnd (mkTop Mock.testSort) Mock.b) + ) + (mkBottom Mock.testSort) ) ) ) @@ -156,10 +171,13 @@ test_antiLeft = Mock.x ( applyAliasToNoArgs "B" - (mkAnd mkTop_ (Mock.f (mkElemVar Mock.x))) + ( mkAnd + (mkTop Mock.testSort) + (Mock.f (mkElemVar Mock.x)) + ) ) ) - mkBottom_ + (mkBottom Mock.testSort) ) ) ) @@ -168,7 +186,9 @@ test_antiLeft = ] parseAndApply :: - AntiLeftTerm -> TermLike VariableName -> IO (Predicate VariableName) + AntiLeftTerm -> + TermLike VariableName -> + IO (Predicate VariableName) parseAndApply (AntiLeftTerm antiLeftTerm) configurationTerm = do antiLeft <- case parse antiLeftTerm of Nothing -> From 5565017ff3a4671c8193877e7b91ce6041a97d08 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:42:55 -0500 Subject: [PATCH 34/74] Test.Kore.Step.Axiom.Identifier: Use explicit sorts --- kore/test/Test/Kore/Step/Axiom/Identifier.hs | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/kore/test/Test/Kore/Step/Axiom/Identifier.hs b/kore/test/Test/Kore/Step/Axiom/Identifier.hs index a8e25f4f79..46d38cb367 100644 --- a/kore/test/Test/Kore/Step/Axiom/Identifier.hs +++ b/kore/test/Test/Kore/Step/Axiom/Identifier.hs @@ -23,11 +23,14 @@ test_matchAxiomIdentifier = (Application Mock.sortInjectionId) , matches "\\ceil(f(a))" - (TermLike.mkCeil_ (Mock.f Mock.a)) + (TermLike.mkCeil Mock.topSort (Mock.f Mock.a)) (Ceil (Application Mock.fId)) , matches "\\ceil(\\ceil(f(a)))" - (TermLike.mkCeil_ (TermLike.mkCeil_ (Mock.f Mock.a))) + ( TermLike.mkCeil + Mock.topSort + (TermLike.mkCeil Mock.subSort (Mock.f Mock.a)) + ) (Ceil (Ceil (Application Mock.fId))) , notMatches "\\and(f(a), g(a))" @@ -35,7 +38,11 @@ test_matchAxiomIdentifier = , matches "x" (TermLike.mkElemVar Mock.x) Variable , matches "\\equals(x, f(a))" - (TermLike.mkEquals_ (TermLike.mkElemVar Mock.x) (Mock.f Mock.a)) + ( TermLike.mkEquals + Mock.topSort + (TermLike.mkElemVar Mock.x) + (Mock.f Mock.a) + ) (Equals Variable (Application Mock.fId)) , matches "\\exists(x, f(a))" @@ -44,7 +51,10 @@ test_matchAxiomIdentifier = , matches "\\exists(x, \\equals(x, f(a)))" ( TermLike.mkExists Mock.x $ - TermLike.mkEquals_ (TermLike.mkElemVar Mock.x) (Mock.f Mock.a) + TermLike.mkEquals + Mock.topSort + (TermLike.mkElemVar Mock.x) + (Mock.f Mock.a) ) (Exists (Equals Variable (Application Mock.fId))) , testGroup @@ -100,7 +110,7 @@ test_matchAxiomIdentifier = [ matches name termLike axiomIdentifier , matches ceilName - (TermLike.mkCeil_ termLike) + (TermLike.mkCeil Mock.topSort termLike) (Ceil axiomIdentifier) ] where From 024defa8c680ec21003d3dde07068eb08618386c Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:44:13 -0500 Subject: [PATCH 35/74] Test.Kore.Step.Axiom.Matcher: Use explicit sorts --- kore/test/Test/Kore/Step/Axiom/Matcher.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/kore/test/Test/Kore/Step/Axiom/Matcher.hs b/kore/test/Test/Kore/Step/Axiom/Matcher.hs index 8f835237cc..ae45f788bd 100644 --- a/kore/test/Test/Kore/Step/Axiom/Matcher.hs +++ b/kore/test/Test/Kore/Step/Axiom/Matcher.hs @@ -99,7 +99,10 @@ test_matcherEqualHeads = ] , testCase "Bottom" $ do let expect = Just (makeTruePredicate, Map.empty) - actual <- matchDefinition mkBottom_ mkBottom_ + actual <- + matchDefinition + (mkBottom Mock.topSort) + (mkBottom Mock.topSort) assertEqual "" expect actual , testCase "Ceil" $ do let expect = @@ -109,8 +112,8 @@ test_matcherEqualHeads = ) actual <- matchDefinition - (mkCeil_ (Mock.plain10 (mkElemVar Mock.xConfig))) - (mkCeil_ (Mock.plain10 Mock.a)) + (mkCeil Mock.topSort (Mock.plain10 (mkElemVar Mock.xConfig))) + (mkCeil Mock.topSort (Mock.plain10 Mock.a)) assertEqual "" expect actual , testCase "Equals" $ do let expect = @@ -122,11 +125,13 @@ test_matcherEqualHeads = ) actual <- matchDefinition - ( mkEquals_ + ( mkEquals + Mock.topSort (Mock.plain10 (mkElemVar Mock.xConfig)) (Mock.plain10 Mock.a) ) - ( mkEquals_ + ( mkEquals + Mock.topSort (Mock.plain10 (mkElemVar Mock.yConfig)) (Mock.plain10 Mock.a) ) @@ -172,8 +177,8 @@ test_matcherEqualHeads = , testCase "Top" $ do actual <- matchDefinition - mkTop_ - mkTop_ + (mkTop Mock.topSort) + (mkTop Mock.topSort) assertEqual "" topCondition actual , testCase "Iff vs Or" $ do let expect = Nothing From 0856714c98ed541ef823ac0062b7e5fc437f8e08 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:45:10 -0500 Subject: [PATCH 36/74] Test.Kore.Step.Axiom.Registry: Use explicit sorts --- kore/test/Test/Kore/Step/Axiom/Registry.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/Step/Axiom/Registry.hs b/kore/test/Test/Kore/Step/Axiom/Registry.hs index fb253299c5..4379ce6367 100644 --- a/kore/test/Test/Kore/Step/Axiom/Registry.hs +++ b/kore/test/Test/Kore/Step/Axiom/Registry.hs @@ -407,8 +407,8 @@ testDef = , sentenceAxiomPattern = externalize $ mkRewrites - (mkAnd mkTop_ (mkApplySymbol fHead [])) - (mkAnd mkTop_ (mkApplySymbol tHead [])) + (mkAnd (mkTop sortS) (mkApplySymbol fHead [])) + (mkAnd (mkTop sortS) (mkApplySymbol tHead [])) } , SentenceAxiomSentence SentenceAxiom @@ -422,7 +422,7 @@ testDef = ( mkEquals sortVarS (mkCeil sortVar1S (mkApplySymbol fHead [])) - mkTop_ + (mkTop sortVar1S) ) (mkTop sortVarS) ) From e56a2e04e64fb23905492a95e996f37eb398a49e Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:48:06 -0500 Subject: [PATCH 37/74] Test.Kore.Step.Function.Integration: Use explicit sorts --- .../Test/Kore/Step/Function/Integration.hs | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/kore/test/Test/Kore/Step/Function/Integration.hs b/kore/test/Test/Kore/Step/Function/Integration.hs index bb7040ac4d..ceb101b88a 100644 --- a/kore/test/Test/Kore/Step/Function/Integration.hs +++ b/kore/test/Test/Kore/Step/Function/Integration.hs @@ -134,7 +134,7 @@ test_functionIntegration = ) ) (Mock.functional10 Mock.c) - assertEqual "" expect (OrPattern.toTermLike actual) + assertEqual "" expect (OrPattern.toTermLike Mock.testSort actual) , testCase "Simple evaluation (builtin branch)" $ do let expect = Mock.g Mock.c actual <- @@ -148,7 +148,7 @@ test_functionIntegration = ) ) (Mock.functional10 Mock.c) - assertEqual "" expect (OrPattern.toTermLike actual) + assertEqual "" expect (OrPattern.toTermLike Mock.testSort actual) , testCase "Simple evaluation (Axioms & Builtin branch, Builtin works)" $ do let expect = Mock.g Mock.c @@ -169,7 +169,7 @@ test_functionIntegration = ) ) (Mock.functional10 Mock.c) - assertEqual "" expect (OrPattern.toTermLike actual) + assertEqual "" expect (OrPattern.toTermLike Mock.testSort actual) , testCase "Simple evaluation (Axioms & Builtin branch, Builtin fails)" $ do let expect = Mock.g Mock.c @@ -189,7 +189,7 @@ test_functionIntegration = ) ) (Mock.functional10 Mock.c) - assertEqual "" expect (OrPattern.toTermLike actual) + assertEqual "" expect (OrPattern.toTermLike Mock.testSort actual) , testCase "Evaluates inside functions" $ do let expect = Mock.functional11 (Mock.functional11 Mock.c) actual <- @@ -202,7 +202,7 @@ test_functionIntegration = ) ) (Mock.functional10 (Mock.functional10 Mock.c)) - assertEqual "" expect (OrPattern.toTermLike actual) + assertEqual "" expect (OrPattern.toTermLike Mock.testSort actual) , testCase "Evaluates 'or'" $ do let expect = mkOr @@ -223,7 +223,7 @@ test_functionIntegration = (Mock.functional10 Mock.d) ) ) - assertEqual "" expect (OrPattern.toTermLike actual) + assertEqual "" expect (OrPattern.toTermLike Mock.testSort actual) , testCase "Evaluates on multiple branches" $ do let expect = Mock.functional11 @@ -246,7 +246,7 @@ test_functionIntegration = (Mock.functional10 Mock.c) ) ) - assertEqual "" expect (OrPattern.toTermLike actual) + assertEqual "" expect (OrPattern.toTermLike Mock.testSort actual) , testCase "Returns conditions" $ do let expect = Conditional @@ -452,7 +452,7 @@ test_functionIntegration = [ "Expected:" , Pretty.indent 4 (unparse expect) , "but found:" - , Pretty.indent 4 (unparse $ OrPattern.toTermLike actual) + , Pretty.indent 4 (Pretty.pretty actual) ] assertEqual message (MultiOr.singleton expect) actual , testCase "Evaluates only simplifications." $ do @@ -1664,11 +1664,11 @@ test_updateList = , equals "negative index" (updateList singletonList (mkInt (-1)) (mkInt 1)) - [mkBottom_] + [mkBottom listSort] , equals "positive index outside rage" (updateList singletonList (mkInt 1) (mkInt 1)) - [mkBottom_] + [mkBottom listSort] , applies "same abstract key" [updateListSimplifier] @@ -1850,7 +1850,7 @@ test_Ceil = [ simplifies "\\ceil(dummy(X)) => ... ~ \\ceil(dummy(Y))" ceilDummyRule - (mkCeil_ $ Builtin.dummyInt $ mkElemVar yConfigInt) + (mkCeil Builtin.kSort $ Builtin.dummyInt $ mkElemVar yConfigInt) , notSimplifies "\\ceil(dummy(X)) => \\not(\\equals(X, 0)) !~ dummy(Y)" ceilDummyRule @@ -1858,20 +1858,20 @@ test_Ceil = , simplifies "\\ceil(dummy(@X)) => ... ~ \\ceil(dummy(Y))" ceilDummySetRule - (mkCeil_ $ Builtin.dummyInt $ mkElemVar yConfigInt) + (mkCeil Builtin.kSort $ Builtin.dummyInt $ mkElemVar yConfigInt) ] ceilDummyRule :: Equation RewritingVariableName ceilDummyRule = axiom_ - (mkCeil_ $ Builtin.dummyInt $ mkElemVar xConfigInt) - (mkEquals_ (Builtin.eqInt (mkElemVar xConfigInt) (mkInt 0)) (mkBool False)) + (mkCeil Builtin.kSort $ Builtin.dummyInt $ mkElemVar xConfigInt) + (mkEquals Builtin.kSort (Builtin.eqInt (mkElemVar xConfigInt) (mkInt 0)) (mkBool False)) ceilDummySetRule :: Equation RewritingVariableName ceilDummySetRule = axiom_ - (mkCeil_ $ Builtin.dummyInt $ mkSetVar xsConfigInt) - (mkEquals_ (Builtin.eqInt (mkSetVar xsConfigInt) (mkInt 0)) (mkBool False)) + (mkCeil _ $ Builtin.dummyInt $ mkSetVar xsConfigInt) + (mkEquals _ (Builtin.eqInt (mkSetVar xsConfigInt) (mkInt 0)) (mkBool False)) -- Simplification tests: check that one or more rules applies or not withSimplified :: From eedec71c91690d5bb31f4319b37ed7067deec08f Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:48:35 -0500 Subject: [PATCH 38/74] Test.Kore.Step.Function.Implication: Use explicit sorts --- kore/test/Test/Kore/Step/Function/Integration.hs | 4 ++-- kore/test/Test/Kore/Step/Implication.hs | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/Step/Function/Integration.hs b/kore/test/Test/Kore/Step/Function/Integration.hs index ceb101b88a..18a6fdee21 100644 --- a/kore/test/Test/Kore/Step/Function/Integration.hs +++ b/kore/test/Test/Kore/Step/Function/Integration.hs @@ -1870,8 +1870,8 @@ ceilDummyRule = ceilDummySetRule :: Equation RewritingVariableName ceilDummySetRule = axiom_ - (mkCeil _ $ Builtin.dummyInt $ mkSetVar xsConfigInt) - (mkEquals _ (Builtin.eqInt (mkSetVar xsConfigInt) (mkInt 0)) (mkBool False)) + (mkCeil Builtin.kSort $ Builtin.dummyInt $ mkSetVar xsConfigInt) + (mkEquals Builtin.kSort (Builtin.eqInt (mkSetVar xsConfigInt) (mkInt 0)) (mkBool False)) -- Simplification tests: check that one or more rules applies or not withSimplified :: diff --git a/kore/test/Test/Kore/Step/Implication.hs b/kore/test/Test/Kore/Step/Implication.hs index 341cf3178e..e4aaa2610d 100644 --- a/kore/test/Test/Kore/Step/Implication.hs +++ b/kore/test/Test/Kore/Step/Implication.hs @@ -93,7 +93,8 @@ test_substitute :: [TestTree] test_substitute = [ testCase "does not capture free variables from the substitution" $ do let dummy = - Pattern.fromCondition_ + Pattern.fromCondition + Mock.testSort (fromPredicate Predicate.makeTruePredicate) right = OrPattern.fromTermLike (mkElemVar y) imp = mkImplication () dummy right [x] From 9b9b08ce7e72b732369ef9c387b32cf6d3886780 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:51:45 -0500 Subject: [PATCH 39/74] Test.Kore.Step.RewriteStep: Use explicit sorts --- kore/test/Test/Kore/Step/RewriteStep.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Step/RewriteStep.hs b/kore/test/Test/Kore/Step/RewriteStep.hs index bc50b43b95..68d75b6500 100644 --- a/kore/test/Test/Kore/Step/RewriteStep.hs +++ b/kore/test/Test/Kore/Step/RewriteStep.hs @@ -987,12 +987,12 @@ test_applyRewriteRule_ = axiomSigmaTopId = RewriteRule $ rulePattern - (Mock.sigma (mkElemVar Mock.xRule) mkTop_) + (Mock.sigma (mkElemVar Mock.xRule) (mkTop Mock.testSort)) (mkElemVar Mock.xRule) claimSigmaTopId = claimPatternFromTerms - (Mock.sigma (mkElemVar Mock.xRule) mkTop_) + (Mock.sigma (mkElemVar Mock.xRule) (mkTop Mock.testSort)) (mkElemVar Mock.xRule) [] From 962bd4a63f79121aae7b95deebe502d950b3f8cd Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:52:30 -0500 Subject: [PATCH 40/74] Test.Kore.Step.Rule: Use explicit sorts --- kore/test/Test/Kore/Step/Rule.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/kore/test/Test/Kore/Step/Rule.hs b/kore/test/Test/Kore/Step/Rule.hs index ff99b3c4bd..e37872e775 100644 --- a/kore/test/Test/Kore/Step/Rule.hs +++ b/kore/test/Test/Kore/Step/Rule.hs @@ -105,8 +105,8 @@ axiomPatternsUnitTests = ( applyInj sortKItem ( mkRewrites - (mkAnd mkTop_ varI1) - (mkAnd mkTop_ varI2) + (mkAnd (mkTop sortAInt) varI1) + (mkAnd (mkTop sortAInt) varI2) ) ) moduleTest = @@ -152,8 +152,8 @@ axiomPatternsUnitTests = symbolInj [sortAInt, sortKItem] [ mkRewrites - (mkAnd mkTop_ varI1) - (mkAnd mkTop_ varI2) + (mkAnd (mkTop sortAInt) varI1) + (mkAnd (mkTop sortAInt) varI2) ] ) ) From f4590875dc4543595faeb3adfae32a87e3168717 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 14:53:08 -0500 Subject: [PATCH 41/74] Test.Kore.Step.Rule.Combine: Use explicit sorts --- kore/test/Test/Kore/Step/Rule/Combine.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/kore/test/Test/Kore/Step/Rule/Combine.hs b/kore/test/Test/Kore/Step/Rule/Combine.hs index 15ea12448b..93e3a3b2ef 100644 --- a/kore/test/Test/Kore/Step/Rule/Combine.hs +++ b/kore/test/Test/Kore/Step/Rule/Combine.hs @@ -27,9 +27,9 @@ import Kore.Internal.TermLike ( TermLike, mkAnd, mkApplyAlias, - mkBottom_, + mkBottom, mkElemVar, - mkEquals_, + mkEquals, mkOr, ) import qualified Kore.Internal.TermLike as TermLike.DoNotUse @@ -206,9 +206,12 @@ test_combineRulesPredicate = ( mkOr ( applyAlias "B" - (mkAnd (mkEquals_ Mock.cf Mock.cg) Mock.ch) + ( mkAnd + (mkEquals Mock.testSort Mock.cf Mock.cg) + Mock.ch + ) ) - mkBottom_ + (mkBottom Mock.testSort) ) ) let expected = From ce423fb1b8760873f5bc6844864b9f94eba7ed04 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Sun, 27 Jun 2021 15:02:24 -0500 Subject: [PATCH 42/74] Test.Kore.Step.Simplification.And: Use explicit sorts --- .../test/Test/Kore/Step/Simplification/And.hs | 54 +++++++++---------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/kore/test/Test/Kore/Step/Simplification/And.hs b/kore/test/Test/Kore/Step/Simplification/And.hs index e9ac4dac8d..d3123d0c4c 100644 --- a/kore/test/Test/Kore/Step/Simplification/And.hs +++ b/kore/test/Test/Kore/Step/Simplification/And.hs @@ -46,15 +46,15 @@ test_andSimplification = assertEqual "false and true = false" OrPattern.bottom - =<< evaluate (makeAnd [] [Pattern.top]) + =<< evaluate (makeAnd [] [Pattern.topOf Mock.testSort]) assertEqual "true and false = false" OrPattern.bottom - =<< evaluate (makeAnd [Pattern.top] []) + =<< evaluate (makeAnd [Pattern.topOf Mock.testSort] []) assertEqual "true and true = true" - OrPattern.top - =<< evaluate (makeAnd [Pattern.top] [Pattern.top]) + (OrPattern.top Mock.testSort) + =<< evaluate (makeAnd [Pattern.topOf Mock.testSort] [Pattern.topOf Mock.testSort]) , testCase "And with booleans" $ do assertEqual "false and something = false" @@ -67,11 +67,11 @@ test_andSimplification = assertEqual "true and something = something" (OrPattern.fromPatterns [fOfXExpanded]) - =<< evaluate (makeAnd [Pattern.top] [fOfXExpanded]) + =<< evaluate (makeAnd [Pattern.topOf Mock.testSort] [fOfXExpanded]) assertEqual "something and true = something" (OrPattern.fromPatterns [fOfXExpanded]) - =<< evaluate (makeAnd [fOfXExpanded] [Pattern.top]) + =<< evaluate (makeAnd [fOfXExpanded] [Pattern.topOf Mock.testSort]) , testCase "And with partial booleans" $ do assertEqual "false term and something = false" @@ -110,7 +110,7 @@ test_andSimplification = , testCase "And predicates" $ do let expect = Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeAndPredicate (makeCeilPredicate fOfX) @@ -120,12 +120,12 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeCeilPredicate fOfX , substitution = mempty } Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeCeilPredicate gOfX , substitution = mempty } @@ -133,7 +133,7 @@ test_andSimplification = , testCase "And substitutions - simple" $ do let expect = Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeTruePredicate , substitution = Substitution.unsafeWrap @@ -144,7 +144,7 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -152,7 +152,7 @@ test_andSimplification = [(inject Mock.yConfig, fOfX)] } Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -183,7 +183,7 @@ test_andSimplification = , testCase "And substitutions - separate predicate" $ do let expect = Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeEqualsPredicate fOfX gOfX , substitution = Substitution.unsafeWrap [(inject Mock.yConfig, fOfX)] @@ -191,7 +191,7 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -199,7 +199,7 @@ test_andSimplification = [(inject Mock.yConfig, fOfX)] } Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -211,7 +211,7 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -224,7 +224,7 @@ test_andSimplification = ] } Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -244,7 +244,7 @@ test_andSimplification = assertEqual "Combines conditions with substitution merge condition" Pattern - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = fst $ makeAndPredicate (fst $ makeAndPredicate @@ -259,12 +259,12 @@ test_andSimplification = , (gSymbol, mock.functionAttributes) ] Pattern - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeCeilPredicate fOfX , substitution = [(y, fOfX)] } Pattern - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeCeilPredicate gOfX , substitution = [(y, gOfX)] } @@ -352,7 +352,7 @@ test_andSimplification = , substitution = mempty } , Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeAndPredicate (makeCeilPredicate fOfX) @@ -365,14 +365,14 @@ test_andSimplification = ( makeAnd [ fOfXExpanded , Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeCeilPredicate fOfX , substitution = mempty } ] [ gOfXExpanded , Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeCeilPredicate gOfX , substitution = mempty } @@ -435,13 +435,13 @@ test_andSimplification = } bottomTerm = Conditional - { term = mkBottom_ + { term = mkBottom Mock.topSort , predicate = makeTruePredicate , substitution = mempty } falsePredicate = Conditional - { term = mkTop_ + { term = mkTop Mock.topSort , predicate = makeFalsePredicate , substitution = mempty } @@ -466,7 +466,7 @@ evaluate :: IO (OrPattern RewritingVariableName) evaluate And{andFirst, andSecond} = MultiAnd.make [andFirst, andSecond] - & simplify Not.notSimplifier SideCondition.top + & simplify Mock.topSort Not.notSimplifier SideCondition.top & runSimplifier Mock.env evaluatePatterns :: @@ -475,6 +475,6 @@ evaluatePatterns :: IO (OrPattern RewritingVariableName) evaluatePatterns first second = MultiAnd.make [first, second] - & makeEvaluate Not.notSimplifier SideCondition.top + & makeEvaluate Mock.topSort Not.notSimplifier SideCondition.top & runSimplifierBranch Mock.env & fmap OrPattern.fromPatterns From 75ef6f163da714b671d04016aa7979530b79632a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Tue, 20 Jul 2021 14:47:41 +0300 Subject: [PATCH 43/74] Fix some tests --- kore/app/exec/Main.hs | 25 +++--- kore/src/Kore/Equation/Validate.hs | 7 +- kore/src/Kore/Exec.hs | 4 +- kore/src/Kore/Internal/Predicate.hs | 17 ++-- kore/src/Kore/Step/RulePattern.hs | 8 +- kore/src/Kore/Step/SMT/Translate.hs | 2 +- .../src/Kore/Step/Simplification/Predicate.hs | 7 +- kore/src/Prelude/Kore.hs | 6 ++ kore/test/Test/Kore/Builtin/KEqual.hs | 2 +- kore/test/Test/Kore/Reachability/Claim.hs | 2 +- .../test/Test/Kore/Step/Simplification/And.hs | 32 ++++---- .../Kore/Step/Simplification/Application.hs | 4 +- .../Test/Kore/Step/Simplification/Ceil.hs | 40 +++++----- .../Test/Kore/Step/Simplification/Exists.hs | 12 +-- .../test/Test/Kore/Step/Simplification/Iff.hs | 40 +++++----- .../Test/Kore/Step/Simplification/Implies.hs | 10 +-- .../Kore/Step/Simplification/Integration.hs | 77 ++++++++++--------- .../Simplification/IntegrationProperty.hs | 2 +- .../test/Test/Kore/Step/Simplification/Not.hs | 16 ++-- kore/test/Test/Kore/Step/Simplification/Or.hs | 2 +- .../Test/Kore/Step/Simplification/Pattern.hs | 4 +- kore/test/Test/Kore/Unification/Unifier.hs | 2 +- 22 files changed, 172 insertions(+), 149 deletions(-) diff --git a/kore/app/exec/Main.hs b/kore/app/exec/Main.hs index 0623cb2fd1..4da6d5c19a 100644 --- a/kore/app/exec/Main.hs +++ b/kore/app/exec/Main.hs @@ -100,10 +100,14 @@ import Kore.Reachability ( SomeClaim, StuckClaim (..), getConfiguration, + lensClaimPattern, ) import qualified Kore.Reachability.Claim as Claim import Kore.Rewriting.RewritingVariable import Kore.Step +import Kore.Step.ClaimPattern ( + getClaimPatternSort, + ) import Kore.Step.RulePattern ( mapRuleVariables, ) @@ -122,9 +126,6 @@ import Kore.Syntax.Definition ( Sentence (..), ) import qualified Kore.Syntax.Definition as Definition.DoNotUse -import Kore.TopBottom ( - isTop, - ) import Kore.Unparser ( unparse, ) @@ -710,18 +711,22 @@ koreProve execOptions proveOptions = do maybeAlreadyProvenModule let ProveClaimsResult{stuckClaims, provenClaims} = proveResult - let (exitCode, final) - | noStuckClaims = success - | otherwise = - stuckPatterns - & OrPattern.toTermLike - & failure + let (exitCode, final) = + case foldFirst stuckClaims of + Nothing -> success -- stuckClaims is empty + Just claim -> + stuckPatterns + & OrPattern.toTermLike (getClaimPatternSort $ claimPattern claim) + & failure where - noStuckClaims = isTop stuckClaims stuckPatterns = OrPattern.fromPatterns (MultiAnd.map getStuckConfig stuckClaims) getStuckConfig = getRewritingPattern . getConfiguration . getStuckClaim + claimPattern claim = + claim + & getStuckClaim + & Lens.view lensClaimPattern lift $ for_ saveProofs $ saveProven specModule provenClaims lift $ renderResult execOptions (unparse final) return (kFileLocations definition, exitCode) diff --git a/kore/src/Kore/Equation/Validate.hs b/kore/src/Kore/Equation/Validate.hs index 94bdcf7d89..ad69816d9b 100644 --- a/kore/src/Kore/Equation/Validate.hs +++ b/kore/src/Kore/Equation/Validate.hs @@ -42,6 +42,9 @@ import Kore.Internal.Predicate ( ) import qualified Kore.Internal.Predicate as Predicate import qualified Kore.Internal.Symbol as Symbol +import Kore.Internal.TermLike ( + mkSortVariable, + ) import qualified Kore.Internal.TermLike as TermLike import Kore.Syntax.Definition import Kore.Syntax.Variable @@ -138,8 +141,8 @@ validateAxiom attrs verified = findBadArgSubterm term checkArgIn (PredicateCeil (TermLike.And_ _ (TermLike.Var_ _) term)) = findBadArgSubterm term - checkArgIn badArg = Just $ Predicate.fromPredicate_ badArg - + checkArgIn badArg = + Just $ Predicate.fromPredicate (mkSortVariable "_") badArg --pretty findBadArgSubterm term = case term of _ | TermLike.isConstructorLike term -> descend diff --git a/kore/src/Kore/Exec.hs b/kore/src/Kore/Exec.hs index d27a86734b..3b053691b4 100644 --- a/kore/src/Kore/Exec.hs +++ b/kore/src/Kore/Exec.hs @@ -86,7 +86,7 @@ import Kore.Internal.Pattern ( ) import qualified Kore.Internal.Pattern as Pattern import Kore.Internal.Predicate ( - fromPredicate_, + fromPredicate, makeMultipleOrPredicate, ) import qualified Kore.Internal.SideCondition as SideCondition @@ -429,7 +429,7 @@ search return . sameTermLikeSort patternSort . getRewritingTerm - . fromPredicate_ + . fromPredicate patternSort $ orPredicate where patternSort = termLikeSort termLike diff --git a/kore/src/Kore/Internal/Predicate.hs b/kore/src/Kore/Internal/Predicate.hs index a3f250a972..a5f3b95bba 100644 --- a/kore/src/Kore/Internal/Predicate.hs +++ b/kore/src/Kore/Internal/Predicate.hs @@ -8,7 +8,6 @@ module Kore.Internal.Predicate ( unparseWithSort, unparse2WithSort, fromPredicate, - fromPredicate_, makePredicate, makeTruePredicate, makeFalsePredicate, @@ -305,7 +304,7 @@ instance NFData variable => NFData (Predicate variable) where rnf annotation `seq` rnf pat instance InternalVariable variable => Pretty (Predicate variable) where - pretty = unparse . fromPredicate_ + pretty = unparse . fromPredicate (mkSortVariable "_") instance InternalVariable variable => SQL.Column (Predicate variable) where defineColumn = SQL.defineTextColumn @@ -497,12 +496,6 @@ fromPredicate sort = Recursive.fold worker OrF (Or () t1 t2) -> TermLike.mkOr t1 t2 TopF _ -> TermLike.mkTop sort -fromPredicate_ :: - InternalVariable variable => - Predicate variable -> - TermLike variable -fromPredicate_ = fromPredicate undefined - {- | Simple type used to track whether a predicate building function performed a simplification that changed the shape of the resulting term. This is needed when these functions are called while traversing the Predicate tree. @@ -862,7 +855,9 @@ instance pretty (NotPredicate termLikeF) = Pretty.vsep [ "Expected a predicate, but found:" - , Pretty.indent 4 (unparse $ fromPredicate_ <$> termLikeF) + , Pretty.indent + 4 + (unparse $ fromPredicate (mkSortVariable "_") <$> termLikeF) ] makePredicate :: @@ -994,7 +989,7 @@ cannotSimplifyNotSimplifiedError predF = ++ unparseToString term ) where - term = fromPredicate_ (synthesize predF) + term = fromPredicate (mkSortVariable "_") (synthesize predF) simplifiedFromChildren :: HasCallStack => @@ -1117,7 +1112,7 @@ mapVariables :: mapVariables adj predicate = let termPredicate = TermLike.mapVariables adj - . fromPredicate_ + . fromPredicate (mkSortVariable "BadSort") $ predicate in either errorMappingVariables diff --git a/kore/src/Kore/Step/RulePattern.hs b/kore/src/Kore/Step/RulePattern.hs index ad516c94a3..a2b5ca1ffa 100644 --- a/kore/src/Kore/Step/RulePattern.hs +++ b/kore/src/Kore/Step/RulePattern.hs @@ -89,6 +89,7 @@ import Kore.Internal.Symbol ( ) import Kore.Internal.TermLike ( TermLike, + termLikeSort, ) import qualified Kore.Internal.TermLike as TermLike import Kore.Internal.Variable ( @@ -294,11 +295,14 @@ lhsToTerm :: Predicate variable -> TermLike variable lhsToTerm left Nothing requires = - TermLike.mkAnd (Predicate.fromPredicate_ requires) left + TermLike.mkAnd (Predicate.fromPredicate (termLikeSort left) requires) left lhsToTerm left (Just antiLeft) requires = TermLike.mkAnd (TermLike.mkNot (AntiLeft.toTermLike antiLeft)) - (TermLike.mkAnd (Predicate.fromPredicate_ requires) left) + ( TermLike.mkAnd + (Predicate.fromPredicate (termLikeSort left) requires) + left + ) -- | Wraps a term as a RHS injectTermIntoRHS :: diff --git a/kore/src/Kore/Step/SMT/Translate.hs b/kore/src/Kore/Step/SMT/Translate.hs index e90c25a436..da64ffd4da 100644 --- a/kore/src/Kore/Step/SMT/Translate.hs +++ b/kore/src/Kore/Step/SMT/Translate.hs @@ -134,7 +134,7 @@ translatePredicateWith :: Translator variable m SExpr translatePredicateWith sideCondition translateTerm predicate = translatePredicatePattern $ - fromPredicate_ predicate + fromPredicate (mkSortVariable "BadSort") predicate where translatePredicatePattern :: p -> Translator variable m SExpr translatePredicatePattern pat diff --git a/kore/src/Kore/Step/Simplification/Predicate.hs b/kore/src/Kore/Step/Simplification/Predicate.hs index 0c923718f7..c5ba2408ae 100644 --- a/kore/src/Kore/Step/Simplification/Predicate.hs +++ b/kore/src/Kore/Step/Simplification/Predicate.hs @@ -31,6 +31,9 @@ import Kore.Internal.SideCondition ( SideCondition, ) import qualified Kore.Internal.SideCondition as SideCondition +import Kore.Internal.TermLike ( + mkSortVariable, + ) import Kore.Rewriting.RewritingVariable ( RewritingVariableName, ) @@ -66,7 +69,9 @@ simplifyPredicateTODO :: LogicT simplifier (MultiAnd (Predicate RewritingVariableName)) simplifyPredicateTODO sideCondition predicate = do patternOr <- - simplifyTermLike sideCondition (Predicate.fromPredicate_ predicate) + simplifyTermLike + sideCondition + (Predicate.fromPredicate (mkSortVariable "BadSort") predicate) & lift -- Despite using lift above, we do not need to -- explicitly check for \bottom because patternOr is an OrPattern. diff --git a/kore/src/Prelude/Kore.hs b/kore/src/Prelude/Kore.hs index 8951055591..475dcbf5f6 100644 --- a/kore/src/Prelude/Kore.hs +++ b/kore/src/Prelude/Kore.hs @@ -32,6 +32,9 @@ module Prelude.Kore ( -- * Filterable Filterable (..), + -- * Foldable + foldFirst, + -- * Witherable Witherable (..), @@ -201,3 +204,6 @@ minMaxBy :: (a -> a -> Ordering) -> a -> a -> (a, a) minMaxBy cmp a b | cmp a b == LT = (a, b) | otherwise = (b, a) + +foldFirst :: Foldable f => f a -> Maybe a +foldFirst = foldr (\x _ -> pure x) Nothing \ No newline at end of file diff --git a/kore/test/Test/Kore/Builtin/KEqual.hs b/kore/test/Test/Kore/Builtin/KEqual.hs index 0815ff047f..3f9f94f974 100644 --- a/kore/test/Test/Kore/Builtin/KEqual.hs +++ b/kore/test/Test/Kore/Builtin/KEqual.hs @@ -195,7 +195,7 @@ test_KEqualSimplification = keqBool (kseq (inj kItemSort dvX) dotk) (kseq (inj kItemSort dvT) dotk) - expect = [Just (Pattern.topOf kSort)] + expect = [Just (Pattern.topOf boolSort)] actual <- runKEqualSimplification term1 term2 assertEqual' "" expect actual ] diff --git a/kore/test/Test/Kore/Reachability/Claim.hs b/kore/test/Test/Kore/Reachability/Claim.hs index 5dba5075f0..12d79ed9a7 100644 --- a/kore/test/Test/Kore/Reachability/Claim.hs +++ b/kore/test/Test/Kore/Reachability/Claim.hs @@ -243,7 +243,7 @@ test_simplifyRightHandSide = Pattern.fromTermAndPredicate Mock.b ( makeEqualsPredicate - (TermLike.mkTop Mock.testSort) + (TermLike.mkTop Mock.boolSort) (Mock.builtinInt 3 `Mock.lessInt` Mock.builtinInt 2) ) claim = diff --git a/kore/test/Test/Kore/Step/Simplification/And.hs b/kore/test/Test/Kore/Step/Simplification/And.hs index d3123d0c4c..beeb7dd32a 100644 --- a/kore/test/Test/Kore/Step/Simplification/And.hs +++ b/kore/test/Test/Kore/Step/Simplification/And.hs @@ -110,7 +110,7 @@ test_andSimplification = , testCase "And predicates" $ do let expect = Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeAndPredicate (makeCeilPredicate fOfX) @@ -120,12 +120,12 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeCeilPredicate fOfX , substitution = mempty } Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeCeilPredicate gOfX , substitution = mempty } @@ -133,7 +133,7 @@ test_andSimplification = , testCase "And substitutions - simple" $ do let expect = Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = Substitution.unsafeWrap @@ -144,7 +144,7 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -152,7 +152,7 @@ test_andSimplification = [(inject Mock.yConfig, fOfX)] } Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -183,7 +183,7 @@ test_andSimplification = , testCase "And substitutions - separate predicate" $ do let expect = Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeEqualsPredicate fOfX gOfX , substitution = Substitution.unsafeWrap [(inject Mock.yConfig, fOfX)] @@ -191,7 +191,7 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -199,7 +199,7 @@ test_andSimplification = [(inject Mock.yConfig, fOfX)] } Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -211,7 +211,7 @@ test_andSimplification = actual <- evaluatePatterns Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -224,7 +224,7 @@ test_andSimplification = ] } Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = Substitution.wrap $ @@ -352,7 +352,7 @@ test_andSimplification = , substitution = mempty } , Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeAndPredicate (makeCeilPredicate fOfX) @@ -365,14 +365,14 @@ test_andSimplification = ( makeAnd [ fOfXExpanded , Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeCeilPredicate fOfX , substitution = mempty } ] [ gOfXExpanded , Conditional - { term = mkTop Mock.topSort + { term = mkTop Mock.testSort , predicate = makeCeilPredicate gOfX , substitution = mempty } @@ -466,7 +466,7 @@ evaluate :: IO (OrPattern RewritingVariableName) evaluate And{andFirst, andSecond} = MultiAnd.make [andFirst, andSecond] - & simplify Mock.topSort Not.notSimplifier SideCondition.top + & simplify Mock.testSort Not.notSimplifier SideCondition.top & runSimplifier Mock.env evaluatePatterns :: @@ -475,6 +475,6 @@ evaluatePatterns :: IO (OrPattern RewritingVariableName) evaluatePatterns first second = MultiAnd.make [first, second] - & makeEvaluate Mock.topSort Not.notSimplifier SideCondition.top + & makeEvaluate Mock.testSort Not.notSimplifier SideCondition.top & runSimplifierBranch Mock.env & fmap OrPattern.fromPatterns diff --git a/kore/test/Test/Kore/Step/Simplification/Application.hs b/kore/test/Test/Kore/Step/Simplification/Application.hs index f4427ed219..5b87c84b8d 100644 --- a/kore/test/Test/Kore/Step/Simplification/Application.hs +++ b/kore/test/Test/Kore/Step/Simplification/Application.hs @@ -88,7 +88,7 @@ test_applicationSimplification = assertEqual "" expect actual , testCase "Application - bottom child makes everything bottom" $ do -- sigma(a or b, bottom) = bottom - let expect = OrPattern.fromPatterns [Pattern.bottom] + let expect = OrPattern.fromPatterns [Pattern.bottomOf Mock.testSort] actual <- evaluate Map.empty @@ -111,7 +111,7 @@ test_applicationSimplification = ( makeApplication Mock.sigmaSymbol [ [aExpanded] - , [Pattern.top] + , [Pattern.topOf Mock.testSort] ] ) assertEqual "" expect actual diff --git a/kore/test/Test/Kore/Step/Simplification/Ceil.hs b/kore/test/Test/Kore/Step/Simplification/Ceil.hs index 623cfcd435..80fb838e43 100644 --- a/kore/test/Test/Kore/Step/Simplification/Ceil.hs +++ b/kore/test/Test/Kore/Step/Simplification/Ceil.hs @@ -58,12 +58,12 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeCeilPredicate somethingOfA , substitution = mempty } , Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeCeilPredicate somethingOfB , substitution = mempty } @@ -81,12 +81,12 @@ test_ceilSimplification = actual1 <- evaluate ( makeCeil - [Pattern.top] + [Pattern.topOf Mock.testSort] ) assertEqual "ceil(top)" ( OrPattern.fromPatterns - [Pattern.top] + [Pattern.topOf Mock.testSort] ) actual1 -- ceil(bottom) = bottom @@ -114,7 +114,7 @@ test_ceilSimplification = assertEqual "ceil(top)" ( OrPattern.fromPatterns - [Pattern.top] + [Pattern.topOf Mock.testSort] ) actual1 ) @@ -122,15 +122,15 @@ test_ceilSimplification = "expanded Ceil - bool operations" ( do -- ceil(top) = top - actual1 <- makeEvaluate Pattern.top + actual1 <- makeEvaluate (Pattern.topOf Mock.testSort) assertEqual "ceil(top)" ( OrPattern.fromPatterns - [Pattern.top] + [Pattern.topOf Mock.testSort] ) actual1 -- ceil(bottom) = bottom - actual2 <- makeEvaluate Pattern.bottom + actual2 <- makeEvaluate (Pattern.bottomOf Mock.testSort) assertEqual "ceil(bottom)" ( OrPattern.fromPatterns @@ -145,7 +145,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeAndPredicate (makeCeilPredicate somethingOfA) @@ -176,7 +176,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeAndPredicate ( makeAndPredicate @@ -204,7 +204,7 @@ test_ceilSimplification = expected actual , testCase "ceil of constructors is top" $ do - let expected = OrPattern.fromPatterns [Pattern.top] + let expected = OrPattern.fromPatterns [Pattern.topOf Mock.testSort] actual <- makeEvaluate Conditional @@ -220,7 +220,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeAndPredicate ( makeAndPredicate @@ -253,7 +253,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeAndPredicate (makeCeilPredicate fOfA) @@ -283,7 +283,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeEqualsPredicate fOfA gOfA , substitution = Substitution.unsafeWrap [(inject Mock.xConfig, fOfB)] @@ -312,7 +312,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeAndPredicate ( makeAndPredicate @@ -347,7 +347,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeAndPredicate (makeEqualsPredicate Mock.a Mock.cf) @@ -364,7 +364,7 @@ test_ceilSimplification = ) ( appliedMockEvaluator Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeEqualsPredicate Mock.a Mock.cf , substitution = mempty } @@ -387,7 +387,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeTruePredicate , substitution = mempty } @@ -406,7 +406,7 @@ test_ceilSimplification = let expected = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeAndPredicate (makeCeilPredicate fOfA) @@ -426,7 +426,7 @@ test_ceilSimplification = let expected = OrPattern.fromPattern Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeCeilPredicate fOfA , substitution = mempty } diff --git a/kore/test/Test/Kore/Step/Simplification/Exists.hs b/kore/test/Test/Kore/Step/Simplification/Exists.hs index 23d313dac9..883f6409b4 100644 --- a/kore/test/Test/Kore/Step/Simplification/Exists.hs +++ b/kore/test/Test/Kore/Step/Simplification/Exists.hs @@ -40,7 +40,7 @@ test_simplify :: [TestTree] test_simplify = [ [plain10, plain11] `simplifiesTo` [plain10', plain11'] $ "\\or distribution" - , [Pattern.top] `simplifiesTo` [Pattern.top] $ + , [Pattern.topOf Mock.testSort] `simplifiesTo` [Pattern.topOf Mock.testSort] $ "\\top" , [] `simplifiesTo` [] $ "\\bottom" @@ -158,18 +158,18 @@ test_makeEvaluate = [ testGroup "Exists - Predicates" [ testCase "Top" $ do - let expect = OrPattern.fromPatterns [Pattern.top] + let expect = OrPattern.fromPatterns [Pattern.topOf Mock.testSort] actual <- makeEvaluate Mock.xConfig - (Pattern.top :: Pattern RewritingVariableName) + (Pattern.topOf Mock.testSort :: Pattern RewritingVariableName) assertEqual "" expect actual , testCase " Bottom" $ do let expect = OrPattern.fromPatterns [] actual <- makeEvaluate Mock.xConfig - (Pattern.bottom :: Pattern RewritingVariableName) + (Pattern.bottomOf Mock.testSort :: Pattern RewritingVariableName) assertEqual "" expect actual ] , testCase "exists applies substitution if possible" $ do @@ -284,12 +284,12 @@ test_makeEvaluate = , testCase "exists reevaluates" $ do -- exists x . (top and (f(x) = f(g(a)) and [x=g(a)]) -- = top.s - let expect = OrPattern.fromPatterns [Pattern.top] + let expect = OrPattern.fromPatterns [Pattern.topOf Mock.testSort] actual <- makeEvaluate Mock.xConfig Conditional - { term = mkTop_ + { term = mkTop Mock.testSort , predicate = makeEqualsPredicate fOfX (Mock.f gOfA) , substitution = Substitution.wrap $ diff --git a/kore/test/Test/Kore/Step/Simplification/Iff.hs b/kore/test/Test/Kore/Step/Simplification/Iff.hs index 087264aee5..37067ad4ae 100644 --- a/kore/test/Test/Kore/Step/Simplification/Iff.hs +++ b/kore/test/Test/Kore/Step/Simplification/Iff.hs @@ -41,10 +41,10 @@ test_simplify = (testSimplifyBoolean <$> [minBound ..] <*> [minBound ..]) , testGroup "Half-Boolean operations" - [ (top, termA) `becomes` [termA] $ "iff(⊤, a) = a" - , (termA, top) `becomes` [termA] $ "iff(a, ⊤) = a" - , (bottom, termA) `becomes` [termNotA] $ "iff(⊤, a) = ¬a" - , (termA, bottom) `becomes` [termNotA] $ "iff(a, ⊤) = ¬a" + [ (topOf Mock.testSort, termA) `becomes` [termA] $ "iff(⊤, a) = a" + , (termA, topOf Mock.testSort) `becomes` [termA] $ "iff(a, ⊤) = a" + , (bottomOf Mock.testSort, termA) `becomes` [termNotA] $ "iff(⊤, a) = ¬a" + , (termA, bottomOf Mock.testSort) `becomes` [termNotA] $ "iff(a, ⊤) = ¬a" ] ] where @@ -61,20 +61,20 @@ test_makeEvaluate = (testEvaluateBoolean <$> [minBound ..] <*> [minBound ..]) , testGroup "Half-Boolean operations" - [ (top, termA) `becomes` [termA] $ "iff(⊤, a) = a" - , (termA, top) `becomes` [termA] $ "iff(a, ⊤) = a" - , (bottom, termA) `becomes` [termNotA] $ "iff(⊤, a) = ¬a" - , (termA, bottom) `becomes` [termNotA] $ "iff(a, ⊤) = ¬a" + [ (topOf Mock.testSort, termA) `becomes` [termA] $ "iff(⊤, a) = a" + , (termA, topOf Mock.testSort) `becomes` [termA] $ "iff(a, ⊤) = a" + , (bottomOf Mock.testSort, termA) `becomes` [termNotA] $ "iff(⊤, a) = ¬a" + , (termA, bottomOf Mock.testSort) `becomes` [termNotA] $ "iff(a, ⊤) = ¬a" ] , testCase "iff with predicates and substitutions" - -- iff(top and predicate1 and subst1, top and predicate2 and subst2) - -- = top and (iff(predicate1 and subst1, predicate2 and subst2) + -- iff(topOf Mock.testSort and predicate1 and subst1, topOf Mock.testSort and predicate2 and subst2) + -- = topOf Mock.testSort and (iff(predicate1 and subst1, predicate2 and subst2) ( assertEqual - "iff(top and predicate, top and predicate)" + "iff(topOf Mock.testSort and predicate, topOf Mock.testSort and predicate)" ( OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = (mkTop Mock.testSort) , predicate = makeIffPredicate ( makeAndPredicate @@ -97,7 +97,7 @@ test_makeEvaluate = ) ( makeEvaluate Conditional - { term = mkTop_ + { term = (mkTop Mock.testSort) , predicate = makeCeilPredicate Mock.cf , substitution = Substitution.wrap $ @@ -105,7 +105,7 @@ test_makeEvaluate = [(inject Mock.xConfig, Mock.a)] } Conditional - { term = mkTop_ + { term = (mkTop Mock.testSort) , predicate = makeCeilPredicate Mock.cg , substitution = Substitution.wrap $ @@ -125,16 +125,16 @@ test_makeEvaluate = ( mkAnd ( mkAnd (Mock.f Mock.a) - (mkCeil_ Mock.cf) + (mkCeil Mock.testSort Mock.cf) ) - (mkEquals_ (mkElemVar Mock.xConfig) Mock.a) + (mkEquals Mock.testSort (mkElemVar Mock.xConfig) Mock.a) ) ( mkAnd ( mkAnd (Mock.g Mock.b) - (mkCeil_ Mock.cg) + (mkCeil Mock.testSort Mock.cg) ) - (mkEquals_ (mkElemVar Mock.yConfig) Mock.b) + (mkEquals Mock.testSort (mkElemVar Mock.yConfig) Mock.b) ) , predicate = makeTruePredicate , substitution = mempty @@ -192,8 +192,8 @@ nameBool x valueBool :: Bool -> Pattern RewritingVariableName valueBool x - | x = Pattern.top - | otherwise = Pattern.bottom + | x = Pattern.topOf Mock.testSort + | otherwise = Pattern.bottomOf Mock.testSort termA :: Pattern RewritingVariableName termA = diff --git a/kore/test/Test/Kore/Step/Simplification/Implies.hs b/kore/test/Test/Kore/Step/Simplification/Implies.hs index e9a8ae0fa7..07df8f9fcb 100644 --- a/kore/test/Test/Kore/Step/Simplification/Implies.hs +++ b/kore/test/Test/Kore/Step/Simplification/Implies.hs @@ -31,10 +31,10 @@ import Test.Tasty.HUnit test_simplifyEvaluated :: [TestTree] test_simplifyEvaluated = - [ ([Pattern.top], [Pattern.top]) `becomes_` [Pattern.top] - , ([Pattern.top], []) `becomes_` [] - , ([], [Pattern.top]) `becomes_` [Pattern.top] - , ([], []) `becomes_` [Pattern.top] + [ ([Pattern.topOf Mock.testSort], [Pattern.topOf Mock.testSort]) `becomes_` [Pattern.topOf Mock.testSort] + , ([Pattern.topOf Mock.testSort], []) `becomes_` [] + , ([], [Pattern.topOf Mock.testSort]) `becomes_` [Pattern.topOf Mock.testSort] + , ([], []) `becomes_` [Pattern.topOf Mock.testSort] , ([termA], [termB]) `becomes_` [aImpliesB] , ([equalsXA], [equalsXB]) `becomes_` [impliesEqualsXAEqualsXB] , ([equalsXA], [equalsXB, equalsXC]) @@ -131,6 +131,6 @@ simplifyEvaluated :: IO (OrPattern.OrPattern RewritingVariableName) simplifyEvaluated first second = runSimplifier mockEnv $ - Implies.simplifyEvaluated SideCondition.top first second + Implies.simplifyEvaluated Mock.testSort SideCondition.top first second where mockEnv = Mock.env diff --git a/kore/test/Test/Kore/Step/Simplification/Integration.hs b/kore/test/Test/Kore/Step/Simplification/Integration.hs index c3fe2fda6c..70f95788b7 100644 --- a/kore/test/Test/Kore/Step/Simplification/Integration.hs +++ b/kore/test/Test/Kore/Step/Simplification/Integration.hs @@ -96,9 +96,9 @@ test_simplificationIntegration = ( mkExists Mock.xConfig ( mkAnd - mkTop_ + (mkTop Mock.testSort) ( mkAnd - ( mkCeil_ + ( (mkCeil Mock.testSort) ( mkAnd ( Mock.constr10 ( mkElemVar @@ -108,20 +108,20 @@ test_simplificationIntegration = (Mock.constr10 Mock.a) ) ) - mkTop_ + (mkTop Mock.testSort) ) ) ) - mkBottom_ + (mkBottom Mock.testSort) ) ) - mkTop_ + (mkTop Mock.testSort) , predicate = makeTruePredicate , substitution = mempty } assertEqual "" expect actual , testCase "owise condition - owise case" $ do - let expect = OrPattern.fromPatterns [Pattern.top] + let expect = OrPattern.fromPatterns [Pattern.topOf Mock.testSort] actual <- evaluate Conditional @@ -135,9 +135,9 @@ test_simplificationIntegration = ( mkExists Mock.xConfig ( mkAnd - mkTop_ + (mkTop Mock.testSort) ( mkAnd - ( mkCeil_ + ( (mkCeil Mock.testSort) ( mkAnd ( Mock.constr10 ( mkElemVar @@ -147,14 +147,14 @@ test_simplificationIntegration = (Mock.constr11 Mock.a) ) ) - mkTop_ + (mkTop Mock.testSort) ) ) ) - mkBottom_ + (mkBottom Mock.testSort) ) ) - mkTop_ + (mkTop Mock.testSort) , predicate = makeTruePredicate , substitution = mempty } @@ -163,7 +163,7 @@ test_simplificationIntegration = let expects = OrPattern.fromPatterns [ Conditional - { term = mkTop_ + { term = (mkTop Mock.testSort) , predicate = makeAndPredicate ( makeAndPredicate @@ -190,7 +190,7 @@ test_simplificationIntegration = evaluate Conditional { term = - mkCeil_ + (mkCeil Mock.testSort) ( mkAnd ( Mock.constr20 (Mock.plain10 Mock.cf) @@ -311,7 +311,7 @@ test_simplificationIntegration = } assertEqual "" expect actual , testCase "exists variable equality" $ do - let expect = OrPattern.top + let expect = OrPattern.top Mock.testSort actual <- evaluateWithAxioms Map.empty @@ -319,7 +319,7 @@ test_simplificationIntegration = { term = mkExists Mock.xConfig - ( mkEquals_ + ( (mkEquals Mock.testSort) (mkElemVar Mock.xConfig) (mkElemVar Mock.yConfig) ) @@ -328,7 +328,7 @@ test_simplificationIntegration = } assertEqual "" expect actual , testCase "exists variable equality reverse" $ do - let expect = OrPattern.top + let expect = OrPattern.top Mock.testSort actual <- evaluateWithAxioms Map.empty @@ -336,7 +336,7 @@ test_simplificationIntegration = { term = mkExists Mock.xConfig - ( mkEquals_ + ( (mkEquals Mock.testSort) (mkElemVar Mock.yConfig) (mkElemVar Mock.xConfig) ) @@ -349,15 +349,15 @@ test_simplificationIntegration = evaluateWithAxioms Map.empty $ Pattern.fromTermLike $ mkExists Mock.xConfig $ - mkEquals_ (mkElemVar Mock.xConfig) (mkElemVar Mock.yConfig) - assertEqual "" OrPattern.top actual + (mkEquals Mock.testSort) (mkElemVar Mock.xConfig) (mkElemVar Mock.yConfig) + assertEqual "" (OrPattern.top Mock.testSort) actual , testCase "exists variable equality reverse" $ do actual <- evaluateWithAxioms Map.empty $ Pattern.fromTermLike $ mkExists Mock.xConfig $ - mkEquals_ (mkElemVar Mock.yConfig) (mkElemVar Mock.xConfig) - assertEqual "" OrPattern.top actual + (mkEquals Mock.testSort) (mkElemVar Mock.yConfig) (mkElemVar Mock.xConfig) + assertEqual "" (OrPattern.top Mock.testSort) actual , testCase "simplification with top predicate (exists variable capture)" $ do let requirement = \var -> @@ -524,7 +524,7 @@ test_simplificationIntegration = actual <- evaluate Conditional - { term = mkIff Mock.bSort0 mkBottom_ + { term = mkIff Mock.bSort0 (mkBottom Mock.testSort0) , predicate = makeTruePredicate , substitution = mempty } @@ -553,13 +553,13 @@ test_simplificationIntegration = mkIff ( mkIn Mock.boolSort - (mkCeil_ Mock.cf) + ((mkCeil Mock.setSort) Mock.cf) ( mkOr Mock.unitSet - (mkCeil_ Mock.cg) + ((mkCeil Mock.setSort) Mock.cg) ) ) - (mkCeil_ Mock.ch) + ((mkCeil Mock.boolSort) Mock.ch) , predicate = makeTruePredicate , substitution = mempty } @@ -587,13 +587,16 @@ test_simplificationIntegration = mkAnd ( Mock.concatList ( mkImplies - (mkImplies mkBottom_ mkTop_) - (mkIn_ Mock.cfSort0 Mock.cgSort0) + ( mkImplies + (mkBottom Mock.listSort) + (mkTop Mock.listSort) + ) + ((mkIn Mock.listSort) Mock.cfSort0 Mock.cgSort0) ) ( mkImplies ( mkAnd - (mkMu m mkBottom_) - mkBottom_ + (mkMu m (mkBottom Mock.listSort)) + (mkBottom Mock.listSort) ) (mkImplies Mock.unitList (mkNu ue Mock.unitList)) ) @@ -622,12 +625,12 @@ test_simplificationIntegration = { term = mkNu gt - ( mkEquals_ - ( mkIn_ - mkTop_ + ( (mkEquals Mock.stringSort) + ( (mkIn Mock.listSort) + (mkTop Mock.testSort1) (mkNu g (mkOr Mock.aSort1 (mkSetVar g))) ) - mkTop_ + (mkTop Mock.listSort) ) , predicate = makeTruePredicate , substitution = mempty @@ -655,7 +658,7 @@ test_simplificationIntegration = { term = mkMu k - ( mkEquals_ + ( (mkEquals Mock.stringSort) (Mock.functionalConstr21 Mock.cf Mock.cf) (Mock.functionalConstr21 Mock.ch Mock.cg) ) @@ -673,8 +676,8 @@ test_simplificationIntegration = { term = mkNu q - ( mkFloor_ - ( mkIn_ + ( (mkFloor Mock.otherSort) + ( (mkIn Mock.otherSort) (Mock.g Mock.ch) (mkOr Mock.cf Mock.cg) ) @@ -695,7 +698,7 @@ test_simplificationIntegration = (mkStringLiteral "a") (mkStringLiteral "b") ) - mkBottom_ + (mkBottom Mock.subSort) , predicate = makeTruePredicate , substitution = mempty } diff --git a/kore/test/Test/Kore/Step/Simplification/IntegrationProperty.hs b/kore/test/Test/Kore/Step/Simplification/IntegrationProperty.hs index 56cc693f0f..617419bffa 100644 --- a/kore/test/Test/Kore/Step/Simplification/IntegrationProperty.hs +++ b/kore/test/Test/Kore/Step/Simplification/IntegrationProperty.hs @@ -66,7 +66,7 @@ import Test.Tasty import Test.Tasty.HUnit.Ext test_simplifiesToSimplified :: TestTree -test_simplifiesToSimplified = +test_simplifiesToSimplified = do testPropertyWithoutSolver "simplify returns simplified pattern" $ do term <- forAll (runTermGen Mock.generatorSetup termLikeGen) let term' = mkRewritingTerm term diff --git a/kore/test/Test/Kore/Step/Simplification/Not.hs b/kore/test/Test/Kore/Step/Simplification/Not.hs index fcc648e97d..bc3c0d146c 100644 --- a/kore/test/Test/Kore/Step/Simplification/Not.hs +++ b/kore/test/Test/Kore/Step/Simplification/Not.hs @@ -31,12 +31,12 @@ import Test.Tasty.HUnit.Ext test_simplifyEvaluated :: [TestTree] test_simplifyEvaluated = - [ [Pattern.top] `becomes_` [] - , [] `becomes_` [Pattern.top] + [ [Pattern.topOf Mock.testSort] `becomes_` [] + , [] `becomes_` [Pattern.topOf Mock.testSort] , [termX] `becomes_` [termNotX] , [termNotX] `becomes_` [termX] , [equalsXA] `becomes_` [notEqualsXA] - , equalsXAWithSortedBottom `patternBecomes` [Pattern.top] + , equalsXAWithSortedBottom `patternBecomes` [Pattern.topOf Mock.testSort] , [substXA] `becomes_` [notEqualsXA] , [equalsXA, equalsXB] `becomes_` [neitherXAB] , [xAndEqualsXA] `becomes_` [termNotX, notEqualsXASorted] @@ -154,14 +154,14 @@ substXA = fromSubstitution $ Substitution.unsafeWrap [(inject Mock.xConfig, Mock forceTermSort :: Pattern.Pattern RewritingVariableName -> Pattern.Pattern RewritingVariableName -forceTermSort = fmap (forceSort Mock.testSort) +forceTermSort = fmap (sameTermLikeSort Mock.testSort) fromPredicate :: Predicate.Predicate RewritingVariableName -> Pattern.Pattern RewritingVariableName fromPredicate = forceTermSort - . Pattern.fromCondition_ + . Pattern.fromCondition Mock.testSort . Condition.fromPredicate fromSubstitution :: @@ -169,13 +169,15 @@ fromSubstitution :: Pattern.Pattern RewritingVariableName fromSubstitution = forceTermSort - . Pattern.fromCondition_ + . Pattern.fromCondition Mock.testSort . Condition.fromSubstitution simplifyEvaluated :: OrPattern.OrPattern RewritingVariableName -> IO (OrPattern.OrPattern RewritingVariableName) simplifyEvaluated = - runSimplifier mockEnv . Not.simplifyEvaluated SideCondition.top + runSimplifier mockEnv . mkNotSimplified where mockEnv = Mock.env + mkNotSimplified notChild = + Not.simplify SideCondition.top Not{notSort = Mock.testSort, notChild} diff --git a/kore/test/Test/Kore/Step/Simplification/Or.hs b/kore/test/Test/Kore/Step/Simplification/Or.hs index aed9eb0c9c..d47fb5b9fb 100644 --- a/kore/test/Test/Kore/Step/Simplification/Or.hs +++ b/kore/test/Test/Kore/Step/Simplification/Or.hs @@ -223,7 +223,7 @@ becomes ( stateIntention [ prettyOr or1 or2 , "to become:" - , Unparser.unparse $ OrPattern.toTermLike expected + , Unparser.unparse $ OrPattern.toTermLike Mock.testSort expected ] ) diff --git a/kore/test/Test/Kore/Step/Simplification/Pattern.hs b/kore/test/Test/Kore/Step/Simplification/Pattern.hs index 6516a1fb37..c8eacc138b 100644 --- a/kore/test/Test/Kore/Step/Simplification/Pattern.hs +++ b/kore/test/Test/Kore/Step/Simplification/Pattern.hs @@ -341,7 +341,7 @@ test_Pattern_simplify_equalityterm = ] first = Mock.cf second = - OrPattern.toTermLike + OrPattern.toTermLike Mock.testSort . OrPattern.fromPatterns $ [ Conditional { term = Mock.cg @@ -401,7 +401,7 @@ termLike = Pattern.fromTermLike -- | Term is \bottom, but not in a trivial way. notTop, orAs, bottomLike :: Pattern RewritingVariableName -notTop = termLike (mkNot mkTop_) +notTop = termLike (mkNot $ mkTop Mock.testSort) -- | Lifting disjunction to the top would duplicate terms. orAs = termLike (mkOr Mock.a Mock.a) diff --git a/kore/test/Test/Kore/Unification/Unifier.hs b/kore/test/Test/Kore/Unification/Unifier.hs index 5be09acbbf..b94243018a 100644 --- a/kore/test/Test/Kore/Unification/Unifier.hs +++ b/kore/test/Test/Kore/Unification/Unifier.hs @@ -815,7 +815,7 @@ simplifyPattern (UnificationTerm term) = do simplifiedPatterns <- Pattern.simplify expandedPattern case toList simplifiedPatterns of - [] -> return Pattern.bottom + [] -> return (Pattern.bottomOf Mock.testSort) (config : _) -> return config expandedPattern = Pattern.fromTermLike term From 40b98cd90739aab8054060e826475ecc55d823a8 Mon Sep 17 00:00:00 2001 From: github-actions Date: Tue, 20 Jul 2021 15:18:49 +0000 Subject: [PATCH 44/74] Format with fourmolu --- kore/app/exec/Main.hs | 2 +- kore/src/Prelude/Kore.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/kore/app/exec/Main.hs b/kore/app/exec/Main.hs index fef66f04ca..7a4734f720 100644 --- a/kore/app/exec/Main.hs +++ b/kore/app/exec/Main.hs @@ -106,10 +106,10 @@ import Kore.Reachability ( lensClaimPattern, ) import qualified Kore.Reachability.Claim as Claim +import Kore.Rewrite import Kore.Rewrite.ClaimPattern ( getClaimPatternSort, ) -import Kore.Rewrite import Kore.Rewrite.RewritingVariable import Kore.Rewrite.RulePattern ( mapRuleVariables, diff --git a/kore/src/Prelude/Kore.hs b/kore/src/Prelude/Kore.hs index cdb2ddee18..8d06371b64 100644 --- a/kore/src/Prelude/Kore.hs +++ b/kore/src/Prelude/Kore.hs @@ -206,4 +206,4 @@ minMaxBy cmp a b | otherwise = (b, a) foldFirst :: Foldable f => f a -> Maybe a -foldFirst = foldr (\x _ -> pure x) Nothing \ No newline at end of file +foldFirst = foldr (\x _ -> pure x) Nothing From 3ce5bd11a92f4faf52f648fd088eb28e90f8bdbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 21 Jul 2021 16:00:42 +0300 Subject: [PATCH 45/74] Fix test --- kore/test/Test/Kore/Simplify/TermLike.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Simplify/TermLike.hs b/kore/test/Test/Kore/Simplify/TermLike.hs index cb34debba2..80a7f70e72 100644 --- a/kore/test/Test/Kore/Simplify/TermLike.hs +++ b/kore/test/Test/Kore/Simplify/TermLike.hs @@ -132,7 +132,7 @@ instance MonadSimplify TestSimplifier where test_simplifyOnly :: [TestTree] test_simplifyOnly = [ (test "LIST.List \\and simplification failure") - (mkAnd (Mock.concatList (mkTop Mock.topSort) (mkTop Mock.topSort)) (Mock.builtinList [])) + (mkAnd (Mock.concatList (mkTop Mock.listSort) (mkTop Mock.listSort)) (Mock.builtinList [])) expectUnsimplified , (test "Non-function symbol without evaluators") Mock.plain00Subsort From aac3660ae88f3972476976aecfeef18bf5df8d2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 21 Jul 2021 16:02:48 +0300 Subject: [PATCH 46/74] Use child sort in predicate forall simplifier --- kore/src/Kore/Simplify/Not.hs | 6 ++---- kore/src/Kore/Simplify/Predicate.hs | 18 ++++++++++++------ 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/kore/src/Kore/Simplify/Not.hs b/kore/src/Kore/Simplify/Not.hs index bbd06c12f6..d7e167aa2b 100644 --- a/kore/src/Kore/Simplify/Not.hs +++ b/kore/src/Kore/Simplify/Not.hs @@ -78,16 +78,14 @@ Right now this uses the following: -} simplify :: MonadSimplify simplifier => - Ord sort => SideCondition RewritingVariableName -> - --TODO (Andrei B): Sort vs sort - Not sort (OrPattern RewritingVariableName) -> + Not Sort (OrPattern RewritingVariableName) -> simplifier (OrPattern RewritingVariableName) simplify sideCondition not'@Not{notSort} = OrPattern.observeAllT $ do let evaluated = MultiAnd.map makeEvaluateNot (distributeNot not') andPattern <- scatterAnd evaluated - mkMultiAndPattern (mkSortVariable "BadSort") sideCondition andPattern + mkMultiAndPattern notSort sideCondition andPattern simplifyEvaluatedPredicate :: MonadSimplify simplifier => diff --git a/kore/src/Kore/Simplify/Predicate.hs b/kore/src/Kore/Simplify/Predicate.hs index 3e748aa029..2133f270ca 100644 --- a/kore/src/Kore/Simplify/Predicate.hs +++ b/kore/src/Kore/Simplify/Predicate.hs @@ -47,7 +47,12 @@ import Kore.Internal.Substitution ( pattern UnorderedAssignment, ) import qualified Kore.Internal.Substitution as Substitution -import Kore.Internal.TermLike (Sort, TermLike, mkSortVariable) +import Kore.Internal.TermLike ( + Sort, + TermLike, + mkSortVariable, + termLikeSort, + ) import qualified Kore.Internal.TermLike as TermLike import Kore.Log.WarnUnsimplifiedPredicate ( warnUnsimplifiedPredicate, @@ -172,8 +177,9 @@ simplify sideCondition original = IffF iffF -> simplifyIff =<< traverse worker iffF CeilF ceilF -> simplifyCeil sideCondition =<< traverse simplifyTerm ceilF - FloorF floorF -> - simplifyFloor sideCondition =<< traverse simplifyTerm floorF + FloorF floorF@(Floor _ _ child) -> + simplifyFloor (termLikeSort child) sideCondition + =<< traverse simplifyTerm floorF ExistsF existsF -> traverse worker (Exists.refreshExists avoid existsF) >>= simplifyExists sideCondition @@ -416,11 +422,11 @@ simplifyCeil sideCondition = -} simplifyFloor :: MonadSimplify simplifier => - Ord sort => + Sort -> SideCondition RewritingVariableName -> Floor sort (OrPattern RewritingVariableName) -> simplifier NormalForm -simplifyFloor sideCondition floor' = do +simplifyFloor termSort sideCondition floor' = do notTerm <- mkNotSimplifiedTerm floorChild ceilNotTerm <- mkCeilSimplified notTerm mkNotSimplified ceilNotTerm @@ -429,7 +435,7 @@ simplifyFloor sideCondition floor' = do mkNotSimplified notChild = simplifyNot Not{notSort = floorResultSort, notChild} mkNotSimplifiedTerm notChild = - Not.simplify sideCondition Not{notSort = floorResultSort, notChild} + Not.simplify sideCondition Not{notSort = termSort, notChild} mkCeilSimplified ceilChild = simplifyCeil sideCondition From e11caaf7d4f2ad559df753e6763cc9b1bf9b4087 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 21 Jul 2021 16:13:33 +0300 Subject: [PATCH 47/74] Apply suggestions given by pedantic --- kore/src/Kore/Simplify/Ceil.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/kore/src/Kore/Simplify/Ceil.hs b/kore/src/Kore/Simplify/Ceil.hs index 744947d3b6..92f2a4de83 100644 --- a/kore/src/Kore/Simplify/Ceil.hs +++ b/kore/src/Kore/Simplify/Ceil.hs @@ -69,7 +69,6 @@ import qualified Kore.Simplify.AndPredicates as And import Kore.Simplify.CeilSimplifier import Kore.Simplify.InjSimplifier import Kore.Simplify.Simplify as Simplifier -import qualified Kore.Sort as Sort import Kore.TopBottom import Kore.Unparser ( unparseToString, From e99d9a39b7c3053aa0dcb0ef6b92d7d38771cdc3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 21 Jul 2021 16:21:57 +0300 Subject: [PATCH 48/74] Apply hlint --- kore/src/Kore/Rewrite/Implication.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/src/Kore/Rewrite/Implication.hs b/kore/src/Kore/Rewrite/Implication.hs index 059d320fa0..3f4587057a 100644 --- a/kore/src/Kore/Rewrite/Implication.hs +++ b/kore/src/Kore/Rewrite/Implication.hs @@ -127,7 +127,7 @@ instance Pretty (Implication modality) where , "existentials:" , Pretty.indent 4 (Pretty.list $ unparse <$> existentials) , "right:" - , Pretty.indent 4 (unparse $ rightTerm) + , Pretty.indent 4 (unparse rightTerm) ] where Implication From 6ea4244ef46b6e057408e8bef45c393c929c054a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Thu, 22 Jul 2021 17:29:45 +0300 Subject: [PATCH 49/74] Fix one more test --- kore/test/Test/Kore/Attribute/Pattern/ConstructorLike.hs | 2 +- kore/test/Test/Kore/Rewrite/MockSymbols.hs | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/kore/test/Test/Kore/Attribute/Pattern/ConstructorLike.hs b/kore/test/Test/Kore/Attribute/Pattern/ConstructorLike.hs index 9d0de195fc..7328b99e46 100644 --- a/kore/test/Test/Kore/Attribute/Pattern/ConstructorLike.hs +++ b/kore/test/Test/Kore/Attribute/Pattern/ConstructorLike.hs @@ -33,7 +33,7 @@ test_TermLike = , testCase "Single constructor is constructor-like" $ Mock.a `shouldBeConstructorLike` True , testCase "Constructor-like with constructor at the top" $ - Mock.constr10 (Mock.builtinInt 3) `shouldBeConstructorLike` True + Mock.constrInt (Mock.builtinInt 3) `shouldBeConstructorLike` True , testCase "Simplifiable pattern contains symbol which is only functional" $ Mock.constr10 (Mock.f Mock.a) `shouldBeConstructorLike` False , testCase "Constructor-like pattern with constructor and sort injection" $ diff --git a/kore/test/Test/Kore/Rewrite/MockSymbols.hs b/kore/test/Test/Kore/Rewrite/MockSymbols.hs index 422833fd27..370512f12a 100644 --- a/kore/test/Test/Kore/Rewrite/MockSymbols.hs +++ b/kore/test/Test/Kore/Rewrite/MockSymbols.hs @@ -444,6 +444,9 @@ constr11Symbol = symbol constr11Id [testSort] testSort & constructor constr20Symbol :: Symbol constr20Symbol = symbol constr20Id [testSort, testSort] testSort & constructor +constrIntSymbol :: Symbol +constrIntSymbol = symbol constr10Id [intSort] intSort & constructor + constrFunct20TestMapSymbol :: Symbol constrFunct20TestMapSymbol = symbol constrFunct20TestMapId [testSort, mapSort] testSort @@ -1183,13 +1186,15 @@ constr00 :: InternalVariable variable => HasCallStack => TermLike variable constr00 = Internal.mkApplySymbol constr00Symbol [] constr10 - , constr11 :: + , constr11 + , constrInt :: InternalVariable variable => HasCallStack => TermLike variable -> TermLike variable constr10 arg = Internal.mkApplySymbol constr10Symbol [arg] constr11 arg = Internal.mkApplySymbol constr11Symbol [arg] +constrInt arg = Internal.mkApplySymbol constrIntSymbol [arg] constr20 :: InternalVariable variable => From 7a5bb52d98c3bedc4769518c40127227cc678e0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 2 Aug 2021 13:17:11 +0300 Subject: [PATCH 50/74] Use bool's sort in unifyIntEq and unifyStringEq --- kore/src/Kore/Builtin/Int.hs | 3 ++- kore/src/Kore/Builtin/String.hs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/kore/src/Kore/Builtin/Int.hs b/kore/src/Kore/Builtin/Int.hs index 61e5b82f45..b1f9412193 100644 --- a/kore/src/Kore/Builtin/Int.hs +++ b/kore/src/Kore/Builtin/Int.hs @@ -528,7 +528,8 @@ unifyIntEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyIntEq{eqTerm, internalBool} = unifyData EqTerm{symbol, operand1, operand2} = eqTerm - eraseTerm = fmap (mkTop . termLikeSort) + eraseTerm conditional = + conditional $> (mkTop (internalBoolSort internalBool)) notSort = applicationSortsResult . symbolSorts $ symbol mkNotSimplified notChild = notSimplifier SideCondition.top Not{notSort, notChild} diff --git a/kore/src/Kore/Builtin/String.hs b/kore/src/Kore/Builtin/String.hs index d6287459a8..d9f5008709 100644 --- a/kore/src/Kore/Builtin/String.hs +++ b/kore/src/Kore/Builtin/String.hs @@ -570,7 +570,8 @@ unifyStringEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyStringEq{eqTerm, internalBool} = unifyData EqTerm{symbol, operand1, operand2} = eqTerm - eraseTerm = fmap (mkTop . termLikeSort) + eraseTerm conditional = + conditional $> (mkTop (internalBoolSort internalBool)) notSort = applicationSortsResult . symbolSorts $ symbol mkNotSimplified notChild = notSimplifier SideCondition.top Not{notSort, notChild} From bd842f43f111d2bf66674ff2a9f7d784d6bbea46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 2 Aug 2021 17:50:12 +0300 Subject: [PATCH 51/74] Fix tests broken because incorrect merge with master --- kore/test/Test/Kore/Simplify/AndTerms.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/Simplify/AndTerms.hs b/kore/test/Test/Kore/Simplify/AndTerms.hs index 69e19d612b..39d92aa822 100644 --- a/kore/test/Test/Kore/Simplify/AndTerms.hs +++ b/kore/test/Test/Kore/Simplify/AndTerms.hs @@ -88,11 +88,17 @@ test_andTermsSimplification = actual <- simplifyUnify (mkTop Mock.testSort) fOfA assertEqual "" ([expected], [expected]) actual , testCase "\\and{s}(f{}(a), \\bottom{s}())" $ do - let expect = ([], []) + let expect = + ( [Pattern.bottomOf Mock.testSort] + , [Pattern.bottomOf Mock.testSort] + ) actual <- simplifyUnify fOfA (mkBottom Mock.testSort) assertEqual "" expect actual , testCase "\\and{s}(\\bottom{s}(), f{}(a))" $ do - let expect = ([], []) + let expect = + ( [Pattern.bottomOf Mock.testSort] + , [Pattern.bottomOf Mock.testSort] + ) actual <- simplifyUnify (mkBottom Mock.testSort) fOfA assertEqual "" expect actual ] @@ -927,7 +933,7 @@ test_andTermsSimplification = , testCase "different lengths" $ do let term7 = Mock.builtinList [Mock.a, Mock.a] term8 = Mock.builtinList [Mock.a] - expect = [] + expect = [Pattern.bottomOf Mock.listSort] actual <- unify term7 term8 assertEqual "" expect actual , testCase "fallback for external List symbols" $ do From 1b2a36fc9fc095cc6297cd93e95d64daf8e2594f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 4 Aug 2021 17:31:00 +0300 Subject: [PATCH 52/74] Use bool's sort in unifyKequalsEq's eraseTerm --- kore/src/Kore/Builtin/KEqual.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/kore/src/Kore/Builtin/KEqual.hs b/kore/src/Kore/Builtin/KEqual.hs index baf5c8af35..b0209f9d88 100644 --- a/kore/src/Kore/Builtin/KEqual.hs +++ b/kore/src/Kore/Builtin/KEqual.hs @@ -281,7 +281,8 @@ unifyKequalsEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyKequalsEq{eqTerm, internalBool} = unifyData EqTerm{symbol, operand1, operand2} = eqTerm - eraseTerm = fmap (mkTop . termLikeSort) + eraseTerm conditional = + conditional $> (mkTop (internalBoolSort internalBool)) sort = applicationSortsResult . symbolSorts $ symbol mkNotSimplified notChild = notSimplifier SideCondition.top Not{notSort = sort, notChild} From b98aa8b4db430ae7da9eab48640e1cd2586d2cff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Thu, 5 Aug 2021 13:23:17 +0300 Subject: [PATCH 53/74] Use initialSort instead of "R" dummy sort for exec's result --- kore/src/Kore/Exec.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/kore/src/Kore/Exec.hs b/kore/src/Kore/Exec.hs index 048ab9e6d2..4396d6e162 100644 --- a/kore/src/Kore/Exec.hs +++ b/kore/src/Kore/Exec.hs @@ -267,12 +267,8 @@ exec exitCode <- getExitCode verifiedModule finalConfigs' let finalTerm = MultiOr.map getRewritingPattern finalConfigs' - & OrPattern.toTermLike dummySort + & OrPattern.toTermLike initialSort & sameTermLikeSort initialSort - where - -- Dummy sort used to unparse configurations. - -- This is only used for unparsing \bottom. - dummySort = SortVariableSort (SortVariable "R") return (exitCode, finalTerm) where dropStrategy = snd From 437fcb2540189051cf422f198fdcb2e5f933341c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Tue, 10 Aug 2021 13:06:34 +0300 Subject: [PATCH 54/74] Fix the left unit tests --- kore/src/Kore/Simplify/Equals.hs | 3 +-- kore/test/Test/Kore/Builtin/Map.hs | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/kore/src/Kore/Simplify/Equals.hs b/kore/src/Kore/Simplify/Equals.hs index 2546f341ed..379a85b7f2 100644 --- a/kore/src/Kore/Simplify/Equals.hs +++ b/kore/src/Kore/Simplify/Equals.hs @@ -167,8 +167,7 @@ simplify { equalsFirst = first , equalsSecond = second , equalsOperandSort = sort - , equalsResultSort = resultSort - } = simplifyEvaluated resultSort sideCondition first' second' + } = simplifyEvaluated sort sideCondition first' second' where (first', second') = minMaxBy (on compareForEquals (OrPattern.toTermLike sort)) first second diff --git a/kore/test/Test/Kore/Builtin/Map.hs b/kore/test/Test/Kore/Builtin/Map.hs index 05e399a55e..2b1e48ed33 100644 --- a/kore/test/Test/Kore/Builtin/Map.hs +++ b/kore/test/Test/Kore/Builtin/Map.hs @@ -374,7 +374,7 @@ test_concatDuplicateKeys = let patMap1 = elementMap patKey patVal1 patMap2 = elementMap patKey patVal2 patConcat = concatMap patMap1 patMap2 - predicate = mkEquals_ (mkBottom listSort) patConcat + predicate = mkEquals_ (mkBottom mapSort) patConcat (===) OrPattern.bottom =<< evaluateT patConcat evaluateExpectTopK predicate ) From 78ad73b9ef00bf199112d5f4a02e06840e9faa4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 11:12:19 +0300 Subject: [PATCH 55/74] Do some cleanup --- kore/src/Kore/Builtin/Builtin.hs | 5 +---- kore/src/Kore/Builtin/EqTerm.hs | 28 ---------------------------- kore/src/Kore/Builtin/Int.hs | 2 -- kore/src/Kore/Builtin/KEqual.hs | 1 - kore/src/Kore/Internal/Predicate.hs | 2 +- 5 files changed, 2 insertions(+), 36 deletions(-) diff --git a/kore/src/Kore/Builtin/Builtin.hs b/kore/src/Kore/Builtin/Builtin.hs index 440586cf05..f982adea50 100644 --- a/kore/src/Kore/Builtin/Builtin.hs +++ b/kore/src/Kore/Builtin/Builtin.hs @@ -445,10 +445,7 @@ isSymbol builtinName Symbol{symbolAttributes = Attribute.Symbol{hook}} = {- | Is the given sort hooked to the named builtin? -TO DO (callan): fix documentation here - -Returns Nothing if the sort is unknown (i.e. the _PREDICATE sort). -Returns Just False if the sort is a variable. +Returns Nothing if the sort is a variable. -} isSort :: Text -> SmtMetadataTools attr -> Sort -> Maybe Bool isSort builtinName tools sort diff --git a/kore/src/Kore/Builtin/EqTerm.hs b/kore/src/Kore/Builtin/EqTerm.hs index 621873a2e0..1a97dee70b 100644 --- a/kore/src/Kore/Builtin/EqTerm.hs +++ b/kore/src/Kore/Builtin/EqTerm.hs @@ -5,7 +5,6 @@ License : BSD-3-Clause module Kore.Builtin.EqTerm ( EqTerm (..), matchEqTerm, - -- unifyEqTerm, ) where import qualified Control.Monad as Monad @@ -30,30 +29,3 @@ matchEqTerm selectSymbol (App_ symbol [operand1, operand2]) = do Monad.guard (selectSymbol symbol) return EqTerm{symbol, operand1, operand2} matchEqTerm _ _ = Nothing - -{- | Unification for an equality-like symbol. - -This function is suitable only for equality simplification. --} - --- unifyEqTerm :: --- forall unifier. --- MonadUnify unifier => --- TermSimplifier RewritingVariableName unifier -> --- NotSimplifier unifier -> --- EqTerm (TermLike RewritingVariableName) -> --- Bool -> --- unifier (Pattern RewritingVariableName) --- unifyEqTerm unifyChildren (NotSimplifier notSimplifier) eqTerm value = --- do --- solution <- unifyChildren operand1 operand2 & OrPattern.gather --- let solution' = MultiOr.map eraseTerm solution --- if value --- then Unify.scatter solution' --- else mkNotSimplified solution' >>= Unify.scatter --- where --- sort = TermLike.termLikeSort termLike2 --- EqTerm{operand1, operand2} = eqTerm --- eraseTerm = Pattern.fromCondition sort . Pattern.withoutTerm --- mkNotSimplified notChild = --- notSimplifier SideCondition.top Not{notSort = sort, notChild} diff --git a/kore/src/Kore/Builtin/Int.hs b/kore/src/Kore/Builtin/Int.hs index fed8912ddf..72296558cd 100644 --- a/kore/src/Kore/Builtin/Int.hs +++ b/kore/src/Kore/Builtin/Int.hs @@ -511,8 +511,6 @@ matchUnifyIntEq first second This function is suitable only for equality simplification. -} - --- TODO (Andrei B): doublecheck unifyIntEq :: forall unifier. MonadUnify unifier => diff --git a/kore/src/Kore/Builtin/KEqual.hs b/kore/src/Kore/Builtin/KEqual.hs index 2aab191dbc..652a3f50b1 100644 --- a/kore/src/Kore/Builtin/KEqual.hs +++ b/kore/src/Kore/Builtin/KEqual.hs @@ -262,7 +262,6 @@ matchUnifyKequalsEq first second | otherwise = Nothing {-# INLINE matchUnifyKequalsEq #-} --- TODO (Andrei B): doublecheck unifyKequalsEq :: forall unifier. MonadUnify unifier => diff --git a/kore/src/Kore/Internal/Predicate.hs b/kore/src/Kore/Internal/Predicate.hs index 7718a81db7..bec6285c06 100644 --- a/kore/src/Kore/Internal/Predicate.hs +++ b/kore/src/Kore/Internal/Predicate.hs @@ -1213,7 +1213,7 @@ mapVariables :: mapVariables adj predicate = let termPredicate = TermLike.mapVariables adj - . fromPredicate (mkSortVariable "BadSort") + . fromPredicate (mkSortVariable "_") $ predicate in either errorMappingVariables From 82e679c66493447b15c65f2931523a380a91fa1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 12:15:26 +0300 Subject: [PATCH 56/74] Validate.hs Cleanup: Use types to suggest that the sort variable "_" is used only for pretty printing --- kore/src/Kore/Equation/Validate.hs | 45 ++++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 11 deletions(-) diff --git a/kore/src/Kore/Equation/Validate.hs b/kore/src/Kore/Equation/Validate.hs index eb9eed3ea2..6a8fe72376 100644 --- a/kore/src/Kore/Equation/Validate.hs +++ b/kore/src/Kore/Equation/Validate.hs @@ -13,6 +13,7 @@ import qualified Data.Functor.Foldable as Recursive import Data.Text ( pack, ) +import Kore.AST.AstWithLocation import Kore.AST.Error import Kore.Attribute.Axiom ( Assoc (..), @@ -36,12 +37,16 @@ import Kore.Equation.Sentence ( fromSentenceAxiom, ) import Kore.Internal.Predicate ( + Predicate, pattern PredicateCeil, pattern PredicateIn, ) import qualified Kore.Internal.Predicate as Predicate import qualified Kore.Internal.Symbol as Symbol import Kore.Internal.TermLike ( + AstLocation, + InternalVariable, + TermLike, mkSortVariable, ) import qualified Kore.Internal.TermLike as TermLike @@ -53,6 +58,7 @@ import Kore.Unparser ( import Kore.Validate.Verifier import qualified Kore.Verified as Verified import Prelude.Kore +import Pretty (Doc) import qualified Pretty validateAxiom :: @@ -124,25 +130,42 @@ validateAxiom attrs verified = failOnJust eq "Expected variable, but found:" - $ asum $ getNotVar <$> termLikeF + (fmap unparseWithLocation $ asum $ getNotVar <$> termLikeF) getNotVar (TermLike.Var_ _) = Nothing getNotVar term = Just term + unparseWithLocation :: + AstWithLocation variable => + InternalVariable variable => + TermLike variable -> + (Doc ann, AstLocation) + unparseWithLocation t = (unparse t, locationFromAst t) + checkArg _ Nothing = return () checkArg eq (Just arg) = traverse_ ( failOnJust eq "Found invalid subterm in argument of function equation:" - . checkArgIn + . checkArgInAndUnparse ) $ Predicate.getMultiAndPredicate arg where - checkArgIn (PredicateIn (TermLike.Var_ _) term) = - findBadArgSubterm term - checkArgIn (PredicateCeil (TermLike.And_ _ (TermLike.Var_ _) term)) = - findBadArgSubterm term - checkArgIn badArg = - Just $ Predicate.fromPredicate (mkSortVariable "_") badArg --pretty + checkArgInAndUnparse :: + AstWithLocation variable => + InternalVariable variable => + Predicate variable -> + Maybe (Doc ann, AstLocation) + checkArgInAndUnparse predicate = + checkArgIn predicate <&> unparseWithLocation + where + checkArgIn (PredicateIn (TermLike.Var_ _) term) = + findBadArgSubterm term + checkArgIn (PredicateCeil (TermLike.And_ _ (TermLike.Var_ _) term)) = + findBadArgSubterm term + checkArgIn badArg = + -- use dummy sort variable for pretty printing inside failOnJust + -- the term's AstLocation will be AstLocationNone + Just $ Predicate.fromPredicate (mkSortVariable "_") badArg findBadArgSubterm term = case term of _ | TermLike.isConstructorLike term -> descend @@ -178,14 +201,14 @@ validateAxiom attrs verified = descend = asum $ findBadArgSubterm <$> termF failOnJust _ _ Nothing = return () - failOnJust eq errorMessage (Just term) = + failOnJust eq errorMessage (Just (term, location)) = koreFailWithLocations - [term] + [location] ( pack $ show $ Pretty.vsep [ errorMessage - , Pretty.indent 4 $ unparse term + , Pretty.indent 4 term , "The equation that the above occurs in is:" , Pretty.indent 4 $ Pretty.pretty eq ] From 56e25454e64ad0f89a07363ffe6f1130a4252e92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 12:23:00 +0300 Subject: [PATCH 57/74] Add TODO for implementing Predicate.mapVariables without converting to TermLike --- kore/src/Kore/Internal/Predicate.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/kore/src/Kore/Internal/Predicate.hs b/kore/src/Kore/Internal/Predicate.hs index bec6285c06..2be358a2fa 100644 --- a/kore/src/Kore/Internal/Predicate.hs +++ b/kore/src/Kore/Internal/Predicate.hs @@ -1213,6 +1213,7 @@ mapVariables :: mapVariables adj predicate = let termPredicate = TermLike.mapVariables adj + -- TODO (Andrei B): Try to avoid TermLike conversion . fromPredicate (mkSortVariable "_") $ predicate in either From d8fded7006098560656e508de60ad6d7e07f8621 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 12:49:16 +0300 Subject: [PATCH 58/74] Rename OrPattern.top to OrPattern.topOf and fix documentation --- kore/src/Kore/Internal/OrPattern.hs | 12 +++++------- kore/src/Kore/Simplify/Floor.hs | 2 +- kore/src/Kore/Simplify/Implies.hs | 4 ++-- kore/src/Kore/Simplify/Top.hs | 2 +- kore/test/Test/Kore/Builtin/Builtin.hs | 2 +- kore/test/Test/Kore/Builtin/Int.hs | 4 ++-- kore/test/Test/Kore/Builtin/KEqual.hs | 6 +++--- kore/test/Test/Kore/Builtin/Map.hs | 4 ++-- kore/test/Test/Kore/Simplify/And.hs | 2 +- kore/test/Test/Kore/Simplify/Forall.hs | 2 +- kore/test/Test/Kore/Simplify/Integration.hs | 8 ++++---- kore/test/Test/Kore/Simplify/OrPattern.hs | 6 +++--- 12 files changed, 26 insertions(+), 28 deletions(-) diff --git a/kore/src/Kore/Internal/OrPattern.hs b/kore/src/Kore/Internal/OrPattern.hs index 5d53e79398..b8bccfa564 100644 --- a/kore/src/Kore/Internal/OrPattern.hs +++ b/kore/src/Kore/Internal/OrPattern.hs @@ -18,7 +18,7 @@ module Kore.Internal.OrPattern ( isFalse, isPredicate, tryGetSort, - top, + topOf, isTrue, toPattern, toTermLike, @@ -148,7 +148,7 @@ fromTermLike = fromPattern . Pattern.fromTermLike {- | @\\bottom@ @ -'isFalse' bottom == True +isFalse bottom == True @ -} bottom :: InternalVariable variable => OrPattern variable @@ -161,13 +161,11 @@ isFalse = isBottom {- | @\\top@ @ -'isTrue' top == True - -To do (Callan): should this be renamed `topOf` as elsewhere? +isTrue (topOf _) == True @ -} -top :: InternalVariable variable => Sort -> OrPattern variable -top sort = fromPattern (Pattern.topOf sort) +topOf :: InternalVariable variable => Sort -> OrPattern variable +topOf sort = fromPattern (Pattern.topOf sort) -- | 'isTrue' checks if the 'Or' has a single top pattern. isTrue :: OrPattern variable -> Bool diff --git a/kore/src/Kore/Simplify/Floor.hs b/kore/src/Kore/Simplify/Floor.hs index e75c31a73e..c867dc20a0 100644 --- a/kore/src/Kore/Simplify/Floor.hs +++ b/kore/src/Kore/Simplify/Floor.hs @@ -78,7 +78,7 @@ makeEvaluateFloor :: Pattern RewritingVariableName -> OrPattern RewritingVariableName makeEvaluateFloor resultSort child - | Pattern.isTop child = OrPattern.top resultSort + | Pattern.isTop child = OrPattern.topOf resultSort | Pattern.isBottom child = OrPattern.bottom | otherwise = makeEvaluateNonBoolFloor resultSort child diff --git a/kore/src/Kore/Simplify/Implies.hs b/kore/src/Kore/Simplify/Implies.hs index c5727fc80a..a2ffeff24c 100644 --- a/kore/src/Kore/Simplify/Implies.hs +++ b/kore/src/Kore/Simplify/Implies.hs @@ -91,8 +91,8 @@ simplifyEvaluated :: simplifier (OrPattern RewritingVariableName) simplifyEvaluated sort sideCondition first second | OrPattern.isTrue first = return second - | OrPattern.isFalse first = return (OrPattern.top sort) - | OrPattern.isTrue second = return (OrPattern.top sort) + | OrPattern.isFalse first = return (OrPattern.topOf sort) + | OrPattern.isTrue second = return (OrPattern.topOf sort) | OrPattern.isFalse second = Not.simplify sideCondition Not{notSort = sort, notChild = first} | otherwise = diff --git a/kore/src/Kore/Simplify/Top.hs b/kore/src/Kore/Simplify/Top.hs index 268a660888..cfdc7d00a8 100644 --- a/kore/src/Kore/Simplify/Top.hs +++ b/kore/src/Kore/Simplify/Top.hs @@ -29,4 +29,4 @@ simplify :: Sort -> Top Sort child -> OrPattern RewritingVariableName -simplify sort _ = OrPattern.top sort +simplify sort _ = OrPattern.topOf sort diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index d4ca9e9d31..6f5f3f728f 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -263,7 +263,7 @@ evaluateExpectTopK :: Hedgehog.PropertyT smt () evaluateExpectTopK termLike = do actual <- evaluateT termLike - OrPattern.top kSort Hedgehog.=== actual + OrPattern.topOf kSort Hedgehog.=== actual evaluateToList :: TermLike RewritingVariableName -> diff --git a/kore/test/Test/Kore/Builtin/Int.hs b/kore/test/Test/Kore/Builtin/Int.hs index 13b598059a..d6c4f3df5e 100644 --- a/kore/test/Test/Kore/Builtin/Int.hs +++ b/kore/test/Test/Kore/Builtin/Int.hs @@ -497,7 +497,7 @@ test_unifyEqual_Equal = testCaseWithoutSMT "unifyEqual BuiltinInteger: Equal" $ do let dv1 = asInternal 2 actual <- evaluate $ mkEquals kSort dv1 dv1 - assertEqual' "" (OrPattern.top kSort) actual + assertEqual' "" (OrPattern.topOf kSort) actual -- | "\and"ed internal Integers that are not equal test_unifyAnd_NotEqual :: TestTree @@ -522,7 +522,7 @@ test_unifyAndEqual_Equal = testCaseWithoutSMT "unifyAnd BuiltinInteger: Equal" $ do let dv = asInternal 0 actual <- evaluate $ mkEquals kSort dv $ mkAnd dv dv - assertEqual' "" (OrPattern.top kSort) actual + assertEqual' "" (OrPattern.topOf kSort) actual -- | Internal Integer "\and"ed with builtin function applied to variable test_unifyAnd_Fn :: TestTree diff --git a/kore/test/Test/Kore/Builtin/KEqual.hs b/kore/test/Test/Kore/Builtin/KEqual.hs index e7d6e28ff2..34b6c8ecba 100644 --- a/kore/test/Test/Kore/Builtin/KEqual.hs +++ b/kore/test/Test/Kore/Builtin/KEqual.hs @@ -83,7 +83,7 @@ test_KEqual = actual <- evaluate original assertEqual' "" expect actual , testCaseWithoutSMT "kseq(x, dotk) equals kseq(x, dotk)" $ do - let expect = OrPattern.top kSort + let expect = OrPattern.topOf kSort xConfigElemVarKItemSort = configElementVariableFromId "x" kItemSort original = @@ -97,7 +97,7 @@ test_KEqual = actual <- evaluate original assertEqual' "" expect actual , testCaseWithoutSMT "kseq(inj(x), dotk) equals kseq(inj(x), dotk)" $ do - let expect = OrPattern.top kSort + let expect = OrPattern.topOf kSort xConfigElemVarIdSort = configElementVariableFromId "x" idSort original = @@ -111,7 +111,7 @@ test_KEqual = actual <- evaluate original assertEqual' "" expect actual , testCaseWithoutSMT "distinct constructor-like terms" $ do - let expect = OrPattern.top kSort + let expect = OrPattern.topOf kSort original = mkEquals kSort diff --git a/kore/test/Test/Kore/Builtin/Map.hs b/kore/test/Test/Kore/Builtin/Map.hs index 2b1e48ed33..ac45bd8dd6 100644 --- a/kore/test/Test/Kore/Builtin/Map.hs +++ b/kore/test/Test/Kore/Builtin/Map.hs @@ -438,7 +438,7 @@ test_keysUnit = predicate = mkEquals_ patExpect patKeys expect <- evaluate patExpect assertEqual "" expect =<< evaluate patKeys - assertEqual "" (OrPattern.top kSort) =<< evaluate predicate + assertEqual "" (OrPattern.topOf kSort) =<< evaluate predicate test_keysElement :: TestTree test_keysElement = @@ -483,7 +483,7 @@ test_keysListUnit = predicate = mkEquals_ patExpect patKeys expect <- evaluate patExpect assertEqual "" expect =<< evaluate patKeys - assertEqual "" (OrPattern.top kSort) =<< evaluate predicate + assertEqual "" (OrPattern.topOf kSort) =<< evaluate predicate test_keysListElement :: TestTree test_keysListElement = diff --git a/kore/test/Test/Kore/Simplify/And.hs b/kore/test/Test/Kore/Simplify/And.hs index 5f22ce0a36..54d5e1eb7f 100644 --- a/kore/test/Test/Kore/Simplify/And.hs +++ b/kore/test/Test/Kore/Simplify/And.hs @@ -53,7 +53,7 @@ test_andSimplification = =<< evaluate (makeAnd [Pattern.topOf Mock.testSort] []) assertEqual "true and true = true" - (OrPattern.top Mock.testSort) + (OrPattern.topOf Mock.testSort) =<< evaluate (makeAnd [Pattern.topOf Mock.testSort] [Pattern.topOf Mock.testSort]) , testCase "And with booleans" $ do assertEqual diff --git a/kore/test/Test/Kore/Simplify/Forall.hs b/kore/test/Test/Kore/Simplify/Forall.hs index 830f1b02ab..3aa41067a6 100644 --- a/kore/test/Test/Kore/Simplify/Forall.hs +++ b/kore/test/Test/Kore/Simplify/Forall.hs @@ -61,7 +61,7 @@ test_forallSimplification = -- forall(top) = top assertEqual "forall(top)" - (OrPattern.top Mock.topSort) + (OrPattern.topOf Mock.topSort) ( evaluate ( makeForall Mock.xConfig diff --git a/kore/test/Test/Kore/Simplify/Integration.hs b/kore/test/Test/Kore/Simplify/Integration.hs index 7739c1f9ce..de6805a5a9 100644 --- a/kore/test/Test/Kore/Simplify/Integration.hs +++ b/kore/test/Test/Kore/Simplify/Integration.hs @@ -311,7 +311,7 @@ test_simplificationIntegration = } assertEqual "" expect actual , testCase "exists variable equality" $ do - let expect = OrPattern.top Mock.testSort + let expect = OrPattern.topOf Mock.testSort actual <- evaluateWithAxioms Map.empty @@ -328,7 +328,7 @@ test_simplificationIntegration = } assertEqual "" expect actual , testCase "exists variable equality reverse" $ do - let expect = OrPattern.top Mock.testSort + let expect = OrPattern.topOf Mock.testSort actual <- evaluateWithAxioms Map.empty @@ -350,14 +350,14 @@ test_simplificationIntegration = Pattern.fromTermLike $ mkExists Mock.xConfig $ (mkEquals Mock.testSort) (mkElemVar Mock.xConfig) (mkElemVar Mock.yConfig) - assertEqual "" (OrPattern.top Mock.testSort) actual + assertEqual "" (OrPattern.topOf Mock.testSort) actual , testCase "exists variable equality reverse" $ do actual <- evaluateWithAxioms Map.empty $ Pattern.fromTermLike $ mkExists Mock.xConfig $ (mkEquals Mock.testSort) (mkElemVar Mock.yConfig) (mkElemVar Mock.xConfig) - assertEqual "" (OrPattern.top Mock.testSort) actual + assertEqual "" (OrPattern.topOf Mock.testSort) actual , testCase "simplification with top predicate (exists variable capture)" $ do let requirement = \var -> diff --git a/kore/test/Test/Kore/Simplify/OrPattern.hs b/kore/test/Test/Kore/Simplify/OrPattern.hs index af2e6cc328..2af60c3ccc 100644 --- a/kore/test/Test/Kore/Simplify/OrPattern.hs +++ b/kore/test/Test/Kore/Simplify/OrPattern.hs @@ -12,7 +12,7 @@ import Kore.Internal.OrPattern ( import qualified Kore.Internal.OrPattern as OrPattern ( bottom, fromPatterns, - top, + topOf, ) import Kore.Internal.Predicate ( Predicate, @@ -38,8 +38,8 @@ import Test.Tasty.HUnit.Ext test_orPatternSimplification :: [TestTree] test_orPatternSimplification = [ testCase "Identity for top" $ do - actual <- runSimplifyPredicates makeTruePredicate (OrPattern.top Mock.topSort) - assertEqual "" (OrPattern.top Mock.topSort) actual + actual <- runSimplifyPredicates makeTruePredicate (OrPattern.topOf Mock.topSort) + assertEqual "" (OrPattern.topOf Mock.topSort) actual , testCase "Identity for bottom" $ do actual <- runSimplifyPredicates makeTruePredicate OrPattern.bottom assertEqual "" OrPattern.bottom actual From e904c2a925ba9051297062a12bbcdccc3329342b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 13:54:04 +0300 Subject: [PATCH 59/74] Equals.makeEvaluate: don't replace second term --- kore/src/Kore/Simplify/Equals.hs | 6 +++--- kore/src/Kore/Simplify/Floor.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/kore/src/Kore/Simplify/Equals.hs b/kore/src/Kore/Simplify/Equals.hs index 379a85b7f2..5aa80f807f 100644 --- a/kore/src/Kore/Simplify/Equals.hs +++ b/kore/src/Kore/Simplify/Equals.hs @@ -269,12 +269,12 @@ makeEvaluate :: SideCondition RewritingVariableName -> simplifier (OrCondition RewritingVariableName) makeEvaluate - first@Conditional{term = Top_ sort} + first@Conditional{term = Top_ _} second@Conditional{term = Top_ _} _ = Iff.makeEvaluate - first{term = mkTop sort} -- remove the term's sort - second{term = mkTop sort} -- remove the term's sort + first + second & MultiOr.map Pattern.withoutTerm & return makeEvaluate diff --git a/kore/src/Kore/Simplify/Floor.hs b/kore/src/Kore/Simplify/Floor.hs index c867dc20a0..09e6969a8a 100644 --- a/kore/src/Kore/Simplify/Floor.hs +++ b/kore/src/Kore/Simplify/Floor.hs @@ -87,7 +87,7 @@ makeEvaluateNonBoolFloor :: Pattern RewritingVariableName -> OrPattern RewritingVariableName makeEvaluateNonBoolFloor resultSort patt@Conditional{term = Top_ _} = - OrPattern.fromPattern patt{term = mkTop resultSort} -- remove the term's sort + OrPattern.fromPattern patt{term = mkTop resultSort} -- change the term's sort -- TODO(virgil): Also evaluate functional patterns to bottom for non-singleton -- sorts, and maybe other cases also makeEvaluateNonBoolFloor resultSort patt = From 4014b1f68f0aff518d5a283a82fef19f727b586f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 14:24:18 +0300 Subject: [PATCH 60/74] Remove unused module and clean Forall.hs's export list --- kore/src/Kore/Simplify/Forall.hs | 2 - kore/src/Kore/Simplify/Rewrites.hs | 78 ------------------------------ 2 files changed, 80 deletions(-) delete mode 100644 kore/src/Kore/Simplify/Rewrites.hs diff --git a/kore/src/Kore/Simplify/Forall.hs b/kore/src/Kore/Simplify/Forall.hs index 5a4f362f15..2044cc9fdf 100644 --- a/kore/src/Kore/Simplify/Forall.hs +++ b/kore/src/Kore/Simplify/Forall.hs @@ -29,13 +29,11 @@ import Kore.Internal.Pattern ( Pattern, ) import qualified Kore.Internal.Pattern as Pattern ( - -- bottom, bottomOf, fromTermLike, isBottom, isTop, patternSort, - -- top, splitTerm, toTermLike, topOf, diff --git a/kore/src/Kore/Simplify/Rewrites.hs b/kore/src/Kore/Simplify/Rewrites.hs deleted file mode 100644 index c718b9c353..0000000000 --- a/kore/src/Kore/Simplify/Rewrites.hs +++ /dev/null @@ -1,78 +0,0 @@ -{- | -Module : Kore.Step.Simplification.Rewrites -Description : Tools for Rewrites pattern simplification. -Copyright : (c) Runtime Verification, 2018 -License : NCSA -Maintainer : virgil.serbanuta@runtimeverification.com -Stability : experimental -Portability : portable --} -module Kore.Step.Simplification.Rewrites ( - simplify, -) where - -import Kore.Internal.OrPattern ( - OrPattern, - ) -import qualified Kore.Internal.OrPattern as OrPattern -import Kore.Internal.Pattern as Pattern -import Kore.Internal.TermLike -import qualified Kore.Internal.TermLike as TermLike ( - markSimplified, - ) -import Kore.Rewriting.RewritingVariable ( - RewritingVariableName, - ) -import Prelude.Kore - -{- | Simplify a 'Rewrites' pattern with a 'OrPattern' child. - -Right now this does not do any actual simplification. - -TODO(virgil): Should I even bother to simplify Rewrites? Maybe to implies+next? --} -simplify :: - Sort -> - Rewrites Sort (OrPattern RewritingVariableName) -> - OrPattern RewritingVariableName -simplify - sort - Rewrites - { rewritesFirst = first - , rewritesSecond = second - } = - simplifyEvaluatedRewrites sort first second - -{- TODO (virgil): Preserve pattern sorts under simplification. - -One way to preserve the required sort annotations is to make -'simplifyEvaluatedRewrites' take an argument of type - -> CofreeF (Or Sort) (Attribute.Pattern variable) (OrPattern variable) - -instead of two 'OrPattern' arguments. The type of -'makeEvaluateRewrites' may be changed analogously. The 'Attribute.Pattern' -annotation will eventually cache information besides the pattern sort, which -will make it even more useful to carry around. - --} -simplifyEvaluatedRewrites :: - Sort -> - OrPattern RewritingVariableName -> - OrPattern RewritingVariableName -> - OrPattern RewritingVariableName -simplifyEvaluatedRewrites sort first second = - makeEvaluateRewrites - (OrPattern.toPattern sort first) - (OrPattern.toPattern sort second) - -makeEvaluateRewrites :: - Pattern RewritingVariableName -> - Pattern RewritingVariableName -> - OrPattern RewritingVariableName -makeEvaluateRewrites first second = - OrPattern.fromTermLike $ - TermLike.markSimplified $ - mkRewrites - (Pattern.toTermLike first) - (Pattern.toTermLike second) From 084ebe8d3f767f9421f513b8b69914f6df664f19 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 14:30:28 +0300 Subject: [PATCH 61/74] Remove redundant parentheses --- kore/test/Test/Kore/Simplify/Iff.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/test/Test/Kore/Simplify/Iff.hs b/kore/test/Test/Kore/Simplify/Iff.hs index fb051d67e0..a360da64de 100644 --- a/kore/test/Test/Kore/Simplify/Iff.hs +++ b/kore/test/Test/Kore/Simplify/Iff.hs @@ -74,7 +74,7 @@ test_makeEvaluate = "iff(topOf Mock.testSort and predicate, topOf Mock.testSort and predicate)" ( OrPattern.fromPatterns [ Conditional - { term = (mkTop Mock.testSort) + { term = mkTop Mock.testSort , predicate = makeIffPredicate ( makeAndPredicate @@ -97,7 +97,7 @@ test_makeEvaluate = ) ( makeEvaluate Conditional - { term = (mkTop Mock.testSort) + { term = mkTop Mock.testSort , predicate = makeCeilPredicate Mock.cf , substitution = Substitution.wrap $ @@ -105,7 +105,7 @@ test_makeEvaluate = [(inject Mock.xConfig, Mock.a)] } Conditional - { term = (mkTop Mock.testSort) + { term = mkTop Mock.testSort , predicate = makeCeilPredicate Mock.cg , substitution = Substitution.wrap $ From 4cc897364e892a532b38058794cafaf73ea5a841 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 14:31:21 +0300 Subject: [PATCH 62/74] Remove redundant do --- kore/test/Test/Kore/Simplify/IntegrationProperty.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs index 9c79cc8aca..a61ee64839 100644 --- a/kore/test/Test/Kore/Simplify/IntegrationProperty.hs +++ b/kore/test/Test/Kore/Simplify/IntegrationProperty.hs @@ -66,7 +66,7 @@ import Test.Tasty import Test.Tasty.HUnit.Ext test_simplifiesToSimplified :: TestTree -test_simplifiesToSimplified = do +test_simplifiesToSimplified = testPropertyWithoutSolver "simplify returns simplified pattern" $ do term <- forAll (runTermGen Mock.generatorSetup termLikeGen) let term' = mkRewritingTerm term From 0222742125c3fdde7f76f889bb831b73707b7af5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Wed, 11 Aug 2021 14:34:17 +0300 Subject: [PATCH 63/74] Use "_" sort variable instead of Mock.testSort for pretty printing --- kore/test/Test/Kore/Simplify/Or.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Simplify/Or.hs b/kore/test/Test/Kore/Simplify/Or.hs index b65f0bf6b7..aa2c849957 100644 --- a/kore/test/Test/Kore/Simplify/Or.hs +++ b/kore/test/Test/Kore/Simplify/Or.hs @@ -223,7 +223,7 @@ becomes ( stateIntention [ prettyOr or1 or2 , "to become:" - , Unparser.unparse $ OrPattern.toTermLike Mock.testSort expected + , Unparser.unparse $ OrPattern.toTermLike (mkSortVariable "_") expected ] ) From 394831b8965171b9afbbc6957c6f7eb3f0312341 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 16 Aug 2021 11:22:57 +0300 Subject: [PATCH 64/74] Address some comments --- kore/src/Kore/Builtin/AssociativeCommutative.hs | 6 +++++- kore/src/Kore/Internal/OrPattern.hs | 6 +++--- kore/src/Kore/Internal/Predicate.hs | 4 +--- kore/src/Kore/Internal/SideCondition.hs | 7 +++---- kore/src/Kore/Repl/Interpreter.hs | 2 +- kore/src/Kore/Rewrite/Implication.hs | 6 +----- kore/src/Kore/Rewrite/Rule.hs | 3 +-- kore/src/Kore/Simplify/AndTerms.hs | 16 ++++++++++++++-- kore/src/Kore/Simplify/InternalMap.hs | 13 ++++++------- kore/src/Kore/Simplify/TermLike.hs | 4 ++-- kore/test/Test/Kore/Simplify/InternalMap.hs | 3 +-- 11 files changed, 38 insertions(+), 32 deletions(-) diff --git a/kore/src/Kore/Builtin/AssociativeCommutative.hs b/kore/src/Kore/Builtin/AssociativeCommutative.hs index 7e9b4b0fa5..cd6502c6bf 100644 --- a/kore/src/Kore/Builtin/AssociativeCommutative.hs +++ b/kore/src/Kore/Builtin/AssociativeCommutative.hs @@ -115,6 +115,7 @@ import Kore.Rewrite.RewritingVariable ( import Kore.Simplify.Simplify as Simplifier import Kore.Sort ( Sort, + sameSort, ) import Kore.Syntax.Variable import Kore.Unification.Unify ( @@ -1400,7 +1401,10 @@ unifyEqualsElementLists let remainder2Terms = map fromConcreteOrWithVariable remainder2 - case elementListAsInternal tools (termLikeSort first) remainder2Terms of + case elementListAsInternal + tools + (sameSort (termLikeSort first) (termLikeSort first)) + remainder2Terms of Nothing -> debugUnifyBottomAndReturnBottom "Duplicated element in unification results" diff --git a/kore/src/Kore/Internal/OrPattern.hs b/kore/src/Kore/Internal/OrPattern.hs index b8bccfa564..74c5ba9c3b 100644 --- a/kore/src/Kore/Internal/OrPattern.hs +++ b/kore/src/Kore/Internal/OrPattern.hs @@ -17,7 +17,7 @@ module Kore.Internal.OrPattern ( bottom, isFalse, isPredicate, - tryGetSort, + getSortIfNotBottom, topOf, isTrue, toPattern, @@ -211,8 +211,8 @@ isPredicate :: OrPattern variable -> Bool isPredicate = all Pattern.isPredicate -- | Gets the `Sort` of a non-empty 'OrPattern' and othewise returns `Nothing`. -tryGetSort :: OrPattern variable -> Maybe Sort -tryGetSort multiOr = +getSortIfNotBottom :: OrPattern variable -> Maybe Sort +getSortIfNotBottom multiOr = case toList multiOr of [] -> Nothing p : _ -> Just (Pattern.patternSort p) diff --git a/kore/src/Kore/Internal/Predicate.hs b/kore/src/Kore/Internal/Predicate.hs index 2be358a2fa..ecc154e053 100644 --- a/kore/src/Kore/Internal/Predicate.hs +++ b/kore/src/Kore/Internal/Predicate.hs @@ -1087,10 +1087,8 @@ cannotSimplifyNotSimplifiedError predF = ( "Unexpectedly marking term with NotSimplified children as simplified:\n" ++ show predF ++ "\n" - ++ unparseToString term + ++ (show . pretty $ synthesize predF) ) - where - term = fromPredicate (mkSortVariable "_") (synthesize predF) simplifiedFromChildren :: HasCallStack => diff --git a/kore/src/Kore/Internal/SideCondition.hs b/kore/src/Kore/Internal/SideCondition.hs index 056f0eec41..2f1017327e 100644 --- a/kore/src/Kore/Internal/SideCondition.hs +++ b/kore/src/Kore/Internal/SideCondition.hs @@ -109,7 +109,6 @@ import Kore.Internal.TermLike ( Key, TermLike, pattern App_, - pattern Equals_, pattern Exists_, pattern Forall_, pattern Inj_, @@ -560,7 +559,7 @@ simplifyConjunctionByAssumption (toList -> andPredicates) = assumeEqualTerms = case predicate of PredicateEquals t1 t2 -> - case retractLocalFunction (TermLike.mkEquals (TermLike.termLikeSort t1) t1 t2) of + case retractLocalFunction (Predicate.makeEqualsPredicate t1 t2) of Just (Pair t1' t2') -> Lens.over (field @"termLikeMap") $ HashMap.insert t1' t2' @@ -665,11 +664,11 @@ in either order, but the function pattern is always returned first in the 'Pair'. -} retractLocalFunction :: - TermLike variable -> + Predicate variable -> Maybe (Pair (TermLike variable)) retractLocalFunction = \case - Equals_ _ _ term1 term2 -> go term1 term2 <|> go term2 term1 + PredicateEquals term1 term2 -> go term1 term2 <|> go term2 term1 _ -> Nothing where go term1@(App_ symbol1 _) term2 diff --git a/kore/src/Kore/Repl/Interpreter.hs b/kore/src/Kore/Repl/Interpreter.hs index ba9dc5634e..36c7bdaec4 100644 --- a/kore/src/Kore/Repl/Interpreter.hs +++ b/kore/src/Kore/Repl/Interpreter.hs @@ -1395,7 +1395,7 @@ prettyClaimStateComponent transformation omitList = , provenValue = makeAuxReplOutput "Proven." } where - -- Dummy sort used to unparse configurations. + -- Sort variable used to unparse configurations. -- This is only used for unparsing \bottom. dummySort = SortVariableSort (SortVariable "R") prettyComponent = diff --git a/kore/src/Kore/Rewrite/Implication.hs b/kore/src/Kore/Rewrite/Implication.hs index 3f4587057a..6a8edfa9ae 100644 --- a/kore/src/Kore/Rewrite/Implication.hs +++ b/kore/src/Kore/Rewrite/Implication.hs @@ -127,7 +127,7 @@ instance Pretty (Implication modality) where , "existentials:" , Pretty.indent 4 (Pretty.list $ unparse <$> existentials) , "right:" - , Pretty.indent 4 (unparse rightTerm) + , Pretty.indent 4 (pretty right) ] where Implication @@ -135,10 +135,6 @@ instance Pretty (Implication modality) where , right , existentials } = implication' - rightTerm = - case OrPattern.tryGetSort right of - Nothing -> error "to do" - Just s -> OrPattern.toTermLike s right instance TopBottom (Implication modality) where isTop _ = False diff --git a/kore/src/Kore/Rewrite/Rule.hs b/kore/src/Kore/Rewrite/Rule.hs index 963496276b..a555cac2ff 100644 --- a/kore/src/Kore/Rewrite/Rule.hs +++ b/kore/src/Kore/Rewrite/Rule.hs @@ -427,10 +427,9 @@ mkEqualityAxiom lhs rhs requires = Just requires' -> TermLike.mkImplies (requires' sortR) - (TermLike.mkAnd function (TermLike.mkTop sortLHS)) + (TermLike.mkAnd function (TermLike.mkTop sortR)) Nothing -> function where - sortLHS = TermLike.termLikeSort lhs sortVariableR = SortVariable "R" sortR = SortVariableSort sortVariableR function = TermLike.mkEquals sortR lhs rhs diff --git a/kore/src/Kore/Simplify/AndTerms.hs b/kore/src/Kore/Simplify/AndTerms.hs index afed16f7e9..d324e4ac82 100644 --- a/kore/src/Kore/Simplify/AndTerms.hs +++ b/kore/src/Kore/Simplify/AndTerms.hs @@ -79,6 +79,9 @@ import Kore.Simplify.NoConfusion import Kore.Simplify.NotSimplifier import Kore.Simplify.Overloading as Overloading import Kore.Simplify.Simplify as Simplifier +import Kore.Sort ( + sameSort, + ) import Kore.Unification.Unify as Unify import Kore.Unparser import Pair @@ -161,7 +164,11 @@ maybeTermEquals notSimplifier childTransformers first second = do | Just unifyData <- matchBytes first second = lift $ unifyBytes unifyData | Just unifyData <- matchBottomTermEquals first second = - lift $ bottomTermEquals (termLikeSort first) SideCondition.topTODO unifyData + lift $ + bottomTermEquals + (sameSort (termLikeSort first) (termLikeSort first)) + SideCondition.topTODO + unifyData | Just unifyData <- matchVariableFunctionEquals first second = lift $ variableFunctionEquals unifyData | Just unifyData <- matchEqualInjectiveHeadsAndEquals first second = @@ -193,7 +200,12 @@ maybeTermEquals notSimplifier childTransformers first second = do | Just unifyData <- Builtin.Map.matchUnifyEquals tools first second = lift $ Builtin.Map.unifyEquals childTransformers tools unifyData | Just unifyData <- Builtin.Map.matchUnifyNotInKeys first second = - lift $ Builtin.Map.unifyNotInKeys (termLikeSort first) childTransformers notSimplifier unifyData + lift $ + Builtin.Map.unifyNotInKeys + (sameSort (termLikeSort first) (termLikeSort first)) + childTransformers + notSimplifier + unifyData | Just unifyData <- Builtin.Set.matchUnifyEquals tools first second = lift $ Builtin.Set.unifyEquals childTransformers tools unifyData | Just unifyData <- Builtin.List.matchUnifyEqualsList tools first second = diff --git a/kore/src/Kore/Simplify/InternalMap.hs b/kore/src/Kore/Simplify/InternalMap.hs index 427e0211c1..0d71d243a9 100644 --- a/kore/src/Kore/Simplify/InternalMap.hs +++ b/kore/src/Kore/Simplify/InternalMap.hs @@ -25,15 +25,14 @@ import Prelude.Kore -- | Simplify an 'InternalMap' pattern. simplify :: - Sort -> InternalMap Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName -simplify sort = - traverse (Logic.scatter >>> Compose) - >>> fmap (normalizeInternalMap sort >>> markSimplified) - >>> getCompose - >>> fmap Pattern.syncSort - >>> MultiOr.observeAll +simplify internalMap = + traverse (Logic.scatter >>> Compose) internalMap + & fmap (normalizeInternalMap (builtinAcSort internalMap) >>> markSimplified) + & getCompose + & fmap Pattern.syncSort + & MultiOr.observeAll normalizeInternalMap :: Sort -> diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index c343a78006..a26c6aba88 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -415,7 +415,7 @@ simplify sideCondition = \termLike -> InternalListF internalF -> InternalList.simplify <$> simplifyChildren internalF InternalMapF internalMapF -> - (InternalMap.simplify termSort) <$> simplifyChildren internalMapF + InternalMap.simplify <$> simplifyChildren internalMapF InternalSetF internalSetF -> (InternalSet.simplify termSort) <$> simplifyChildren internalSetF DomainValueF domainValueF -> @@ -552,7 +552,7 @@ simplifyOnly sideCondition = InternalListF internalListF -> InternalList.simplify <$> traverse worker internalListF InternalMapF internalMapF -> - InternalMap.simplify sort <$> traverse worker internalMapF + InternalMap.simplify <$> traverse worker internalMapF InternalSetF internalSetF -> InternalSet.simplify sort <$> traverse worker internalSetF -- Domain values: diff --git a/kore/test/Test/Kore/Simplify/InternalMap.hs b/kore/test/Test/Kore/Simplify/InternalMap.hs index c9e1dc7fca..61a7070d88 100644 --- a/kore/test/Test/Kore/Simplify/InternalMap.hs +++ b/kore/test/Test/Kore/Simplify/InternalMap.hs @@ -111,7 +111,7 @@ test_simplify = assertEqual "" (OrPattern.fromPatterns expect) - (evaluate Mock.topSort origin) + (evaluate origin) mkMap :: [(child, child)] -> [child] -> InternalMap Key child mkMap = mkMapAux [] @@ -140,7 +140,6 @@ mkMapAux concreteElements elements opaque = } evaluate :: - Sort -> InternalMap Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName evaluate = simplify From 6fb683a4b1aa1fb347b347ff5e26eadad45eeda5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 16 Aug 2021 13:42:07 +0300 Subject: [PATCH 65/74] Remove Sort parameter from Top.simplify --- kore/src/Kore/Simplify/TermLike.hs | 2 +- kore/src/Kore/Simplify/Top.hs | 7 ++++--- kore/test/Test/Kore/Simplify/Top.hs | 3 +-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index a26c6aba88..42be9035cf 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -441,7 +441,7 @@ simplify sideCondition = \termLike -> -- TODO(virgil): Move next up through patterns. NextF nextF -> Next.simplify <$> simplifyChildren nextF OrF orF -> Or.simplify <$> simplifyChildren orF - TopF topF -> Top.simplify termSort <$> simplifyChildren topF + TopF topF -> Top.simplify <$> simplifyChildren topF -- StringLiteralF stringLiteralF -> return $ StringLiteral.simplify (getConst stringLiteralF) diff --git a/kore/src/Kore/Simplify/Top.hs b/kore/src/Kore/Simplify/Top.hs index cfdc7d00a8..9b9bf78d88 100644 --- a/kore/src/Kore/Simplify/Top.hs +++ b/kore/src/Kore/Simplify/Top.hs @@ -20,13 +20,14 @@ import Kore.Rewrite.RewritingVariable ( ) import Kore.Sort import Kore.Syntax.Top -import Prelude.Kore () +import Prelude.Kore ( + (.), + ) -- | simplifies a Top pattern, which means returning an always-true or. -- TODO (virgil): Preserve pattern sorts under simplification. simplify :: - Sort -> Top Sort child -> OrPattern RewritingVariableName -simplify sort _ = OrPattern.topOf sort +simplify = OrPattern.topOf . topSort diff --git a/kore/test/Test/Kore/Simplify/Top.hs b/kore/test/Test/Kore/Simplify/Top.hs index 00fa0445d9..10425761a0 100644 --- a/kore/test/Test/Kore/Simplify/Top.hs +++ b/kore/test/Test/Kore/Simplify/Top.hs @@ -28,12 +28,11 @@ test_topSimplification = ( assertEqual "" (OrPattern.fromPattern (Pattern.topOf testSort)) - (evaluate testSort Top{topSort = testSort}) + (evaluate Top{topSort = testSort}) ) ] evaluate :: - Sort -> Top Sort (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName evaluate = simplify From a978cf8805f4381250a7de61cda80326acbcdaa2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 16 Aug 2021 13:47:05 +0300 Subject: [PATCH 66/74] Remove Sort parameter from InternalSet.simplify --- kore/src/Kore/Simplify/InternalSet.hs | 13 ++++++------- kore/src/Kore/Simplify/TermLike.hs | 4 ++-- kore/test/Test/Kore/Simplify/InternalSet.hs | 3 +-- 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/kore/src/Kore/Simplify/InternalSet.hs b/kore/src/Kore/Simplify/InternalSet.hs index 8ebede9a0e..0bd24c53a6 100644 --- a/kore/src/Kore/Simplify/InternalSet.hs +++ b/kore/src/Kore/Simplify/InternalSet.hs @@ -25,15 +25,14 @@ import Prelude.Kore -- | Simplify an 'InternalMap' pattern. simplify :: - Sort -> InternalSet Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName -simplify sort = - traverse (Logic.scatter >>> Compose) - >>> fmap (normalizeInternalSet sort >>> markSimplified) - >>> getCompose - >>> fmap Pattern.syncSort - >>> MultiOr.observeAll +simplify internalSet = + traverse (Logic.scatter >>> Compose) internalSet + & fmap (normalizeInternalSet (builtinAcSort internalSet) >>> markSimplified) + & getCompose + & fmap Pattern.syncSort + & MultiOr.observeAll normalizeInternalSet :: Sort -> diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index 42be9035cf..db6d7a7fc9 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -417,7 +417,7 @@ simplify sideCondition = \termLike -> InternalMapF internalMapF -> InternalMap.simplify <$> simplifyChildren internalMapF InternalSetF internalSetF -> - (InternalSet.simplify termSort) <$> simplifyChildren internalSetF + InternalSet.simplify <$> simplifyChildren internalSetF DomainValueF domainValueF -> DomainValue.simplify <$> simplifyChildren domainValueF FloorF floorF -> Floor.simplify <$> simplifyChildren floorF @@ -554,7 +554,7 @@ simplifyOnly sideCondition = InternalMapF internalMapF -> InternalMap.simplify <$> traverse worker internalMapF InternalSetF internalSetF -> - InternalSet.simplify sort <$> traverse worker internalSetF + InternalSet.simplify <$> traverse worker internalSetF -- Domain values: DomainValueF domainValueF -> DomainValue.simplify <$> traverse worker domainValueF diff --git a/kore/test/Test/Kore/Simplify/InternalSet.hs b/kore/test/Test/Kore/Simplify/InternalSet.hs index 8c2961df94..dc277ac44e 100644 --- a/kore/test/Test/Kore/Simplify/InternalSet.hs +++ b/kore/test/Test/Kore/Simplify/InternalSet.hs @@ -82,7 +82,7 @@ test_simplify = TestTree becomes name origin (OrPattern.fromPatterns -> expects) = testCase name $ do - let actuals = evaluate Mock.topSort origin + let actuals = evaluate origin assertEqual "" expects actuals mkSet :: [child] -> [child] -> InternalSet Key child @@ -114,7 +114,6 @@ mkSetAux concreteElements elements opaque = mkSetValue = \x -> (x, SetValue) evaluate :: - Sort -> InternalSet Key (OrPattern RewritingVariableName) -> OrPattern RewritingVariableName evaluate = simplify From 26415a91d3b8e73eeadec58a8744ed21cd58d76c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 16 Aug 2021 14:02:26 +0300 Subject: [PATCH 67/74] Use pattern sort in Or.hs if available --- kore/test/Test/Kore/Simplify/Or.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/kore/test/Test/Kore/Simplify/Or.hs b/kore/test/Test/Kore/Simplify/Or.hs index aa2c849957..77315526a6 100644 --- a/kore/test/Test/Kore/Simplify/Or.hs +++ b/kore/test/Test/Kore/Simplify/Or.hs @@ -9,6 +9,7 @@ import qualified Data.List as List import Data.Text ( Text, ) +import Kore.Internal.OrPattern (getSortIfNotBottom) import Kore.Internal.Predicate ( Predicate, makeEqualsPredicate, @@ -223,9 +224,11 @@ becomes ( stateIntention [ prettyOr or1 or2 , "to become:" - , Unparser.unparse $ OrPattern.toTermLike (mkSortVariable "_") expected + , Unparser.unparse $ OrPattern.toTermLike termSort expected ] ) + where + termSort = fromMaybe (mkSortVariable "_") (getSortIfNotBottom expected) simplifiesTo :: HasCallStack => From d422354c02ee26fbdcb5b277293d9f1957bf23d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 16 Aug 2021 14:36:39 +0300 Subject: [PATCH 68/74] Address Raoul's comments --- kore/src/Kore/Simplify/Equals.hs | 14 +++++++------- kore/test/Test/Kore/Builtin/Builtin.hs | 1 + 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/kore/src/Kore/Simplify/Equals.hs b/kore/src/Kore/Simplify/Equals.hs index 5aa80f807f..9af31d0210 100644 --- a/kore/src/Kore/Simplify/Equals.hs +++ b/kore/src/Kore/Simplify/Equals.hs @@ -68,6 +68,7 @@ import qualified Kore.Simplify.Or as Or ( simplifyEvaluated, ) import Kore.Simplify.Simplify +import Kore.Sort (sameSort) import Kore.Unification.UnifierT ( runUnifierT, ) @@ -172,9 +173,9 @@ simplify (first', second') = minMaxBy (on compareForEquals (OrPattern.toTermLike sort)) first second -{- TODO (virgil): Preserve pattern sorts under simplification. +{- -One way to preserve the required sort annotations is to make 'simplifyEvaluated' +Another way to preserve the required sort annotations is to make 'simplifyEvaluated' take an argument of type > CofreeF (Equals Sort) (Attribute.Pattern variable) (OrPattern variable) @@ -295,13 +296,12 @@ makeEvaluate second@Conditional{term = secondTerm} sideCondition = do - let termSort = termLikeSort firstTerm - let first' = first{term = if termsAreEqual then mkTop termSort else firstTerm} + let first' = first{term = if termsAreEqual then mkTop sort else firstTerm} firstCeil <- makeEvaluateCeil sort sideCondition first' - let second' = second{term = if termsAreEqual then mkTop termSort else secondTerm} + let second' = second{term = if termsAreEqual then mkTop sort else secondTerm} secondCeil <- makeEvaluateCeil sort sideCondition second' let mkNotSimplified notChild = - Not.simplify sideCondition Not{notSort = termSort, notChild} + Not.simplify sideCondition Not{notSort = sort, notChild} firstCeilNegation <- mkNotSimplified firstCeil secondCeilNegation <- mkNotSimplified secondCeil termEquality <- makeEvaluateTermsAssumesNoBottom firstTerm secondTerm @@ -315,7 +315,7 @@ makeEvaluate & MultiOr.map Pattern.withoutTerm & return where - sort = termLikeSort firstTerm + sort = sameSort (termLikeSort firstTerm) (termLikeSort secondTerm) termsAreEqual = firstTerm == secondTerm -- Do not export this. This not valid as a standalone function, it diff --git a/kore/test/Test/Kore/Builtin/Builtin.hs b/kore/test/Test/Kore/Builtin/Builtin.hs index 6f5f3f728f..f09433fe83 100644 --- a/kore/test/Test/Kore/Builtin/Builtin.hs +++ b/kore/test/Test/Kore/Builtin/Builtin.hs @@ -258,6 +258,7 @@ evaluateT :: evaluateT = lift . evaluate evaluateExpectTopK :: + HasCallStack => (MonadSMT smt, MonadLog smt, MonadProf smt, MonadMask smt) => TermLike RewritingVariableName -> Hedgehog.PropertyT smt () From 18b05e94605c976d5d6cb4d4fed2ac4b4437e3c9 Mon Sep 17 00:00:00 2001 From: github-actions Date: Mon, 16 Aug 2021 11:57:12 +0000 Subject: [PATCH 69/74] Format with fourmolu --- kore/src/Kore/Builtin/AssociativeCommutative.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/src/Kore/Builtin/AssociativeCommutative.hs b/kore/src/Kore/Builtin/AssociativeCommutative.hs index cd6502c6bf..743493c33b 100644 --- a/kore/src/Kore/Builtin/AssociativeCommutative.hs +++ b/kore/src/Kore/Builtin/AssociativeCommutative.hs @@ -1402,9 +1402,9 @@ unifyEqualsElementLists let remainder2Terms = map fromConcreteOrWithVariable remainder2 case elementListAsInternal - tools - (sameSort (termLikeSort first) (termLikeSort first)) - remainder2Terms of + tools + (sameSort (termLikeSort first) (termLikeSort first)) + remainder2Terms of Nothing -> debugUnifyBottomAndReturnBottom "Duplicated element in unification results" From 574844a83442024260f3802f427f64b5d00cf75f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 16 Aug 2021 15:07:58 +0300 Subject: [PATCH 70/74] Rebuild From 5e0be13f8915d0ec460675c059e44a69c60bbf60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Mon, 16 Aug 2021 18:20:59 +0300 Subject: [PATCH 71/74] Use sameSort with different sorts --- kore/src/Kore/Builtin/AssociativeCommutative.hs | 2 +- kore/src/Kore/Simplify/AndTerms.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/kore/src/Kore/Builtin/AssociativeCommutative.hs b/kore/src/Kore/Builtin/AssociativeCommutative.hs index 743493c33b..b086765a5b 100644 --- a/kore/src/Kore/Builtin/AssociativeCommutative.hs +++ b/kore/src/Kore/Builtin/AssociativeCommutative.hs @@ -1403,7 +1403,7 @@ unifyEqualsElementLists case elementListAsInternal tools - (sameSort (termLikeSort first) (termLikeSort first)) + (sameSort (termLikeSort first) (termLikeSort second)) remainder2Terms of Nothing -> debugUnifyBottomAndReturnBottom diff --git a/kore/src/Kore/Simplify/AndTerms.hs b/kore/src/Kore/Simplify/AndTerms.hs index d324e4ac82..ba9da59c7d 100644 --- a/kore/src/Kore/Simplify/AndTerms.hs +++ b/kore/src/Kore/Simplify/AndTerms.hs @@ -166,7 +166,7 @@ maybeTermEquals notSimplifier childTransformers first second = do | Just unifyData <- matchBottomTermEquals first second = lift $ bottomTermEquals - (sameSort (termLikeSort first) (termLikeSort first)) + (sameSort (termLikeSort first) (termLikeSort second)) SideCondition.topTODO unifyData | Just unifyData <- matchVariableFunctionEquals first second = @@ -202,7 +202,7 @@ maybeTermEquals notSimplifier childTransformers first second = do | Just unifyData <- Builtin.Map.matchUnifyNotInKeys first second = lift $ Builtin.Map.unifyNotInKeys - (sameSort (termLikeSort first) (termLikeSort first)) + (sameSort (termLikeSort first) (termLikeSort second)) childTransformers notSimplifier unifyData From 2262f7214ef44af139639b6caa8f480451251023 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Tue, 17 Aug 2021 14:40:09 +0300 Subject: [PATCH 72/74] Address comments --- kore/src/Kore/Builtin/EqTerm.hs | 41 +++++++++++++++++++++++++++ kore/src/Kore/Builtin/Int.hs | 7 ++--- kore/src/Kore/Builtin/KEqual.hs | 7 ++--- kore/src/Kore/Builtin/String.hs | 7 ++--- kore/src/Kore/Simplify/TermLike.hs | 1 + kore/test/Test/Kore/Builtin/KEqual.hs | 13 +++++++++ 6 files changed, 64 insertions(+), 12 deletions(-) diff --git a/kore/src/Kore/Builtin/EqTerm.hs b/kore/src/Kore/Builtin/EqTerm.hs index 1a97dee70b..e58bead410 100644 --- a/kore/src/Kore/Builtin/EqTerm.hs +++ b/kore/src/Kore/Builtin/EqTerm.hs @@ -5,10 +5,27 @@ License : BSD-3-Clause module Kore.Builtin.EqTerm ( EqTerm (..), matchEqTerm, + unifyEqTerm, ) where import qualified Control.Monad as Monad +import Kore.Internal.ApplicationSorts (applicationSortsResult) +import qualified Kore.Internal.MultiOr as MultiOr +import qualified Kore.Internal.OrPattern as OrPattern +import Kore.Internal.Pattern ( + Pattern, + ) +import qualified Kore.Internal.SideCondition as SideCondition import Kore.Internal.TermLike as TermLike +import Kore.Rewrite.RewritingVariable ( + RewritingVariableName, + ) +import Kore.Simplify.NotSimplifier ( + NotSimplifier (..), + ) +import Kore.Simplify.Simplify ( + TermSimplifier, + ) import Kore.Unification.Unify as Unify import Prelude.Kore @@ -29,3 +46,27 @@ matchEqTerm selectSymbol (App_ symbol [operand1, operand2]) = do Monad.guard (selectSymbol symbol) return EqTerm{symbol, operand1, operand2} matchEqTerm _ _ = Nothing + +{- | Unification for an equality-like symbol. +This function is suitable only for equality simplification. +-} +unifyEqTerm :: + forall unifier. + MonadUnify unifier => + TermSimplifier RewritingVariableName unifier -> + NotSimplifier unifier -> + EqTerm (TermLike RewritingVariableName) -> + Bool -> + unifier (Pattern RewritingVariableName) +unifyEqTerm unifyChildren (NotSimplifier notSimplifier) eqTerm value = + do + solution <- unifyChildren operand1 operand2 & OrPattern.gather + let solution' = MultiOr.map eraseTerm solution + (if value then pure else mkNotSimplified) solution' + >>= Unify.scatter + where + EqTerm{symbol, operand1, operand2} = eqTerm + eqSort = applicationSortsResult . symbolSorts $ symbol + eraseTerm conditional = conditional $> (mkTop eqSort) + mkNotSimplified notChild = + notSimplifier SideCondition.top Not{notSort = eqSort, notChild} \ No newline at end of file diff --git a/kore/src/Kore/Builtin/Int.hs b/kore/src/Kore/Builtin/Int.hs index 72296558cd..3026aa6d05 100644 --- a/kore/src/Kore/Builtin/Int.hs +++ b/kore/src/Kore/Builtin/Int.hs @@ -531,8 +531,7 @@ unifyIntEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyIntEq{eqTerm, internalBool} = unifyData EqTerm{symbol, operand1, operand2} = eqTerm - eraseTerm conditional = - conditional $> (mkTop (internalBoolSort internalBool)) - notSort = applicationSortsResult . symbolSorts $ symbol + eqSort = applicationSortsResult . symbolSorts $ symbol + eraseTerm conditional = conditional $> (mkTop eqSort) mkNotSimplified notChild = - notSimplifier SideCondition.top Not{notSort, notChild} + notSimplifier SideCondition.top Not{notSort = eqSort, notChild} diff --git a/kore/src/Kore/Builtin/KEqual.hs b/kore/src/Kore/Builtin/KEqual.hs index 652a3f50b1..2129b40176 100644 --- a/kore/src/Kore/Builtin/KEqual.hs +++ b/kore/src/Kore/Builtin/KEqual.hs @@ -282,11 +282,10 @@ unifyKequalsEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyKequalsEq{eqTerm, internalBool} = unifyData EqTerm{symbol, operand1, operand2} = eqTerm - eraseTerm conditional = - conditional $> (mkTop (internalBoolSort internalBool)) - sort = applicationSortsResult . symbolSorts $ symbol + eqSort = applicationSortsResult . symbolSorts $ symbol + eraseTerm conditional = conditional $> (mkTop eqSort) mkNotSimplified notChild = - notSimplifier SideCondition.top Not{notSort = sort, notChild} + notSimplifier SideCondition.top Not{notSort = eqSort, notChild} -- | The @KEQUAL.ite@ hooked symbol applied to @term@-type arguments. data IfThenElse term = IfThenElse diff --git a/kore/src/Kore/Builtin/String.hs b/kore/src/Kore/Builtin/String.hs index e350957944..77f8765d5f 100644 --- a/kore/src/Kore/Builtin/String.hs +++ b/kore/src/Kore/Builtin/String.hs @@ -580,8 +580,7 @@ unifyStringEq unifyChildren (NotSimplifier notSimplifier) unifyData = where UnifyStringEq{eqTerm, internalBool} = unifyData EqTerm{symbol, operand1, operand2} = eqTerm - eraseTerm conditional = - conditional $> (mkTop (internalBoolSort internalBool)) - notSort = applicationSortsResult . symbolSorts $ symbol + eqSort = applicationSortsResult . symbolSorts $ symbol + eraseTerm conditional = conditional $> (mkTop eqSort) mkNotSimplified notChild = - notSimplifier SideCondition.top Not{notSort, notChild} + notSimplifier SideCondition.top Not{notSort = eqSort, notChild} diff --git a/kore/src/Kore/Simplify/TermLike.hs b/kore/src/Kore/Simplify/TermLike.hs index db6d7a7fc9..caef76d68c 100644 --- a/kore/src/Kore/Simplify/TermLike.hs +++ b/kore/src/Kore/Simplify/TermLike.hs @@ -576,6 +576,7 @@ simplifyOnly sideCondition = -- Matching Logic: AndF andF -> do let conjuncts = foldMap MultiAnd.fromTermLike andF + -- MultiAnd doesn't preserve the sort so we need to send it as an external argument And.simplify sort Not.notSimplifier sideCondition =<< MultiAnd.traverse worker conjuncts OrF orF -> diff --git a/kore/test/Test/Kore/Builtin/KEqual.hs b/kore/test/Test/Kore/Builtin/KEqual.hs index 34b6c8ecba..c9aff4af19 100644 --- a/kore/test/Test/Kore/Builtin/KEqual.hs +++ b/kore/test/Test/Kore/Builtin/KEqual.hs @@ -122,6 +122,19 @@ test_KEqual = ) actual <- evaluate original assertEqual' "" expect actual + , testCaseWithoutSMT "kseq(x, dotk) and kseq(x, dotk)" $ do + let expect = OrPattern.fromTermLike $ Test.Bool.asInternal True + xConfigElemVarKItemSort = + configElementVariableFromId "x" kItemSort + original = + mkAnd + (Test.Bool.asInternal True) + ( keqBool + (kseq (mkElemVar xConfigElemVarKItemSort) dotk) + (kseq (mkElemVar xConfigElemVarKItemSort) dotk) + ) + actual <- evaluate 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) From 43766a953f97f64c5302fe17ff0db90381e5aeb2 Mon Sep 17 00:00:00 2001 From: github-actions Date: Tue, 17 Aug 2021 11:42:57 +0000 Subject: [PATCH 73/74] Format with fourmolu --- kore/src/Kore/Builtin/EqTerm.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kore/src/Kore/Builtin/EqTerm.hs b/kore/src/Kore/Builtin/EqTerm.hs index e58bead410..7d6734f026 100644 --- a/kore/src/Kore/Builtin/EqTerm.hs +++ b/kore/src/Kore/Builtin/EqTerm.hs @@ -69,4 +69,4 @@ unifyEqTerm unifyChildren (NotSimplifier notSimplifier) eqTerm value = eqSort = applicationSortsResult . symbolSorts $ symbol eraseTerm conditional = conditional $> (mkTop eqSort) mkNotSimplified notChild = - notSimplifier SideCondition.top Not{notSort = eqSort, notChild} \ No newline at end of file + notSimplifier SideCondition.top Not{notSort = eqSort, notChild} From aa257231597fe31b2066dfa39379add0437a3ba3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Burdu=C8=99a?= Date: Tue, 17 Aug 2021 15:23:03 +0300 Subject: [PATCH 74/74] Rebuild