@@ -411,7 +411,11 @@ evaluateTerm' ::
411411evaluateTerm' direction = iterateEquations direction PreferFunctions
412412
413413{- | 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.
415419-}
416420evaluatePattern ::
417421 LoggerMIO io =>
@@ -430,13 +434,28 @@ evaluatePattern' ::
430434 Pattern ->
431435 EquationT io Pattern
432436evaluatePattern' 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}
440459 where
441460 -- when TooManyIterations exception occurred while evaluating the top-level term,
442461 -- i.e. not in a recursive evaluation of a side-condition,
0 commit comments