feat: add tryPureCoe
@Kha It seems to work reasonably well. It didn't break any test.
This commit is contained in:
parent
3c699eb915
commit
0595e8a78a
2 changed files with 51 additions and 1 deletions
|
|
@ -524,6 +524,18 @@ match result with
|
|||
| LOption.undef => throwError ref ("failed to synthesize instance" ++ indentExpr type)
|
||||
| LOption.none => throwError ref ("failed to synthesize instance" ++ indentExpr type)
|
||||
|
||||
/--
|
||||
Try to coerce `a : α` into `m β` by first coercing `a : α` into ‵β`, and then using `pure`.
|
||||
The method is only applied if the head of `α` nor ‵β` is not a metavariable. -/
|
||||
private def tryPureCoe? (ref : Syntax) (m β α a : Expr) : TermElabM (Option Expr) :=
|
||||
if β.getAppFn.isMVar || α.getAppFn.isMVar then pure none
|
||||
else catch
|
||||
(do
|
||||
aNew ← tryCoe ref β α a none;
|
||||
aNew ← liftMetaM ref $ Meta.mkPure m aNew;
|
||||
pure $ some aNew)
|
||||
(fun _ => pure none)
|
||||
|
||||
/-
|
||||
Try coercions and monad lifts to make sure `e` has type `expectedType`.
|
||||
|
||||
|
|
@ -532,7 +544,11 @@ Otherwise, we just use the basic `tryCoe`.
|
|||
|
||||
Extensions for monads.
|
||||
|
||||
Given an expected type of the form `n β` and a given type `eType` is of the form `m α`. We use the following approaches.
|
||||
Given an expected type of the form `n β`, if `eType` is of the form `α`
|
||||
|
||||
1 - Try to coerce ‵α` into ‵β`, and use `pure` to lift it to `n α`.
|
||||
|
||||
If `eType` is of the form `m α`. We use the following approaches.
|
||||
|
||||
1- Try to unify `n` and `m`. If it succeeds, then we rely on `tryCoe`, and
|
||||
the instances
|
||||
|
|
@ -578,7 +594,13 @@ since this goal does not contain any metavariables. And then, we
|
|||
convert `g x` into `liftM $ g x`.
|
||||
-/
|
||||
def tryLiftAndCoe (ref : Syntax) (expectedType : Expr) (eType : Expr) (e : Expr) (f? : Option Expr) : TermElabM Expr := do
|
||||
eType ← instantiateMVars ref eType;
|
||||
some ⟨n, β, monadInst⟩ ← isMonad? ref expectedType | tryCoe ref expectedType eType e f?;
|
||||
β ← instantiateMVars ref β;
|
||||
eNew? ← tryPureCoe? ref n β eType e;
|
||||
match eNew? with
|
||||
| some eNew => pure eNew
|
||||
| none => do
|
||||
some (m, α) ← isTypeApp? ref eType | tryCoe ref expectedType eType e f?;
|
||||
condM (isDefEq ref m n) (tryCoe ref expectedType eType e f?) $
|
||||
catch
|
||||
|
|
|
|||
28
tests/lean/run/tryPureCoe.lean
Normal file
28
tests/lean/run/tryPureCoe.lean
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
new_frontend
|
||||
def m1 : IO Bool :=
|
||||
pure true
|
||||
|
||||
def p (x : Nat) : Bool :=
|
||||
x > 0
|
||||
|
||||
def tst1 : IO Bool :=
|
||||
true <&&> m1
|
||||
|
||||
def tst2 (x : Nat) : IO Bool :=
|
||||
x = 0 <&&> m1
|
||||
|
||||
def tst3 (x : Nat) : IO Unit :=
|
||||
whenM (m1 <&&> x > 0) $
|
||||
throw $ IO.userError "test"
|
||||
|
||||
def tst4 (x : Nat) : IO Unit :=
|
||||
whenM (x > 0 <&&> m1) $
|
||||
throw $ IO.userError "test"
|
||||
|
||||
def tst5 (x : Nat) : IO Unit :=
|
||||
whenM (p x <&&> m1) $
|
||||
throw $ IO.userError "test"
|
||||
|
||||
def tst6 (x : Nat) : IO Unit :=
|
||||
whenM (p x <&&> id m1) $
|
||||
throw $ IO.userError "test"
|
||||
Loading…
Add table
Reference in a new issue