@@ -388,6 +388,20 @@ where
388388 let finalR := addInfo s! "{ var} is irrelevant (unused)" id r
389389 pure $ imp (· $ Classical.ofNonempty) finalR (PSum.inr $ λ x _ => x)
390390
391+ instance (priority := 2000 ) subtypeVarTestable {p : α → Prop } {β : α → Prop }
392+ [∀ x, PrintableProp (p x)]
393+ [∀ x, Testable (β x)]
394+ [SampleableExt (Subtype p)] {var'} :
395+ Testable (NamedBinder var $ Π x : α, NamedBinder var' $ p x → β x) where
396+ run cfg min :=
397+ letI (x : Subtype p) : Testable (β x) :=
398+ { run := fun cfg min => do
399+ let r ← Testable.runProp (β x.val) cfg min
400+ pure $ addInfo s! "guard: { printProp (p x)} (by construction)" id r (PSum.inr id) }
401+ do
402+ let r ← @Testable.run (∀ x : Subtype p, β x.val) (@varTestable var _ _ _ _) cfg min
403+ pure $ iff Subtype.forall' r
404+
391405instance (priority := low) decidableTestable {p : Prop } [PrintableProp p] [Decidable p] :
392406 Testable p where
393407 run := λ _ _ =>
@@ -493,16 +507,18 @@ open Lean
493507
494508/-- Traverse the syntax of a proposition to find universal quantifiers
495509quantifiers and add `NamedBinder` annotations next to them. -/
496- partial def addDecorations (e : Expr) : Expr :=
497- e.replace $ λ expr =>
498- match expr with
499- | Expr.forallE name type body data =>
510+ partial def addDecorations (e : Expr) : MetaM Expr :=
511+ Meta.transform e $ fun expr => do
512+ if not (← Meta.inferType e).isProp then
513+ return .continue
514+ else if let Expr.forallE name type body data := expr then
500515 let n := name.toString
501- let newType := addDecorations type
502- let newBody := addDecorations body
516+ let newType ← addDecorations type
517+ let newBody ← addDecorations body
503518 let rest := Expr.forallE name newType newBody data
504- some $ mkApp2 (mkConst `SlimCheck.NamedBinder) (mkStrLit n) rest
505- | _ => none
519+ return .done $ (← Meta.mkAppM `SlimCheck.NamedBinder #[mkStrLit n, rest])
520+ else
521+ return .continue
506522
507523/-- `DecorationsOf p` is used as a hint to `mk_decorations` to specify
508524that the goal should be satisfied with a proposition equivalent to `p`
@@ -527,7 +543,7 @@ scoped elab "mk_decorations" : tactic => do
527543 let goal ← getMainGoal
528544 let goalType ← goal.getType
529545 if let .app (.const ``Decorations.DecorationsOf _) body := goalType then
530- closeMainGoal (addDecorations body)
546+ closeMainGoal (← addDecorations body)
531547
532548end Decorations
533549
0 commit comments