@@ -411,7 +411,11 @@ evaluateTerm' ::
411
411
evaluateTerm' direction = iterateEquations direction PreferFunctions
412
412
413
413
{- | Simplify a Pattern, processing its constraints independently.
414
- Returns either the first failure or the new pattern if no failure was encountered
414
+
415
+ Before evaluating the term of the pattern,
416
+ the constraints of the pattern are checked for consistency with an SMT solver.
417
+
418
+ Returns either the first failure or the new pattern if no failure was encountered.
415
419
-}
416
420
evaluatePattern ::
417
421
LoggerMIO io =>
@@ -430,13 +434,28 @@ evaluatePattern' ::
430
434
Pattern ->
431
435
EquationT io Pattern
432
436
evaluatePattern' pat@ Pattern {term, ceilConditions} = withPatternContext pat $ do
433
- newTerm <- withTermContext term $ evaluateTerm' BottomUp term `catch_` keepTopLevelResults
434
- -- after evaluating the term, evaluate all (existing and
435
- -- newly-acquired) constraints, once
436
- traverse_ simplifyAssumedPredicate . predicates =<< getState
437
- -- this may yield additional new constraints, left unevaluated
438
- evaluatedConstraints <- predicates <$> getState
439
- pure Pattern {constraints = evaluatedConstraints, term = newTerm, ceilConditions}
437
+ solver <- (. smtSolver) <$> getConfig
438
+ -- check initial constraints for consistency, reporting an error if they are Bottom
439
+ SMT. isSat solver pat. constraints >>= \ case
440
+ Right False -> do
441
+ let collapseAndBools :: Set Predicate -> Predicate
442
+ collapseAndBools = undefined
443
+ -- the constraints are unsatisfiable, which means that the patten is Bottom
444
+ throw . SideConditionFalse . collapseAndBools $ pat. constraints
445
+ Left unknwon@ SMT. SMTSolverUnknown {} -> do
446
+ -- unlikely case of an Unknown response to a consistency check.
447
+ -- What to do here? fail hard for now.
448
+ liftIO $ Exception. throw unknwon
449
+ Left other -> liftIO $ Exception. throw other -- fail hard on other SMT errors
450
+ Right True -> do
451
+ -- constrains are consistent, continue
452
+ newTerm <- withTermContext term $ evaluateTerm' BottomUp term `catch_` keepTopLevelResults
453
+ -- after evaluating the term, evaluate all (existing and
454
+ -- newly-acquired) constraints, once
455
+ traverse_ simplifyAssumedPredicate . predicates =<< getState
456
+ -- this may yield additional new constraints, left unevaluated
457
+ evaluatedConstraints <- predicates <$> getState
458
+ pure Pattern {constraints = evaluatedConstraints, term = newTerm, ceilConditions}
440
459
where
441
460
-- when TooManyIterations exception occurred while evaluating the top-level term,
442
461
-- i.e. not in a recursive evaluation of a side-condition,
0 commit comments