-
Notifications
You must be signed in to change notification settings - Fork 24
/
ExtractScript.lean
66 lines (57 loc) · 2.48 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
/-
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.Tracing
import Aesop.Tree.TreeM
open Lean
open Lean.Meta
open Lean.Parser.Tactic (tacticSeq)
namespace Aesop
abbrev ExtractScriptM := StateRefT UnstructuredScript TreeM
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
match g.normalizationState with
| .notNormal => throwError "expected goal {g.id} to be normalised"
| .provenByNormalization _ normScript? =>
modify (· ++ (← getNormScript g.id normScript?))
| .normal postGoal postState normScript? =>
modify (· ++ (← getNormScript g.id normScript?))
let (some rref) ← g.firstProvenRapp? | throwError
m!"goal {g.id} does not have a proven rapp"
rref.extractScriptCore postGoal postState
where
@[inline, always_inline]
getNormScript (gid : GoalId) :
Except DisplayRuleName UnstructuredScript → ExtractScriptM UnstructuredScript
| .ok script => pure script
| .error rule => throwError "normalization rule {rule} (at goal {gid}) does not support tactic script generation"
partial def RappRef.extractScriptCore (rref : RappRef) (preGoal : MVarId)
(preState : Meta.SavedState) : ExtractScriptM Unit := do
let r ← rref.get
let postState := r.metaState
let (some scriptBuilder) := r.scriptBuilder?
| throwError "rule {r.appliedRule.name} (at rapp {r.id}) does not support tactic script generation"
let tacticSeq ←
try
postState.runMetaM' scriptBuilder.unstructured.run
catch e =>
throwError "script builder for rapp {r.id} reported error:{indentD $ e.toMessageData}"
let postGoals ← postState.runMetaM' do
r.originalSubgoals.mapM λ g => return ⟨g, ← g.getMVarDependencies⟩
modify λ s => s.push { postState, tacticSeq, preGoal, postGoals, preState }
r.children.forM (·.extractScriptCore)
end
@[inline]
def MVarClusterRef.extractScript (cref : MVarClusterRef) :
TreeM UnstructuredScript :=
(·.snd) <$> cref.extractScriptCore.run #[]
end Aesop