Skip to content

Commit dd0c7b0

Browse files
committed
add attribute
1 parent 0c2b643 commit dd0c7b0

2 files changed

Lines changed: 89 additions & 0 deletions

File tree

‎RandomDo.lean‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ public import RandomDo.Monad.ForInInstances
77
public import RandomDo.Monad.Instances
88
public import RandomDo.Monad.MeasurableSpace
99
public import RandomDo.Monad.Notation
10+
public import RandomDo.Tactic.Deriving
1011
public import RandomDo.Tactic.Elab
1112
public import RandomDo.Tactic.Examples
1213
public import RandomDo.Tactic.ForInStep

‎RandomDo/Tactic/Deriving.lean‎

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
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

Comments
 (0)