@@ -436,17 +436,24 @@ evaluatePattern' ::
436
436
evaluatePattern' pat@ Pattern {term, ceilConditions} = withPatternContext pat $ do
437
437
solver <- (. smtSolver) <$> getConfig
438
438
-- 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
440
449
Right False -> do
441
- let collapseAndBools :: Set Predicate -> Predicate
442
- collapseAndBools = undefined
443
450
-- the constraints are unsatisfiable, which means that the patten is Bottom
444
451
throw . SideConditionFalse . collapseAndBools $ pat. constraints
445
- Left unknwon @ SMT. SMTSolverUnknown {} -> do
452
+ Left SMT. SMTSolverUnknown {} -> do
446
453
-- unlikely case of an Unknown response to a consistency check.
447
454
-- 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
450
457
continue
451
458
Left other ->
452
459
-- fail hard on SMT error other than @SMT.SMTSolverUnknown@
@@ -475,6 +482,9 @@ evaluatePattern' pat@Pattern{term, ceilConditions} = withPatternContext pat $ do
475
482
pure partialResult
476
483
err -> throw err
477
484
485
+ collapseAndBools :: Set Predicate -> Predicate
486
+ collapseAndBools = coerce . foldAndBool . map coerce . Set. toList
487
+
478
488
-- evaluate the given predicate assuming all others
479
489
simplifyAssumedPredicate :: LoggerMIO io => Predicate -> EquationT io ()
480
490
simplifyAssumedPredicate p = do
0 commit comments