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

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
35 changes: 0 additions & 35 deletions booster/library/Booster/Pattern/ApplyEquations.hs
Original file line number Diff line number Diff line change
Expand Up @@ -844,27 +844,6 @@ applyEquations theory handler term = do
)
err

{- | A sort predicate equation is characterised by the following:
* Its lhs is a function application (of a symbol starting with 'Lblis', not checked)
* function argument is a singleton K sequence
* containing an injection of a Variable into the 'KItem' sort
* rhs is a boolean
* requires and ensures are both empty (i.e., plain "true" DVs)
* the rule has no location information
-}
isSortPredicate :: RewriteRule tag -> Bool
isSortPredicate rule
| SymbolApplication _funSym [] [arg] <- rule.lhs
, KSeq sort (Var v) <- arg -- implicitly: Injection sort KItem (Var v)
, v.variableSort == sort
, (rule.rhs == TrueBool || rule.rhs == FalseBool)
, [Predicate TrueBool] <- rule.requires -- , null rule.requires
, [Predicate TrueBool] <- rule.ensures -- , null rule.ensures
, UNKNOWN <- sourceRef rule.attributes =
True
| otherwise =
False

applyEquation ::
forall io tag.
LoggerMIO io =>
Expand All @@ -873,20 +852,6 @@ applyEquation ::
EquationT
io
(Either ((EquationT io () -> EquationT io ()) -> EquationT io (), ApplyEquationFailure) Term)
applyEquation (FunctionApplication _sym [] [term]) rule
| isSortPredicate rule
, KSeq _ (FunctionApplication _ _ _) <- term =
-- sort predicates only match on a sort injection, unevaluated
-- function applications may create false negatives
pure $
Left
( \ctxt ->
ctxt $
withTermContext term $
withContext CtxWarn $
logMessage ("Refusing to apply sort predicate rule to an unevaluated term" :: Text)
, IndeterminateMatch
)
applyEquation term rule =
runExceptT $
getPrettyModifiers >>= \case
Expand Down
50 changes: 33 additions & 17 deletions booster/library/Booster/Pattern/Match.hs
Original file line number Diff line number Diff line change
Expand Up @@ -330,7 +330,7 @@ matchInj ::
Term ->
StateT MatchState (Except MatchResult) ()
matchInj
matchType
_matchType
source1
target1
trm1
Expand All @@ -341,28 +341,44 @@ matchInj
failWith (DifferentSorts (Injection source1 target1 trm1) (Injection source2 target2 trm2))
| source1 == source2 = do
enqueueRegularProblem trm1 trm2
| Var v <- trm1 = do
-- variable in pattern, check source sorts and bind
matchInj
matchType
source1
target1
trm1
source2
target2
trm2 =
do
subsorts <- gets mSubsorts
isSubsort <-
s1IsSubsort <-
lift . withExcept (MatchFailed . SubsortingError) $
checkSubsort subsorts source1 source2
s2IsSubsort <-
lift . withExcept (MatchFailed . SubsortingError) $
checkSubsort subsorts source2 source1
if isSubsort
then bindVariable matchType v (Injection source2 source1 trm2)
else failWith (DifferentSorts trm1 trm2)
| FunctionApplication{} <- trm2 = do
-- cases below require a subsort relation (and source1 ==
-- source2 is already handled)
unless (s1IsSubsort || s2IsSubsort) $
failWith (DifferentSorts trm1 trm2)
-- Functions may have a more general sort than the actual result.
-- This means we cannot simply fail the rewrite: the match is
-- indeterminate if the function result is.
subsorts <- gets mSubsorts
isSubsort <- -- rule requires a more specific sort?
lift . withExcept (MatchFailed . SubsortingError) $
checkSubsort subsorts source1 source2
if isSubsort
then addIndeterminate trm1 trm2
else failWith (DifferentSorts (Injection source1 target1 trm1) (Injection source2 target2 trm2))
| otherwise =
failWith (DifferentSorts (Injection source1 target1 trm1) (Injection source2 target2 trm2))
case (s1IsSubsort, trm2) of
(True, FunctionApplication{}) ->
addIndeterminate trm1 trm2
_ -> do
-- If the rule has a variable with a supersort of the
-- subject, trm2 can be bound with a suitable injection
case (s2IsSubsort, trm1) of
(True, Var v) ->
bindVariable matchType v (Injection source2 source1 trm2)
_ ->
-- truly different sorts, safe to just fail
failWith $
DifferentSorts
(Injection source1 target1 trm1)
(Injection source2 target2 trm2)
{-# INLINE matchInj #-}

----- Symbol Applications
Expand Down
Loading
Loading