Skip to content

Commit d82576f

Browse files
committed
Improve control-flow in evaluatePattern'
1 parent 1fce254 commit d82576f

File tree

1 file changed

+19
-22
lines changed

1 file changed

+19
-22
lines changed

booster/library/Booster/Pattern/ApplyEquations.hs

+19-22
Original file line numberDiff line numberDiff line change
@@ -463,16 +463,15 @@ evaluatePattern' ::
463463
EquationT io Pattern
464464
evaluatePattern' pat@Pattern{term, constraints, ceilConditions} = withPatternContext pat $ do
465465
solver <- (.smtSolver) <$> getConfig
466-
-- check the pattern's constraints for consistency, reporting an error if they are Bottom
467-
withContext CtxConstraint
468-
. withContext CtxDetail
469-
. withTermContext (coerce $ collapseAndBools constraints)
470-
$ pure ()
471-
consistent <- withContext CtxConstraint $ SMT.isSat solver constraints
472-
withContext CtxConstraint $ do
473-
logMessage $
474-
"Constraints consistency check returns: " <> show consistent
475-
466+
-- check the pattern's constraints for satisfiability to ensure they are consistent
467+
consistent <-
468+
withContext CtxConstraint $ do
469+
withContext CtxDetail . withTermContext (coerce $ collapseAndBools constraints) $ pure ()
470+
consistent <- SMT.isSat solver constraints
471+
withContext CtxConstraint $
472+
logMessage $
473+
"Constraints consistency check returns: " <> show consistent
474+
pure consistent
476475
case consistent of
477476
Right False -> do
478477
-- the constraints are unsatisfiable, which means that the patten is Bottom
@@ -482,23 +481,21 @@ evaluatePattern' pat@Pattern{term, constraints, ceilConditions} = withPatternCon
482481
-- continue to preserver the old behaviour.
483482
withContext CtxConstraint . logWarn . Text.pack $
484483
"Constraints consistency UNKNOWN: " <> show consistent
485-
continue
484+
pure ()
486485
Left other ->
487486
-- fail hard on SMT error other than @SMT.SMTSolverUnknown@
488487
liftIO $ Exception.throw other
489-
Right True -> do
488+
Right True ->
490489
-- constraints are consistent, continue
491-
continue
492-
where
493-
continue = do
494-
newTerm <- withTermContext term $ evaluateTerm' BottomUp term `catch_` keepTopLevelResults
495-
-- after evaluating the term, evaluate all (existing and
496-
-- newly-acquired) constraints, once
497-
traverse_ simplifyAssumedPredicate . predicates =<< getState
498-
-- this may yield additional new constraints, left unevaluated
499-
evaluatedConstraints <- predicates <$> getState
500-
pure Pattern{constraints = evaluatedConstraints, term = newTerm, ceilConditions}
490+
pure ()
501491

492+
newTerm <- withTermContext term $ evaluateTerm' BottomUp term `catch_` keepTopLevelResults
493+
-- after evaluating the term, evaluate all (existing and newly-acquired) constraints, once
494+
traverse_ simplifyAssumedPredicate . predicates =<< getState
495+
-- this may yield additional new constraints, left unevaluated
496+
evaluatedConstraints <- predicates <$> getState
497+
pure Pattern{constraints = evaluatedConstraints, term = newTerm, ceilConditions}
498+
where
502499
-- when TooManyIterations exception occurred while evaluating the top-level term,
503500
-- i.e. not in a recursive evaluation of a side-condition,
504501
-- it is safe to keep the partial result and ignore the exception.

0 commit comments

Comments
 (0)