@@ -464,17 +464,24 @@ evaluatePattern' ::
464464evaluatePattern' pat@ Pattern {term, ceilConditions} = withPatternContext pat $ do
465465 solver <- (. smtSolver) <$> getConfig
466466 -- check initial constraints for consistency, reporting an error if they are Bottom
467- SMT. isSat solver pat. constraints >>= \ case
467+ withContext CtxConstraint
468+ . withContext CtxDetail
469+ . withTermContext (coerce $ collapseAndBools pat. constraints)
470+ $ pure ()
471+ consistent <- withContext CtxConstraint $ SMT. isSat solver pat. constraints
472+ withContext CtxConstraint $ do
473+ logMessage $
474+ " Constraints consistency check returns: " <> show consistent
475+
476+ case consistent of
468477 Right False -> do
469- let collapseAndBools :: Set Predicate -> Predicate
470- collapseAndBools = undefined
471478 -- the constraints are unsatisfiable, which means that the patten is Bottom
472479 throw . SideConditionFalse . collapseAndBools $ pat. constraints
473- Left unknwon @ SMT. SMTSolverUnknown {} -> do
480+ Left SMT. SMTSolverUnknown {} -> do
474481 -- unlikely case of an Unknown response to a consistency check.
475482 -- What to do here? continue for now to preserver the old behaviour.
476- withPatternContext pat . logWarn . Text. pack $
477- " Constraints consistency check returns : " <> show unknwon
483+ withContext CtxConstraint . logWarn . Text. pack $
484+ " Constraints consistency UNKNOWN : " <> show consistent
478485 continue
479486 Left other ->
480487 -- fail hard on SMT error other than @SMT.SMTSolverUnknown@
@@ -503,6 +510,9 @@ evaluatePattern' pat@Pattern{term, ceilConditions} = withPatternContext pat $ do
503510 pure partialResult
504511 err -> throw err
505512
513+ collapseAndBools :: Set Predicate -> Predicate
514+ collapseAndBools = coerce . foldAndBool . map coerce . Set. toList
515+
506516-- evaluate the given predicate assuming all others
507517simplifyAssumedPredicate :: LoggerMIO io => Predicate -> EquationT io ()
508518simplifyAssumedPredicate p = do
0 commit comments