diff --git a/src/Lean/Delaborator.lean b/src/Lean/Delaborator.lean index ca3ef57210..3b6e05ee6b 100644 --- a/src/Lean/Delaborator.lean +++ b/src/Lean/Delaborator.lean @@ -197,9 +197,11 @@ descend e.bindingDomain! 0 d def withBindingBody {α} (n : Name) (d : DelabM α) : DelabM α := do e ← getExpr; -fun ctx => withLocalDecl n e.binderInfo e.bindingDomain! $ fun fvar => +withLocalDecl n e.binderInfo e.bindingDomain! (fun fvar => let b := e.bindingBody!.instantiate1 fvar; - descend b 1 d ctx + descend b 1 d) + -- we don't care about instances, and don't want ill-typed binders to crash the delaborator + false def withProj {α} (d : DelabM α) : DelabM α := do Expr.app fn _ _ ← getExpr | unreachable!; @@ -281,7 +283,7 @@ def delabAppExplicit : Delab := do (do fn ← getExpr; stx ← if fn.isConst then delabConst else delab; - implicitParams ← liftM $ getImplicitParams fn; + implicitParams ← liftM $ getImplicitParams fn <|> pure #[]; stx ← if implicitParams.any id then `(@$stx) else pure stx; pure (stx, #[])) (fun ⟨fnStx, argStxs⟩ => do @@ -296,7 +298,7 @@ def delabAppImplicit : Delab := whenNotPPOption getPPExplicit $ do (do fn ← getExpr; stx ← if fn.isConst then delabConst else delab; - implicitParams ← liftM $ getImplicitParams fn; + implicitParams ← liftM $ getImplicitParams fn <|> pure #[]; pure (stx, implicitParams.toList, #[])) (fun ⟨fnStx, implicitParams, argStxs⟩ => match implicitParams with | true :: implicitParams => pure (fnStx, implicitParams, argStxs) diff --git a/src/Lean/Meta/Basic.lean b/src/Lean/Meta/Basic.lean index 66022518a3..556b92ab59 100644 --- a/src/Lean/Meta/Basic.lean +++ b/src/Lean/Meta/Basic.lean @@ -803,36 +803,36 @@ private partial def lambdaMetaTelescopeAux (maxMVars? : Option Nat) def lambdaMetaTelescope (e : Expr) (maxMVars? : Option Nat := none) : m (Array Expr × Array BinderInfo × Expr) := liftMetaM $ lambdaMetaTelescopeAux maxMVars? #[] #[] 0 e -private def withNewFVar {α} (fvar fvarType : Expr) (k : Expr → MetaM α) : MetaM α := do -c? ← isClass? fvarType; +private def withNewFVar {α} (fvar fvarType : Expr) (k : Expr → MetaM α) (introduceInstances := true) : MetaM α := do +c? ← if introduceInstances then isClass? fvarType else pure none; match c? with | none => k fvar | some c => withNewLocalInstance c fvar $ k fvar -private def withLocalDeclImp {α} (n : Name) (bi : BinderInfo) (type : Expr) (k : Expr → MetaM α) : MetaM α := do +private def withLocalDeclImp {α} (n : Name) (bi : BinderInfo) (type : Expr) (k : Expr → MetaM α) (introduceInstances := true) : MetaM α := do fvarId ← mkFreshId; ctx ← read; let lctx := ctx.lctx.mkLocalDecl fvarId n type bi; let fvar := mkFVar fvarId; adaptReader (fun (ctx : Context) => { ctx with lctx := lctx }) $ - withNewFVar fvar type k + withNewFVar fvar type k introduceInstances -def withLocalDecl {α} (name : Name) (bi : BinderInfo) (type : Expr) (k : Expr → n α) : n α := -map1MetaM (fun _ k => withLocalDeclImp name bi type k) k +def withLocalDecl {α} (name : Name) (bi : BinderInfo) (type : Expr) (k : Expr → n α) (introduceInstances := true) : n α := +map1MetaM (fun _ k => withLocalDeclImp name bi type k introduceInstances) k -def withLocalDeclD {α} (name : Name) (type : Expr) (k : Expr → n α) : n α := -withLocalDecl name BinderInfo.default type k +def withLocalDeclD {α} (name : Name) (type : Expr) (k : Expr → n α) (introduceInstances := true) : n α := +withLocalDecl name BinderInfo.default type k introduceInstances -private def withLetDeclImp {α} (n : Name) (type : Expr) (val : Expr) (k : Expr → MetaM α) : MetaM α := do +private def withLetDeclImp {α} (n : Name) (type : Expr) (val : Expr) (k : Expr → MetaM α) (introduceInstances := true) : MetaM α := do fvarId ← mkFreshId; ctx ← read; let lctx := ctx.lctx.mkLetDecl fvarId n type val; let fvar := mkFVar fvarId; adaptReader (fun (ctx : Context) => { ctx with lctx := lctx }) $ - withNewFVar fvar type k + withNewFVar fvar type k introduceInstances -def withLetDecl {α} (name : Name) (type : Expr) (val : Expr) (k : Expr → n α) : n α := -map1MetaM (fun _ k => withLetDeclImp name type val k) k +def withLetDecl {α} (name : Name) (type : Expr) (val : Expr) (k : Expr → n α) (introduceInstances := true) : n α := +map1MetaM (fun _ k => withLetDeclImp name type val k introduceInstances) k private def withExistingLocalDeclsImp {α} (decls : List LocalDecl) (k : MetaM α) : MetaM α := do ctx ← read;