@@ -436,17 +436,24 @@ evaluatePattern' ::
436436evaluatePattern' pat@ Pattern {term, ceilConditions} = withPatternContext pat $ do
437437 solver <- (. smtSolver) <$> getConfig
438438 -- check initial constraints for consistency, reporting an error if they are Bottom
439- SMT. isSat solver pat. constraints >>= \ case
439+ withContext CtxConstraint
440+ . withContext CtxDetail
441+ . withTermContext (coerce $ collapseAndBools pat. constraints)
442+ $ pure ()
443+ consistent <- withContext CtxConstraint $ SMT. isSat solver pat. constraints
444+ withContext CtxConstraint $ do
445+ logMessage $
446+ " Constraints consistency check returns: " <> show consistent
447+
448+ case consistent of
440449 Right False -> do
441- let collapseAndBools :: Set Predicate -> Predicate
442- collapseAndBools = undefined
443450 -- the constraints are unsatisfiable, which means that the patten is Bottom
444451 throw . SideConditionFalse . collapseAndBools $ pat. constraints
445- Left unknwon @ SMT. SMTSolverUnknown {} -> do
452+ Left SMT. SMTSolverUnknown {} -> do
446453 -- unlikely case of an Unknown response to a consistency check.
447454 -- What to do here? continue for now to preserver the old behaviour.
448- withPatternContext pat . logWarn . Text. pack $
449- " Constraints consistency check returns : " <> show unknwon
455+ withContext CtxConstraint . logWarn . Text. pack $
456+ " Constraints consistency UNKNOWN : " <> show consistent
450457 continue
451458 Left other ->
452459 -- fail hard on SMT error other than @SMT.SMTSolverUnknown@
@@ -475,6 +482,9 @@ evaluatePattern' pat@Pattern{term, ceilConditions} = withPatternContext pat $ do
475482 pure partialResult
476483 err -> throw err
477484
485+ collapseAndBools :: Set Predicate -> Predicate
486+ collapseAndBools = coerce . foldAndBool . map coerce . Set. toList
487+
478488-- evaluate the given predicate assuming all others
479489simplifyAssumedPredicate :: LoggerMIO io => Predicate -> EquationT io ()
480490simplifyAssumedPredicate p = do
0 commit comments