|
| 1 | +/- |
| 2 | +Copyright (c) 2026 Rémy Degenne. All rights reserved. |
| 3 | +Released under Apache 2.0 license as described in the file LICENSE. |
| 4 | +Authors: Rémy Degenne |
| 5 | +-/ |
| 6 | +module |
| 7 | + |
| 8 | +public import RandomDo.Tactic.Elab |
| 9 | + |
| 10 | +/-! |
| 11 | +# The `@[is_markov]` attribute |
| 12 | +
|
| 13 | +Writing an `rdo` program and then stating that it is a Markov kernel are two separate steps, and |
| 14 | +the second is mechanical: it is what `is_markov` does. This attribute runs it at the declaration, |
| 15 | +so a program carries its own instance: |
| 16 | +
|
| 17 | +``` |
| 18 | +@[is_markov] |
| 19 | +noncomputable def centred (c : ℝ) : Measure ℝ := rdo |
| 20 | + let x ← gaussianReal c 1 |
| 21 | + return x |
| 22 | +``` |
| 23 | +
|
| 24 | +## Why not `deriving IsMarkov` |
| 25 | +
|
| 26 | +A `deriving` clause under a `def` parses, but core commits to *delta deriving* whenever any of the |
| 27 | +named declarations is a definition (`Lean.Elab.Deriving.Basic.elabDeriving`): it unfolds the |
| 28 | +definition and infers pre-existing instances, and never consults a registered |
| 29 | +`DerivingHandler`. Delta deriving cannot run a tactic, and in any case looks for a class parameter |
| 30 | +that the fully applied `centred c : Measure ℝ` fits, which `IsMarkov`'s `γ → Measure α` is not. |
| 31 | +Supporting that spelling would mean overriding core's `deriving` command elaborator wholesale. |
| 32 | +
|
| 33 | +## Which statement is derived |
| 34 | +
|
| 35 | +A program's *last* argument is read as the kernel's parameter when it is explicit, giving |
| 36 | +`IsMarkov`. Otherwise the program denotes one fixed distribution and the statement is |
| 37 | +`IsProbabilityMeasure`. So `centred` above yields `IsMarkov centred`, while a parameterless program |
| 38 | +yields `IsProbabilityMeasure` of it, and a program whose trailing arguments are instance-implicit — |
| 39 | +`(μ : Measure ℝ) [IsProbabilityMeasure μ]` — yields `IsProbabilityMeasure` of it too, with those |
| 40 | +arguments bound. |
| 41 | +-/ |
| 42 | + |
| 43 | +public meta section |
| 44 | + |
| 45 | +open Lean Meta Elab Term MeasureTheory |
| 46 | + |
| 47 | +namespace RDo.Tactic |
| 48 | + |
| 49 | +/-- The statement to prove for `declName`, as described in the module docstring. -/ |
| 50 | +def isMarkovStatement (declName : Name) : MetaM Expr := do |
| 51 | + let info ← getConstInfo declName |
| 52 | + forallTelescope info.type fun args body ↦ do |
| 53 | + unless body.isAppOfArity ``MeasureTheory.Measure 2 do |
| 54 | + throwError "`IsMarkov` can only be derived for a declaration valued in `Measure`, but \ |
| 55 | + {declName} is valued in{indentExpr body}" |
| 56 | + let f := mkAppN (mkConst declName (info.levelParams.map .param)) args |
| 57 | + if h : 0 < args.size then |
| 58 | + let last := args[args.size - 1] |
| 59 | + if (← last.fvarId!.getDecl).binderInfo.isExplicit then |
| 60 | + return ← mkForallFVars args.pop (← mkAppM ``IsMarkov #[← mkLambdaFVars #[last] f]) |
| 61 | + mkForallFVars args (← mkAppM ``MeasureTheory.IsProbabilityMeasure #[f]) |
| 62 | + |
| 63 | +/-- Prove `isMarkovStatement declName` with the `is_markov` tactic and register it as an |
| 64 | +instance. -/ |
| 65 | +def addIsMarkovInstance (declName : Name) : TermElabM Unit := do |
| 66 | + let goal ← isMarkovStatement declName |
| 67 | + let proof ← Term.elabTerm (← `(by intros; is_markov)) (some goal) |
| 68 | + Term.synthesizeSyntheticMVarsNoPostponing |
| 69 | + let info ← getConstInfo declName |
| 70 | + let instName := declName ++ `isMarkov |
| 71 | + addDecl (.thmDecl { name := instName, levelParams := info.levelParams, type := goal, |
| 72 | + value := ← instantiateMVars proof }) |
| 73 | + Meta.addInstance instName .global 1000 |
| 74 | + |
| 75 | +/-- The `@[is_markov]` attribute. -/ |
| 76 | +initialize registerBuiltinAttribute { |
| 77 | + name := `is_markov |
| 78 | + descr := "prove that this `rdo` program is a Markov kernel, and register it as an instance" |
| 79 | + applicationTime := .afterCompilation |
| 80 | + add := fun declName _stx kind ↦ do |
| 81 | + unless kind == AttributeKind.global do |
| 82 | + throwError "`is_markov` must be a global attribute" |
| 83 | + (addIsMarkovInstance declName).run'.run' |
| 84 | +} |
| 85 | + |
| 86 | +end RDo.Tactic |
| 87 | + |
| 88 | +end |
0 commit comments