feat: delaborator: tolerate ill-typed terms (such as IR)

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)

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;