|
|
|
|
@ -1,289 +0,0 @@
|
|
|
|
|
/-
|
|
|
|
|
This is the Lean 4 game server. It offers a way to interact with Lean 4 which
|
|
|
|
|
is completely distinct from running the command-line lean or the language server protocol.
|
|
|
|
|
|
|
|
|
|
It is based on lean-gym by Daniel Selsam.
|
|
|
|
|
-/
|
|
|
|
|
import Lean.Data.Json.Basic
|
|
|
|
|
|
|
|
|
|
import GameServer.Utils
|
|
|
|
|
import GameServer.EnvExtensions
|
|
|
|
|
import GameServer.Communication
|
|
|
|
|
|
|
|
|
|
open Lean Meta Elab Tactic Std
|
|
|
|
|
|
|
|
|
|
/-- Convert format to string without line breaks -/
|
|
|
|
|
def Std.Format.oneline : Format → String
|
|
|
|
|
| .nil => ""
|
|
|
|
|
| .line => ""
|
|
|
|
|
| .text s => s
|
|
|
|
|
| .nest _ f => f.oneline
|
|
|
|
|
| .append f g => f.oneline ++ g.oneline
|
|
|
|
|
| .group f _ => f.oneline
|
|
|
|
|
| .tag _ f => f.oneline
|
|
|
|
|
|
|
|
|
|
/-- Convert JSON to string without line breaks -/
|
|
|
|
|
instance instToStringJsonOneLine : ToString Json := ⟨fun o => o.render.oneline⟩
|
|
|
|
|
attribute [-instance] Lean.Json.instToStringJson
|
|
|
|
|
|
|
|
|
|
/-! ## GameGoal -/
|
|
|
|
|
structure GameGoal where
|
|
|
|
|
objects : List LocalDecl
|
|
|
|
|
assumptions : List LocalDecl
|
|
|
|
|
goal : String
|
|
|
|
|
mvarid : MVarId
|
|
|
|
|
|
|
|
|
|
def Lean.MVarId.toGameGoal (goal : MVarId) : MetaM GameGoal := do
|
|
|
|
|
match (← getMCtx).findDecl? goal with
|
|
|
|
|
| none => throwError "unknown goal"
|
|
|
|
|
| some mvarDecl => do
|
|
|
|
|
-- toGameGoalAux below will sort local declarations from the context of goal into data and assumptions,
|
|
|
|
|
-- discarding auxilliary declarations
|
|
|
|
|
let rec toGameGoalAux : List (Option LocalDecl) → MetaM (List LocalDecl × List LocalDecl)
|
|
|
|
|
| (some decl)::t => withLCtx mvarDecl.lctx mvarDecl.localInstances do
|
|
|
|
|
let (o, a) ← toGameGoalAux t
|
|
|
|
|
if decl.isAuxDecl then
|
|
|
|
|
return (o, a)
|
|
|
|
|
if (← inferType decl.type).isProp then
|
|
|
|
|
return (o, decl::a)
|
|
|
|
|
else
|
|
|
|
|
return (decl::o, a)
|
|
|
|
|
| none:: t => toGameGoalAux t
|
|
|
|
|
| [] => return ([], [])
|
|
|
|
|
withLCtx mvarDecl.lctx mvarDecl.localInstances do
|
|
|
|
|
let (objects, assumptions) ← toGameGoalAux mvarDecl.lctx.decls.toList
|
|
|
|
|
return {objects := objects, assumptions := assumptions, goal := toString (← Meta.ppExpr mvarDecl.type),
|
|
|
|
|
mvarid := goal }
|
|
|
|
|
|
|
|
|
|
def GameGoal.toJson (gameGoal : GameGoal) : MetaM Json :=
|
|
|
|
|
gameGoal.mvarid.withContext do
|
|
|
|
|
return Json.mkObj [("objects", Lean.ToJson.toJson (← gameGoal.objects.mapM Lean.LocalDecl.toJson)),
|
|
|
|
|
("assumptions", Lean.ToJson.toJson (← gameGoal.assumptions.mapM Lean.LocalDecl.toJson)),
|
|
|
|
|
("goal", gameGoal.goal)]
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/-! ## Action -/
|
|
|
|
|
|
|
|
|
|
inductive Action where
|
|
|
|
|
| info : Action
|
|
|
|
|
| loadLevel : Nat → Action
|
|
|
|
|
| runTactic : String → Action
|
|
|
|
|
| undo : Action
|
|
|
|
|
| restartGame : Action
|
|
|
|
|
| restartLevel : Action
|
|
|
|
|
| quit : Action
|
|
|
|
|
| next : Action
|
|
|
|
|
| prev : Action
|
|
|
|
|
| invalid : String → Action -- Used for broken Json parsing
|
|
|
|
|
deriving ToJson, FromJson, Repr
|
|
|
|
|
|
|
|
|
|
def Action.parse (s : String) : Action :=
|
|
|
|
|
let e : Except String Action :=
|
|
|
|
|
try
|
|
|
|
|
return ← fromJson? (← Json.parse s)
|
|
|
|
|
catch _ => return Action.invalid s
|
|
|
|
|
match e with
|
|
|
|
|
| Except.ok a => a
|
|
|
|
|
| _ => Action.info
|
|
|
|
|
|
|
|
|
|
def Action.get : IO Action :=
|
|
|
|
|
return Action.parse (← (← IO.getStdin).getLine)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/-! ## LevelInfo -/
|
|
|
|
|
|
|
|
|
|
structure LevelInfo extends GameLevel where
|
|
|
|
|
goals : List GameGoal := []
|
|
|
|
|
errors : Array String := #[]
|
|
|
|
|
message : String := ""
|
|
|
|
|
|
|
|
|
|
def LevelInfo.toJson (info : LevelInfo) : MetaM Json :=
|
|
|
|
|
return Json.mkObj [("index", Lean.ToJson.toJson info.index),
|
|
|
|
|
("title", Lean.ToJson.toJson info.title),
|
|
|
|
|
("tactics", Lean.ToJson.toJson info.tactics),
|
|
|
|
|
("lemmas", Lean.ToJson.toJson info.lemmas),
|
|
|
|
|
("errors", Lean.ToJson.toJson info.errors),
|
|
|
|
|
("goals", Lean.ToJson.toJson (← info.goals.mapM (·.toJson))),
|
|
|
|
|
("message", info.message)]
|
|
|
|
|
|
|
|
|
|
namespace Server
|
|
|
|
|
|
|
|
|
|
/-! ## LevelM and Response -/
|
|
|
|
|
|
|
|
|
|
structure SavedState where
|
|
|
|
|
tacticState : Tactic.SavedState
|
|
|
|
|
message : String := ""
|
|
|
|
|
|
|
|
|
|
abbrev LevelM := ReaderT GameLevel StateRefT (Array SavedState) TermElabM
|
|
|
|
|
|
|
|
|
|
/-- Returns the most recent SavedState. -/
|
|
|
|
|
def getState : LevelM SavedState := do
|
|
|
|
|
let some state := (← get).back? | throwError "Couldn't find tactic state"
|
|
|
|
|
return state
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
structure Response : Type where
|
|
|
|
|
goals : List GameGoal := []
|
|
|
|
|
errors : Array String := #[]
|
|
|
|
|
message : String := ""
|
|
|
|
|
|
|
|
|
|
def Response.toJson (resp : Response) : MetaM Json :=
|
|
|
|
|
return Json.mkObj [("errors", Lean.ToJson.toJson resp.errors),
|
|
|
|
|
("goals", Lean.ToJson.toJson (← resp.goals.mapM (·.toJson))),
|
|
|
|
|
("message", resp.message)]
|
|
|
|
|
|
|
|
|
|
/-! ## Main running functions -/
|
|
|
|
|
|
|
|
|
|
/-- Dummy `Core.Context` value to be fed to `Lean.Core.CoreM.toIO` -/
|
|
|
|
|
def coreCtx : Core.Context := {
|
|
|
|
|
currNamespace := Name.anonymous,
|
|
|
|
|
openDecls := [],
|
|
|
|
|
fileName := "<Game>",
|
|
|
|
|
fileMap := { source := "", positions := #[0], lines := #[1] } }
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
structure RunTacticParams where
|
|
|
|
|
tactic : String
|
|
|
|
|
deriving FromJson
|
|
|
|
|
|
|
|
|
|
structure LoadLevelParams where
|
|
|
|
|
number : Nat
|
|
|
|
|
deriving FromJson
|
|
|
|
|
|
|
|
|
|
partial def runLevel (requestId : JsonRpc.RequestID) (env : Environment) (GameName : Name) (levels : HashMap Nat GameLevel) (idx : Nat) : IO Unit := do
|
|
|
|
|
let levelName : Name := s!"Level{toString idx}"
|
|
|
|
|
let termElabM : TermElabM Unit := do
|
|
|
|
|
let some lvl := levels.find? idx | throwError s!"Cannot find level {idx}"
|
|
|
|
|
let mvar ← mkFreshExprMVar (some lvl.goal) (kind := MetavarKind.synthetic)
|
|
|
|
|
let (_, mvar) ← mvar.mvarId!.introNP lvl.intro_nb
|
|
|
|
|
mvar.withContext do
|
|
|
|
|
let state := #[{tacticState := { term := ← Term.saveState, tactic := { goals := [mvar] }}}]
|
|
|
|
|
let levelM : LevelM Unit := do
|
|
|
|
|
let resp := {← mkResponse with message := lvl.introduction}
|
|
|
|
|
let levelInfo : LevelInfo :=
|
|
|
|
|
{ index := lvl.index,
|
|
|
|
|
title := lvl.title,
|
|
|
|
|
tactics := lvl.tactics,
|
|
|
|
|
lemmas := lvl.lemmas,
|
|
|
|
|
errors := resp.errors,
|
|
|
|
|
goals := resp.goals,
|
|
|
|
|
message := resp.message }
|
|
|
|
|
let hOut ← IO.getStdout
|
|
|
|
|
hOut.writeGspResponse ⟨requestId, ← levelInfo.toJson⟩
|
|
|
|
|
mainLoop
|
|
|
|
|
levelM.run lvl |>.run' state
|
|
|
|
|
let metaM : MetaM Unit := termElabM.run' (ctx := {})
|
|
|
|
|
try
|
|
|
|
|
discard <| metaM.run'.toIO coreCtx { env := env }
|
|
|
|
|
catch
|
|
|
|
|
| .userError s => output s!"Could not run level {idx}: {s}"
|
|
|
|
|
| _ => output s!"Could not run level {idx}"
|
|
|
|
|
|
|
|
|
|
where
|
|
|
|
|
|
|
|
|
|
mkResponse (errors : Array String := #[]) : LevelM Response := do
|
|
|
|
|
let savedState ← getState
|
|
|
|
|
let goals := savedState.tacticState.tactic.goals
|
|
|
|
|
return { goals := (← liftM $ goals.mapM Lean.MVarId.toGameGoal), message := savedState.message, errors := errors }
|
|
|
|
|
|
|
|
|
|
/-- Try to parse the given String as a single line tactic invocation. Update the LevelM state only
|
|
|
|
|
if the tactic succeeds. Always return a Response object which contains information about the current
|
|
|
|
|
state with a message and errors if any. -/
|
|
|
|
|
runTactic (tacticString : String) : LevelM Response := do
|
|
|
|
|
let lvl ← read
|
|
|
|
|
let tacticNames := (lvl.tactics.map (·.name.toString)).toList
|
|
|
|
|
let tacName := (tacticString.trim.splitOn " ").headD ""
|
|
|
|
|
if not (tacticNames.contains tacName) then mkResponse #["Unrecognized tactic"] else
|
|
|
|
|
let savedState ← getState
|
|
|
|
|
match Parser.runParserCategory (← getEnv) `tactic tacticString "<stdin>" with
|
|
|
|
|
| Except.error err => mkResponse #[err]
|
|
|
|
|
| Except.ok stx => do
|
|
|
|
|
savedState.tacticState.term.restore
|
|
|
|
|
let mvarId : MVarId := savedState.tacticState.tactic.goals.head!
|
|
|
|
|
try
|
|
|
|
|
let unsolvedGoals ← Tactic.run mvarId do set savedState.tacticState.tactic
|
|
|
|
|
evalTactic stx
|
|
|
|
|
if (← getThe Core.State).messages.hasErrors then
|
|
|
|
|
let messages := (← getThe Core.State).messages.getErrorMessages.toList.toArray
|
|
|
|
|
mkResponse (← (messages.map Message.data).mapM fun md => md.toString)
|
|
|
|
|
else
|
|
|
|
|
let savedState : Tactic.SavedState := { term := (← Term.saveState), tactic := { goals := unsolvedGoals}}
|
|
|
|
|
let mut message := ""
|
|
|
|
|
match unsolvedGoals with
|
|
|
|
|
| goal::_ => do
|
|
|
|
|
let normalized_tgt ← normalizedRevertExpr goal
|
|
|
|
|
for msg in lvl.messages do
|
|
|
|
|
if ← isDefEq normalized_tgt msg.normalized_goal then
|
|
|
|
|
message := msg.message
|
|
|
|
|
break
|
|
|
|
|
| [] => pure ()
|
|
|
|
|
if unsolvedGoals matches [] then
|
|
|
|
|
message := (← read).conclusion
|
|
|
|
|
modify fun s => s.push {tacticState := savedState, message := message}
|
|
|
|
|
mkResponse
|
|
|
|
|
catch ex => mkResponse #[← ex.toMessageData.toString]
|
|
|
|
|
|
|
|
|
|
mainLoop : LevelM Unit := do
|
|
|
|
|
let hIn ← IO.getStdin
|
|
|
|
|
let hOut ← IO.getStdout
|
|
|
|
|
let hLog ← IO.getStderr
|
|
|
|
|
let m ← hIn.readGspMessage
|
|
|
|
|
match m with
|
|
|
|
|
| .request id "runTactic" params => do
|
|
|
|
|
match fromJson? (toJson (params)) with
|
|
|
|
|
| Except.ok (v : RunTacticParams) =>
|
|
|
|
|
let resp ← runTactic v.tactic
|
|
|
|
|
hOut.writeGspResponse ⟨id, ← resp.toJson⟩
|
|
|
|
|
| Except.error inner =>
|
|
|
|
|
hLog.putStr s!"Invalid params: {inner}"
|
|
|
|
|
hLog.flush
|
|
|
|
|
| .request id "loadLevel" (some params) =>
|
|
|
|
|
match fromJson? (toJson (params)) with
|
|
|
|
|
| Except.ok (v : LoadLevelParams) =>
|
|
|
|
|
runLevel id env GameName levels v.number
|
|
|
|
|
| Except.error inner =>
|
|
|
|
|
hLog.putStr s!"Invalid params: {inner}"
|
|
|
|
|
hLog.flush
|
|
|
|
|
| .request id "undo" _ => do
|
|
|
|
|
modify fun s => s.pop
|
|
|
|
|
hOut.writeGspResponse ⟨id, ← (← mkResponse).toJson⟩
|
|
|
|
|
| _ =>
|
|
|
|
|
hLog.putStr s!"Invalid action: {toJson m}"
|
|
|
|
|
hLog.flush
|
|
|
|
|
mainLoop
|
|
|
|
|
|
|
|
|
|
open System Lean Std in
|
|
|
|
|
partial def runGame (GameName : Name) : IO Unit := do
|
|
|
|
|
let env ← importModules [{ module := `Init : Import }, { module := GameName : Import }] {} 0
|
|
|
|
|
let termElabM : TermElabM Unit := do
|
|
|
|
|
let levels := levelsExt.getState env
|
|
|
|
|
let game := {← gameExt.get with nb_levels := levels.size }
|
|
|
|
|
mainLoop env game levels
|
|
|
|
|
let metaM : MetaM Unit := termElabM.run' (ctx := {})
|
|
|
|
|
discard <| metaM.run'.toIO coreCtx { env := env }
|
|
|
|
|
where
|
|
|
|
|
mainLoop (env : Environment) (game : Game) (levels : HashMap Nat GameLevel): IO Unit := do
|
|
|
|
|
let hIn ← IO.getStdin
|
|
|
|
|
let hOut ← IO.getStdout
|
|
|
|
|
let hLog ← IO.getStderr
|
|
|
|
|
let m ← hIn.readGspMessage
|
|
|
|
|
match m with
|
|
|
|
|
| .request id "info" params =>
|
|
|
|
|
hOut.writeGspResponse ⟨id, game⟩
|
|
|
|
|
| .request id "loadLevel" (some params) =>
|
|
|
|
|
match fromJson? (toJson (params)) with
|
|
|
|
|
| Except.ok (v : LoadLevelParams) =>
|
|
|
|
|
runLevel id env GameName levels v.number
|
|
|
|
|
| Except.error inner =>
|
|
|
|
|
hLog.putStr s!"Invalid params: {inner}"
|
|
|
|
|
hLog.flush
|
|
|
|
|
| .request id m _ =>
|
|
|
|
|
hOut.writeGspResponseError
|
|
|
|
|
⟨id, JsonRpc.ErrorCode.methodNotFound, s!"Method not found: {m}", none⟩
|
|
|
|
|
| _ =>
|
|
|
|
|
hLog.putStr s!"Invalid action: {toJson m}"
|
|
|
|
|
hLog.flush
|
|
|
|
|
|
|
|
|
|
mainLoop env game levels
|
|
|
|
|
|
|
|
|
|
end Server
|
Alexander Bentkamp
2 years ago