cleanup code surrounding hints
Jon Eugster
1 year ago
parent
2649f985fa
commit
8008b68fd6
@ -0,0 +1,106 @@
|
|||||||
|
import GameServer.AbstractCtx
|
||||||
|
|
||||||
|
/-!
|
||||||
|
This file contains anything related to the `Hint` tactic used to add hints to a game level.
|
||||||
|
-/
|
||||||
|
|
||||||
|
open Lean Meta Elab
|
||||||
|
|
||||||
|
namespace GameServer
|
||||||
|
|
||||||
|
syntax hintArg := atomic(" (" (&"strict" <|> &"hidden") " := " withoutPosition(term) ")")
|
||||||
|
|
||||||
|
/-- A hint to help the user with a specific goal state -/
|
||||||
|
structure GoalHintEntry where
|
||||||
|
goal : AbstractCtxResult
|
||||||
|
/-- Text of the hint as an expression of type `Array Expr → MessageData` -/
|
||||||
|
text : Expr
|
||||||
|
rawText : String
|
||||||
|
/-- If true, then hint should be hidden and only be shown on player's request -/
|
||||||
|
hidden : Bool := false
|
||||||
|
/-- If true, then the goal must contain only the assumptions specified in `goal` and no others -/
|
||||||
|
strict : Bool := false
|
||||||
|
|
||||||
|
instance : Repr GoalHintEntry := {
|
||||||
|
reprPrec := fun a n => reprPrec a.text n
|
||||||
|
}
|
||||||
|
|
||||||
|
/-- For a hint `(hint : GoalHintEntry)` one uses `(← evalHintMessage hint.text) x`
|
||||||
|
where `(x : Array Expr)` contains the names of all the variables that should be inserted
|
||||||
|
in the text.
|
||||||
|
|
||||||
|
TODO: explain better. -/
|
||||||
|
unsafe def evalHintMessageUnsafe : Expr → MetaM (Array Expr → MessageData) :=
|
||||||
|
evalExpr (Array Expr → MessageData)
|
||||||
|
(.forallE default (mkApp (mkConst ``Array [levelZero]) (mkConst ``Expr))
|
||||||
|
(mkConst ``MessageData) .default)
|
||||||
|
|
||||||
|
@[implemented_by evalHintMessageUnsafe]
|
||||||
|
def evalHintMessage : Expr → MetaM (Array Expr → MessageData) := fun _ => pure (fun _ => "")
|
||||||
|
|
||||||
|
/-- Remove any spaces at the beginning of a new line -/
|
||||||
|
partial def removeIndentation (s : String) : String :=
|
||||||
|
let rec loop (i : String.Pos) (acc : String) (removeSpaces := false) : String :=
|
||||||
|
let c := s.get i
|
||||||
|
let i := s.next i
|
||||||
|
if s.atEnd i then
|
||||||
|
acc.push c
|
||||||
|
else if removeSpaces && c == ' ' then
|
||||||
|
loop i acc (removeSpaces := true)
|
||||||
|
else if c == '\n' then
|
||||||
|
loop i (acc.push c) (removeSpaces := true)
|
||||||
|
else
|
||||||
|
loop i (acc.push c)
|
||||||
|
loop ⟨0⟩ ""
|
||||||
|
|
||||||
|
/-- A tactic that can be used inside `Statement`s to indicate in which proof states players should
|
||||||
|
see hints. The tactic does not affect the goal state.
|
||||||
|
-/
|
||||||
|
elab (name := GameServer.Tactic.Hint) "Hint" args:hintArg* msg:interpolatedStr(term) : tactic => do
|
||||||
|
let mut strict := false
|
||||||
|
let mut hidden := false
|
||||||
|
|
||||||
|
-- remove spaces at the beginning of new lines
|
||||||
|
let msg := TSyntax.mk $ msg.raw.setArgs $ ← msg.raw.getArgs.mapM fun m => do
|
||||||
|
match m with
|
||||||
|
| Syntax.node info k args =>
|
||||||
|
if k == interpolatedStrLitKind && args.size == 1 then
|
||||||
|
match args.get! 0 with
|
||||||
|
| (Syntax.atom info' val) =>
|
||||||
|
let val := removeIndentation val
|
||||||
|
return Syntax.node info k #[Syntax.atom info' val]
|
||||||
|
| _ => return m
|
||||||
|
else
|
||||||
|
return m
|
||||||
|
| _ => return m
|
||||||
|
|
||||||
|
for arg in args do
|
||||||
|
match arg with
|
||||||
|
| `(hintArg| (strict := true)) => strict := true
|
||||||
|
| `(hintArg| (strict := false)) => strict := false
|
||||||
|
| `(hintArg| (hidden := true)) => hidden := true
|
||||||
|
| `(hintArg| (hidden := false)) => hidden := false
|
||||||
|
| _ => throwUnsupportedSyntax
|
||||||
|
|
||||||
|
let goal ← Tactic.getMainGoal
|
||||||
|
goal.withContext do
|
||||||
|
-- We construct an expression that can produce the hint text. The difficulty is that we
|
||||||
|
-- want the text to possibly contain quotation of the local variables which might have been
|
||||||
|
-- named differently by the player.
|
||||||
|
let varsName := `vars
|
||||||
|
let text ← withLocalDeclD varsName (mkApp (mkConst ``Array [levelZero]) (mkConst ``Expr)) fun vars => do
|
||||||
|
let mut text ← `(m! $msg)
|
||||||
|
let goalDecl ← goal.getDecl
|
||||||
|
let decls := goalDecl.lctx.decls.toArray.filterMap id
|
||||||
|
for i in [:decls.size] do
|
||||||
|
text ← `(let $(mkIdent decls[i]!.userName) := $(mkIdent varsName)[$(quote i)]!; $text)
|
||||||
|
return ← mkLambdaFVars #[vars] $ ← Term.elabTermAndSynthesize text none
|
||||||
|
let textmvar ← mkFreshExprMVar none
|
||||||
|
guard $ ← isDefEq textmvar text -- Store the text in a mvar.
|
||||||
|
-- The information about the hint is logged as a message using `logInfo` to transfer it to the
|
||||||
|
-- `Statement` command:
|
||||||
|
logInfo $
|
||||||
|
.tagged `Hint $
|
||||||
|
.nest (if strict then 1 else 0) $
|
||||||
|
.nest (if hidden then 1 else 0) $
|
||||||
|
.compose (.ofGoal textmvar.mvarId!) (.ofGoal goal)
|
||||||
Loading…
Reference in New Issue