-
Notifications
You must be signed in to change notification settings - Fork 27
/
ExtractScript.lean
132 lines (106 loc) · 4.35 KB
/
ExtractScript.lean
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
/-
Copyright (c) 2022 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/
import Aesop.Script.UScript
import Aesop.Tracing
import Aesop.Tree.TreeM
open Lean
open Lean.Meta
open Lean.Parser.Tactic (tacticSeq)
namespace Aesop
open Script
structure ExtractScriptM.Context where
completeProof : Bool
structure ExtractScriptM.State where
script : UScript := #[]
abbrev ExtractScriptM :=
ReaderT ExtractScriptM.Context $ StateRefT ExtractScriptM.State TreeM
def ExtractScriptM.run (completeProof : Bool) (x : ExtractScriptM α) :
TreeM UScript :=
(·.2.script) <$> (ReaderT.run x { completeProof } |>.run {})
namespace ExtractScript
def lazyStepToStep (ruleName : DisplayRuleName) (lstep : LazyStep) :
MetaM Step :=
try
lstep.toStep
catch e =>
throwError "tactic script generation failed for rule {ruleName}:{indentD e.toMessageData}"
def lazyStepsToSteps (ruleName : DisplayRuleName) :
Option (Array LazyStep) → MetaM (Array Step)
| none => throwError "tactic script generation is not supported by rule {ruleName}"
| some lsteps => lsteps.mapM (lazyStepToStep ruleName)
def recordStep (step : Script.Step) : ExtractScriptM Unit := do
modify λ s => { s with script := s.script.push step }
def recordLazySteps (ruleName : DisplayRuleName)
(steps? : Option (Array Script.LazyStep)) : ExtractScriptM Unit := do
let steps ← lazyStepsToSteps ruleName steps?
modify λ s => { s with script := s.script ++ steps }
def visitGoal (g : Goal) : ExtractScriptM Unit := do
match g.normalizationState with
| .notNormal => throwError "expected goal {g.id} to be normalised"
| .normal (script := script) ..
| .provenByNormalization (script := script) .. =>
for (ruleName, script?) in script do
recordLazySteps ruleName script?
def visitRapp (r : Rapp) : ExtractScriptM Unit := do
recordLazySteps r.appliedRule.name r.scriptSteps?
-- The safe prefix can't assign mvars because any safe rule that assigns mvars
-- is downgraded to an unsafe rule. So we add `sorry` steps for all introduced
-- mvars.
if ! (← read).completeProof then
for mvarId in r.introducedMVars do
recordStep $ ← Step.mkSorry mvarId r.metaState
end ExtractScript
open ExtractScript
mutual
partial def MVarClusterRef.extractScriptCore (cref : MVarClusterRef) :
ExtractScriptM Unit := do
let c ← cref.get
let (some gref) ← c.provenGoal? | throwError
m!"the mvar cluster with goals {(← c.goals.mapM (·.get)).map (·.id)} does not contain a proven goal"
gref.extractScriptCore
partial def GoalRef.extractScriptCore (gref : GoalRef) : ExtractScriptM Unit := do
let g ← gref.get
visitGoal g
if ! g.normalizationState.isProvenByNormalization then
let (some rref) ← g.firstProvenRapp? | throwError
m!"goal {g.id} does not have a proven rapp"
rref.extractScriptCore
partial def RappRef.extractScriptCore (rref : RappRef) :
ExtractScriptM Unit := do
let r ← rref.get
visitRapp r
r.children.forM (·.extractScriptCore)
end
@[inline]
def extractScript : TreeM UScript := do
(← getRootGoal).extractScriptCore.run (completeProof := true)
mutual
partial def MVarClusterRef.extractSafePrefixScriptCore
(mref : MVarClusterRef) : ExtractScriptM Unit := do
(← mref.get).goals.forM (·.extractSafePrefixScriptCore)
partial def GoalRef.extractSafePrefixScriptCore (gref : GoalRef) :
ExtractScriptM Unit := do
let g ← gref.get
visitGoal g
if ! g.normalizationState.isProvenByNormalization then
let safeRapps ← g.safeRapps
if safeRapps.size > 1 then
throwError "aesop: internal error: goal {g.id} has {safeRapps.size} safe rapps"
if let some rref := safeRapps[0]? then
rref.extractSafePrefixScriptCore
else
let some (postNormGoal, postNormState) := g.postNormGoalAndMetaState?
| throwError "aesop: internal error at extractSafePrefixScript"
recordStep $ ← Step.mkSorry postNormGoal postNormState
partial def RappRef.extractSafePrefixScriptCore (rref : RappRef) :
ExtractScriptM Unit := do
let r ← rref.get
visitRapp r
r.forSubgoalsM (·.extractSafePrefixScriptCore)
end
def extractSafePrefixScript : TreeM UScript := do
(← getRootGoal).extractSafePrefixScriptCore.run (completeProof := false)
end Aesop