disabled tactics command #16

2023-02-06 14:59:41 +01:00
parent dd4fe60f7e
commit 51f82cf9eb
15 changed files with 41 additions and 20 deletions
@@ -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