disabled tactics command #16
This commit is contained in:
@@ -193,6 +193,9 @@ entry or a tactic doc set. -/
|
|||||||
elab "NewTactics" args:ident* : command => do
|
elab "NewTactics" args:ident* : command => do
|
||||||
modifyCurLevel fun level => pure {level with newTactics := args.map (·.getId)}
|
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 -/
|
/-! ## Lemmas -/
|
||||||
|
|
||||||
/-- Declare a documentation entry for some lemma.
|
/-- Declare a documentation entry for some lemma.
|
||||||
|
|||||||
@@ -64,19 +64,33 @@ open JsonRpc
|
|||||||
|
|
||||||
section Elab
|
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
|
/-- Find all tactics in syntax object that are forbidden according to a
|
||||||
set `allowed` of allowed tactics. -/
|
set `allowed` of allowed tactics. -/
|
||||||
partial def findForbiddenTactics (allowed: Array Name) (stx : Syntax)
|
partial def findForbiddenTactics (inputCtx : Parser.InputContext) (level : GameLevel) (stx : Syntax)
|
||||||
(acc : Array (SourceInfo × String) := #[]) : Array (SourceInfo × String) :=
|
: Elab.Command.CommandElabM Unit := do
|
||||||
match stx with
|
match stx with
|
||||||
| .missing => acc
|
| .missing => return ()
|
||||||
| .node info kind args => args.foldl (fun acc s => findForbiddenTactics allowed s acc) acc
|
| .node info kind args =>
|
||||||
| .atom info val => if isForbidden val then acc.push (info, val) else acc
|
for arg in args do
|
||||||
| .ident info rawVal val preresolved => acc
|
findForbiddenTactics inputCtx level arg
|
||||||
where isForbidden (val : String) : Bool :=
|
| .atom info val =>
|
||||||
0 < val.length ∧ val.data[0]!.isAlpha ∧ ¬ allowed.contains 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
|
open Elab Meta Expr in
|
||||||
def compileProof (inputCtx : Parser.InputContext) (snap : Snapshot) (hasWidgets : Bool) (couldBeEndSnap : Bool) : IO Snapshot := do
|
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
|
let level ← GameServer.getLevelByFileName inputCtx.fileName
|
||||||
|
|
||||||
-- Check for forbidden tactics
|
-- Check for forbidden tactics
|
||||||
let forbiddenTacs := findForbiddenTactics (level.tactics.map (·.name)) tacticStx
|
findForbiddenTactics inputCtx level 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}'"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
-- Insert invisible `skip` command to make sure we always display the initial goal
|
-- 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 #[]
|
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\"."
|
Conclusion "Bravo! PS: `rfl` steht für \"reflexivity\"."
|
||||||
|
|
||||||
NewTactics rfl
|
NewTactics rfl
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -33,3 +33,4 @@ HiddenHint (n : ℕ) (h : 1 < n) : 1 < n =>
|
|||||||
Conclusion ""
|
Conclusion ""
|
||||||
|
|
||||||
NewTactics assumption
|
NewTactics assumption
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -28,3 +28,4 @@ HiddenHint (A : Prop) (hA : A) : A =>
|
|||||||
Conclusion ""
|
Conclusion ""
|
||||||
|
|
||||||
NewTactics assumption
|
NewTactics assumption
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -34,3 +34,4 @@ True := by
|
|||||||
Conclusion ""
|
Conclusion ""
|
||||||
|
|
||||||
NewTactics trivial
|
NewTactics trivial
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -22,3 +22,4 @@ Statement
|
|||||||
Conclusion ""
|
Conclusion ""
|
||||||
|
|
||||||
NewTactics trivial
|
NewTactics trivial
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -28,3 +28,4 @@ HiddenHint (A : Prop) (h : False) : A =>
|
|||||||
unabhängig davon, was das Goal ist."
|
unabhängig davon, was das Goal ist."
|
||||||
|
|
||||||
NewTactics contradiction
|
NewTactics contradiction
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -27,3 +27,4 @@ Conclusion
|
|||||||
"
|
"
|
||||||
|
|
||||||
NewTactics contradiction
|
NewTactics contradiction
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -30,3 +30,4 @@ Conclusion
|
|||||||
"
|
"
|
||||||
|
|
||||||
NewTactics contradiction
|
NewTactics contradiction
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -33,6 +33,7 @@ HiddenHint (A : Prop) (hA : A) : A =>
|
|||||||
"Du hast einen Beweis dafür in den *Annahmen*."
|
"Du hast einen Beweis dafür in den *Annahmen*."
|
||||||
|
|
||||||
NewTactics constructor assumption
|
NewTactics constructor assumption
|
||||||
|
DisabledTactics tauto
|
||||||
|
|
||||||
-- Statement
|
-- Statement
|
||||||
-- "Zeige $(A \\land (A \\Rightarrow B)) \\iff (A \\land B)$."
|
-- "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*."
|
"Du hast einen Beweis dafür in den *Annahmen*."
|
||||||
|
|
||||||
NewTactics constructor assumption
|
NewTactics constructor assumption
|
||||||
|
DisabledTactics tauto
|
||||||
|
|
||||||
-- Statement
|
-- Statement
|
||||||
-- "Zeige $(A \\land (A \\Rightarrow B)) \\iff (A \\land B)$."
|
-- "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."
|
"Sackgasse. Probier's nochmals."
|
||||||
|
|
||||||
NewTactics left right assumption
|
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."
|
"Jetzt noch das UND in den Annahmen mit `rcases h with ⟨h₁, h₂⟩` zerlegen."
|
||||||
|
|
||||||
NewTactics assumption rcases
|
NewTactics assumption rcases
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
@@ -123,3 +123,4 @@ HiddenHint (A : Prop) (B : Prop) : A ∨ B =>
|
|||||||
"`left` oder `right`?"
|
"`left` oder `right`?"
|
||||||
|
|
||||||
NewTactics left right assumption constructor rcases rfl contradiction trivial
|
NewTactics left right assumption constructor rcases rfl contradiction trivial
|
||||||
|
DisabledTactics tauto
|
||||||
|
|||||||
Reference in New Issue
Block a user