disabled tactics command #16

pull/43/head
Alexander Bentkamp 3 years ago
parent dd4fe60f7e
commit 51f82cf9eb

@ -193,6 +193,9 @@ entry or a tactic doc set. -/
elab "NewTactics" args:ident* : command => do
modifyCurLevel fun level => pure {level with newTactics := args.map (·.getId)}
elab "DisabledTactics" args:ident* : command => do
modifyCurLevel fun level => pure {level with disabledTactics := args.map (·.getId)}
/-! ## Lemmas -/
/-- Declare a documentation entry for some lemma.

@ -64,19 +64,33 @@ open JsonRpc
section Elab
-- TODO: use HashSetf ro `allowed`?
-- TODO: use HashSet for allowed tactics?
/-- Find all tactics in syntax object that are forbidden according to a
set `allowed` of allowed tactics. -/
partial def findForbiddenTactics (allowed: Array Name) (stx : Syntax)
(acc : Array (SourceInfo × String) := #[]) : Array (SourceInfo × String) :=
partial def findForbiddenTactics (inputCtx : Parser.InputContext) (level : GameLevel) (stx : Syntax)
: Elab.Command.CommandElabM Unit := do
match stx with
| .missing => acc
| .node info kind args => args.foldl (fun acc s => findForbiddenTactics allowed s acc) acc
| .atom info val => if isForbidden val then acc.push (info, val) else acc
| .ident info rawVal val preresolved => acc
where isForbidden (val : String) : Bool :=
0 < val.length ∧ val.data[0]!.isAlpha ∧ ¬ allowed.contains val
| .missing => return ()
| .node info kind args =>
for arg in args do
findForbiddenTactics inputCtx level arg
| .atom info val =>
-- ignore syntax elements that do not start with a letter
if 0 < val.length ∧ val.data[0]!.isAlpha then
if ¬ ((level.tactics.map (·.name.toString))).contains val then
addErrorMessage info s!"You have not unlocked the tactic '{val}' yet!"
else if level.disabledTactics.contains val then
addErrorMessage info s!"The tactic '{val}' is disabled in this level!"
| .ident info rawVal val preresolved => return ()
where addErrorMessage (info : SourceInfo) (s : MessageData) :=
modify fun st => { st with
messages := st.messages.add {
fileName := inputCtx.fileName
severity := MessageSeverity.error
pos := inputCtx.fileMap.toPosition (info.getPos?.getD 0)
data := s
}
}
open Elab Meta Expr in
def compileProof (inputCtx : Parser.InputContext) (snap : Snapshot) (hasWidgets : Bool) (couldBeEndSnap : Bool) : IO Snapshot := do
@ -114,16 +128,7 @@ def compileProof (inputCtx : Parser.InputContext) (snap : Snapshot) (hasWidgets
let level ← GameServer.getLevelByFileName inputCtx.fileName
-- Check for forbidden tactics
let forbiddenTacs := findForbiddenTactics (level.tactics.map (·.name)) tacticStx
for (info, forbiddenTac) in forbiddenTacs do
modify fun st => { st with
messages := st.messages.add {
fileName := inputCtx.fileName
severity := MessageSeverity.error
pos := inputCtx.fileMap.toPosition (info.getPos?.getD 0)
data := s!"You are not allowed to use the tactic '{forbiddenTac}'"
}
}
findForbiddenTactics inputCtx level tacticStx
-- Insert invisible `skip` command to make sure we always display the initial goal
let skip := Syntax.node (.original default 0 default endOfWhitespace) ``Lean.Parser.Tactic.skip #[]

@ -28,3 +28,4 @@ HiddenHint : 42 = 42 =>
Conclusion "Bravo! PS: `rfl` steht für \"reflexivity\"."
NewTactics rfl
DisabledTactics tauto

@ -33,3 +33,4 @@ HiddenHint (n : ) (h : 1 < n) : 1 < n =>
Conclusion ""
NewTactics assumption
DisabledTactics tauto

@ -28,3 +28,4 @@ HiddenHint (A : Prop) (hA : A) : A =>
Conclusion ""
NewTactics assumption
DisabledTactics tauto

@ -34,3 +34,4 @@ True := by
Conclusion ""
NewTactics trivial
DisabledTactics tauto

@ -22,3 +22,4 @@ Statement
Conclusion ""
NewTactics trivial
DisabledTactics tauto

@ -28,3 +28,4 @@ HiddenHint (A : Prop) (h : False) : A =>
unabhängig davon, was das Goal ist."
NewTactics contradiction
DisabledTactics tauto

@ -27,3 +27,4 @@ Conclusion
"
NewTactics contradiction
DisabledTactics tauto

@ -30,3 +30,4 @@ Conclusion
"
NewTactics contradiction
DisabledTactics tauto

@ -33,6 +33,7 @@ HiddenHint (A : Prop) (hA : A) : A =>
"Du hast einen Beweis dafür in den *Annahmen*."
NewTactics constructor assumption
DisabledTactics tauto
-- Statement
-- "Zeige $(A \\land (A \\Rightarrow B)) \\iff (A \\land B)$."

@ -34,6 +34,7 @@ HiddenHint (A : Prop) (hA : A) : A =>
"Du hast einen Beweis dafür in den *Annahmen*."
NewTactics constructor assumption
DisabledTactics tauto
-- Statement
-- "Zeige $(A \\land (A \\Rightarrow B)) \\iff (A \\land B)$."

@ -31,3 +31,4 @@ Hint (A : Prop) (B : Prop) (hA : A) : ¬ B =>
"Sackgasse. Probier's nochmals."
NewTactics left right assumption
DisabledTactics tauto

@ -45,3 +45,4 @@ Hint (A : Prop) (B : Prop) (h : A ∧ B) : A =>
"Jetzt noch das UND in den Annahmen mit `rcases h with ⟨h₁, h₂⟩` zerlegen."
NewTactics assumption rcases
DisabledTactics tauto

@ -123,3 +123,4 @@ HiddenHint (A : Prop) (B : Prop) : A B =>
"`left` oder `right`?"
NewTactics left right assumption constructor rcases rfl contradiction trivial
DisabledTactics tauto

Loading…
Cancel
Save