@@ -870,42 +870,52 @@ applyEquation term rule = fmap (either Failure Success) $ runExceptT $ do
870
870
$ " Substitution:"
871
871
<+> (hsep $ intersperse " ," $ map (\ (k, v) -> pretty k <+> " ->" <+> pretty v) $ Map. toList subst)
872
872
873
- -- check required conditions, using substitution
873
+ -- instantiate the requires clause with the obtained substitution
874
874
let required =
875
875
concatMap
876
876
(splitBoolPredicates . coerce . substituteInTerm subst . coerce)
877
877
rule. requires
878
878
-- If the required condition is _syntactically_ present in
879
879
-- the prior (known constraints), we don't check it.
880
880
knownPredicates <- (. predicates) <$> lift getState
881
- let (knownTrue, toCheck) = partition (`Set.member` knownPredicates) required
882
- unless (null knownTrue) $
883
- logMessage $
884
- renderOneLineText $
885
- " Known true side conditions (won't check):" <+> hsep (intersperse " ," $ map pretty knownTrue)
886
-
887
- unclearConditions' <- catMaybes <$> mapM (checkConstraint ConditionFalse ) toCheck
888
-
889
- case unclearConditions' of
890
- [] -> do
891
- -- check ensured conditions, filter any
892
- -- true ones, prune if any is false
893
- let ensured =
894
- concatMap
895
- (splitBoolPredicates . substituteInPredicate subst)
896
- (Set. toList rule. ensures)
897
- ensuredConditions <-
898
- -- throws if an ensured condition found to be false
899
- catMaybes <$> mapM (checkConstraint EnsuresFalse ) ensured
900
- lift $ pushConstraints $ Set. fromList ensuredConditions
901
- pure $ substituteInTerm subst rule. rhs
902
- unclearConditions -> do
903
- withContext " failure" $
904
- logMessage $
905
- renderOneLineText $
906
- " Uncertain about a condition(s) in rule:" <+> hsep (intersperse " ," $ map pretty unclearConditions)
907
- throwE $ IndeterminateCondition unclearConditions
881
+ toCheck <- lift $ filterOutKnownConstraints knownPredicates required
882
+
883
+ -- check the filtered requires clause conditions
884
+ unclearConditions <- catMaybes <$> mapM (checkConstraint ConditionFalse ) toCheck
885
+
886
+ -- unclear conditions may have been simplified and
887
+ -- could now be syntactically present in the path constraints, filter again
888
+ stillUnclear <- lift $ filterOutKnownConstraints knownPredicates unclearConditions
889
+
890
+ -- abort if any of the conditions is still unclear at that point
891
+ unless (null stillUnclear) $ do
892
+ withContext " failure" $
893
+ logMessage $
894
+ renderOneLineText $
895
+ " Uncertain about a condition(s) in rule:" <+> hsep (intersperse " ," $ map pretty stillUnclear)
896
+ throwE $ IndeterminateCondition unclearConditions
897
+
898
+ -- check ensured conditions, filter any
899
+ -- true ones, prune if any is false
900
+ let ensured =
901
+ concatMap
902
+ (splitBoolPredicates . substituteInPredicate subst)
903
+ (Set. toList rule. ensures)
904
+ ensuredConditions <-
905
+ -- throws if an ensured condition found to be false
906
+ catMaybes <$> mapM (checkConstraint EnsuresFalse ) ensured
907
+ lift $ pushConstraints $ Set. fromList ensuredConditions
908
+ pure $ substituteInTerm subst rule. rhs
908
909
where
910
+ filterOutKnownConstraints :: Set Predicate -> [Predicate ] -> EquationT io [Predicate ]
911
+ filterOutKnownConstraints priorKnowledge constraitns = do
912
+ let (knownTrue, toCheck) = partition (`Set.member` priorKnowledge) constraitns
913
+ unless (null knownTrue) $
914
+ logMessage $
915
+ renderOneLineText $
916
+ " Known true side conditions (won't check):" <+> hsep (intersperse " ," $ map pretty knownTrue)
917
+ pure toCheck
918
+
909
919
-- Simplify given predicate in a nested EquationT execution.
910
920
-- Call 'whenBottom' if it is Bottom, return Nothing if it is Top,
911
921
-- otherwise return the simplified remaining predicate.
0 commit comments