refactor: try ==> commitWhen

This commit is contained in:
Leonardo de Moura 2020-02-14 19:17:11 -08:00
parent ddf6ecaea3
commit 203bf08339
2 changed files with 17 additions and 16 deletions

View file

@ -31,7 +31,7 @@ if a.isLambda && !b.isLambda then do
match bType with
| Expr.forallE n d _ c =>
let b' := Lean.mkLambda n c.binderInfo d (mkApp b (mkBVar 0));
try $ isExprDefEqAux a b'
commitWhen $ isExprDefEqAux a b'
| _ => pure false
else
pure false
@ -567,7 +567,7 @@ match v with
private partial def processAssignmentFOApprox (mvar : Expr) (args : Array Expr) : Expr → MetaM Bool
| v => do
trace! `Meta.isDefEq.foApprox (mvar ++ " " ++ args ++ " := " ++ v);
condM (try $ processAssignmentFOApproxAux mvar args v)
condM (commitWhen $ processAssignmentFOApproxAux mvar args v)
(pure true)
(do v? ← unfoldDefinition? v;
match v? with
@ -701,7 +701,7 @@ private def tryHeuristic (t s : Expr) : MetaM Bool :=
let tFn := t.getAppFn;
let sFn := s.getAppFn;
traceCtx `Meta.isDefEq.delta $
try $ do
commitWhen $ do
b ← isDefEqArgs tFn t.getAppArgs s.getAppArgs
<&&>
isListLevelDefEqAux tFn.constLevels! sFn.constLevels!;
@ -924,10 +924,10 @@ private partial def isDefEqQuick : Expr → Expr → MetaM LBool
if s.isMVar && !t.isMVar then
/- Solve `?m t =?= ?n` by trying first `?n := ?m t`.
Reason: this assignment is precise. -/
condM (try (processAssignment s t)) (pure LBool.true) $
condM (commitWhen (processAssignment s t)) (pure LBool.true) $
assign t s
else
condM (try (processAssignment t s)) (pure LBool.true) $
condM (commitWhen (processAssignment t s)) (pure LBool.true) $
assign s t
private def isDefEqProofIrrel (t s : Expr) : MetaM LBool := do
@ -945,7 +945,7 @@ match status with
(do sType ← inferType s; toLBoolM $ isExprDefEqAux tType sType)
(pure LBool.undef)
@[inline] def tryL (x : MetaM LBool) (k : MetaM Bool) : MetaM Bool := do
@[inline] def whenUndefDo (x : MetaM LBool) (k : MetaM Bool) : MetaM Bool := do
status ← x;
match status with
| LBool.true => pure true
@ -960,7 +960,8 @@ s' ← whnfCore s;
if t == t' && s == s' then
k t' s'
else
tryL (isDefEqQuick t' s') $ k t' s'
whenUndefDo (isDefEqQuick t' s') $
k t' s'
@[specialize] private def unstuckMVar
(e : Expr)
@ -988,17 +989,17 @@ partial def isExprDefEqAuxImpl : Expr → Expr → MetaM Bool
let t := consumeLet t;
let s := consumeLet s;
trace `Meta.isDefEq.step $ fun _ => t ++ " =?= " ++ s;
tryL (isDefEqQuick t s) $
tryL (isDefEqProofIrrel t s) $
whenUndefDo (isDefEqQuick t s) $
whenUndefDo (isDefEqProofIrrel t s) $
isDefEqWHNF t s $ fun t s => do
tryL (isDefEqOffset t s) $ do
tryL (isDefEqDelta t s) $
whenUndefDo (isDefEqOffset t s) $ do
whenUndefDo (isDefEqDelta t s) $
condM (isDefEqEta t s <||> isDefEqEta s t) (pure true) $
match t, s with
| Expr.const c us _, Expr.const d vs _ => if c == d then isListLevelDefEqAux us vs else pure false
| Expr.app _ _ _, Expr.app _ _ _ =>
let tFn := t.getAppFn;
condM (try (isExprDefEqAux tFn s.getAppFn <&&> isDefEqArgs tFn t.getAppArgs s.getAppArgs))
condM (commitWhen (isExprDefEqAux tFn s.getAppFn <&&> isDefEqArgs tFn t.getAppArgs s.getAppArgs))
(pure true)
(isDefEqOnFailure t s)
| _, _ => isDefEqOnFailure t s

View file

@ -194,12 +194,12 @@ private def restore (env : Environment) (mctx : MetavarContext) (postponed : Per
modify $ fun s => { env := env, mctx := mctx, postponed := postponed, .. s }
/--
`try x` executes `x` and process all postponed universe level constraints produced by `x`.
`commitWhen x` executes `x` and process all postponed universe level constraints produced by `x`.
We keep the modifications only if both return `true`.
Remark: postponed universe level constraints must be solved before returning. Otherwise,
we don't know whether `x` really succeeded. -/
@[specialize] def try (x : MetaM Bool) : MetaM Bool := do
@[specialize] def commitWhen (x : MetaM Bool) : MetaM Bool := do
s ← get;
let env := s.env;
let mctx := s.mctx;
@ -217,13 +217,13 @@ catch
def isLevelDefEq (u v : Level) : MetaM Bool :=
traceCtx `Meta.isLevelDefEq $ do
b ← try $ isLevelDefEqAux u v;
b ← commitWhen $ isLevelDefEqAux u v;
trace! `Meta.isLevelDefEq (u ++ " =?= " ++ v ++ " ... " ++ if b then "success" else "failure");
pure b
def isExprDefEq (t s : Expr) : MetaM Bool :=
traceCtx `Meta.isDefEq $ do
b ← try $ isExprDefEqAux t s;
b ← commitWhen $ isExprDefEqAux t s;
trace! `Meta.isDefEq (t ++ " =?= " ++ s ++ " ... " ++ if b then "success" else "failure");
pure b