|
|
|
|
@ -1,11 +1,8 @@
|
|
|
|
|
import GameServer.HashMapExtension
|
|
|
|
|
import GameServer.SingleValPersistentEnvExtension
|
|
|
|
|
|
|
|
|
|
import Lean
|
|
|
|
|
/-! # Environment extensions
|
|
|
|
|
|
|
|
|
|
The game framework stores almost all its game building data in environment extensions
|
|
|
|
|
defined in this file. MAyn of them are `SimplePersistentEnvExtension` but we also
|
|
|
|
|
use `HashMapExtension` and `SingleValPersistentEnvExtension`
|
|
|
|
|
defined in this file.
|
|
|
|
|
-/
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -103,31 +100,80 @@ elab "#print_lemma_set" : command => do
|
|
|
|
|
for entry in lemmaSetExt.getState (← getEnv) do
|
|
|
|
|
dbg_trace "{entry.name} : {entry.lemmas.map LemmaDocEntry.name}"
|
|
|
|
|
|
|
|
|
|
/-! ## Game -/
|
|
|
|
|
/-! ## Graph -/
|
|
|
|
|
|
|
|
|
|
structure Game where
|
|
|
|
|
name : Name
|
|
|
|
|
title : String := ""
|
|
|
|
|
introduction : String := ""
|
|
|
|
|
conclusion : String := ""
|
|
|
|
|
authors : List String := []
|
|
|
|
|
nb_levels : Nat := 0
|
|
|
|
|
deriving Repr, Inhabited, ToJson
|
|
|
|
|
structure Graph (α β : Type) [inst : BEq α] [inst : Hashable α] where
|
|
|
|
|
nodes: HashMap α β := {}
|
|
|
|
|
edges: Array (α × α) := {}
|
|
|
|
|
deriving Inhabited
|
|
|
|
|
|
|
|
|
|
initialize gameExt : SingleValPersistentEnvExtension Game ← registerSingleValPersistentEnvExtension `gameExt Game
|
|
|
|
|
instance [inst : BEq α] [inst : Hashable α] [ToJson α] : ToJson (Graph α β) := {
|
|
|
|
|
toJson := fun graph => Json.mkObj [
|
|
|
|
|
("nodes", toJson (graph.nodes.toArray.map Prod.fst)),
|
|
|
|
|
("edges", toJson graph.edges)
|
|
|
|
|
]
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/-! ## Levels -/
|
|
|
|
|
instance [inst : BEq α] [inst : Hashable α] : EmptyCollection (Graph α β) := ⟨default⟩
|
|
|
|
|
|
|
|
|
|
def Graph.insertNode [inst : BEq α] [inst : Hashable α] (g : Graph α β) (a : α) (b : β) :=
|
|
|
|
|
{g with nodes := g.nodes.insert a b}
|
|
|
|
|
|
|
|
|
|
/- Register a (non-persistent) environment extension to hold the current level number. -/
|
|
|
|
|
initialize curLevelExt : EnvExtension Nat ← registerEnvExtension (pure 0)
|
|
|
|
|
/-! ## Environment extensions for game specification-/
|
|
|
|
|
|
|
|
|
|
/-- Register a (non-persistent) environment extension to hold the current level -/
|
|
|
|
|
initialize curGameExt : EnvExtension (Option Name) ← registerEnvExtension (pure none)
|
|
|
|
|
/-- Register a (non-persistent) environment extension to hold the current level -/
|
|
|
|
|
initialize curWorldExt : EnvExtension (Option Name) ← registerEnvExtension (pure none)
|
|
|
|
|
/-- Register a (non-persistent) environment extension to hold the current level -/
|
|
|
|
|
initialize curLevelExt : EnvExtension (Option Nat) ← registerEnvExtension (pure none)
|
|
|
|
|
|
|
|
|
|
inductive Layer :=
|
|
|
|
|
| Game | World | Level
|
|
|
|
|
|
|
|
|
|
variable {m: Type → Type} [Monad m] [MonadEnv m]
|
|
|
|
|
|
|
|
|
|
def setCurLevelIdx (lvl : Nat) : m Unit :=
|
|
|
|
|
modifyEnv (curLevelExt.setState · lvl)
|
|
|
|
|
def setCurGameId (game : Name) : m Unit :=
|
|
|
|
|
modifyEnv (curGameExt.setState · (some game))
|
|
|
|
|
|
|
|
|
|
def setCurWorldId (world : Name) : m Unit :=
|
|
|
|
|
modifyEnv (curWorldExt.setState · (some world))
|
|
|
|
|
|
|
|
|
|
def getCurLevelIdx : m Nat := do
|
|
|
|
|
return curLevelExt.getState (← getEnv)
|
|
|
|
|
def setCurLevelIdx (level : Nat) : m Unit :=
|
|
|
|
|
modifyEnv (curLevelExt.setState · (some level))
|
|
|
|
|
|
|
|
|
|
def getCurLayer [MonadError m] : m Layer := do
|
|
|
|
|
match curGameExt.getState (← getEnv), curWorldExt.getState (← getEnv), curLevelExt.getState (← getEnv) with
|
|
|
|
|
| some _, some _, some _ => return Layer.Level
|
|
|
|
|
| some _, some _, none => return Layer.World
|
|
|
|
|
| some _, none, none => return Layer.Game
|
|
|
|
|
| _, _, _ => throwError "Invalid Layer"
|
|
|
|
|
|
|
|
|
|
def getCurGameId [MonadError m] : m Name := do
|
|
|
|
|
match curGameExt.getState (← getEnv) with
|
|
|
|
|
| some game => return game
|
|
|
|
|
| none => throwError "Current game not set"
|
|
|
|
|
|
|
|
|
|
def getCurWorldId [MonadError m] : m Name := do
|
|
|
|
|
match curWorldExt.getState (← getEnv) with
|
|
|
|
|
| some world => return world
|
|
|
|
|
| none => throwError "Current world not set"
|
|
|
|
|
|
|
|
|
|
def getCurLevelIdx [MonadError m] : m Nat := do
|
|
|
|
|
match curLevelExt.getState (← getEnv) with
|
|
|
|
|
| some level => return level
|
|
|
|
|
| none => throwError "Current level not set"
|
|
|
|
|
|
|
|
|
|
/-! ## Levels -/
|
|
|
|
|
|
|
|
|
|
structure LevelId where
|
|
|
|
|
game : Name
|
|
|
|
|
world : Name
|
|
|
|
|
level : Nat
|
|
|
|
|
deriving Inhabited
|
|
|
|
|
|
|
|
|
|
def getCurLevelId [MonadError m] : m LevelId := do
|
|
|
|
|
return { game := ← getCurGameId, world := ← getCurWorldId, level := ← getCurLevelIdx}
|
|
|
|
|
|
|
|
|
|
structure GameLevel where
|
|
|
|
|
index: Nat
|
|
|
|
|
@ -140,10 +186,117 @@ structure GameLevel where
|
|
|
|
|
goal : TSyntax `Lean.Parser.Command.declSig := default
|
|
|
|
|
deriving Inhabited, Repr
|
|
|
|
|
|
|
|
|
|
initialize levelsExt : HashMapExtension Nat GameLevel ← mkHashMapExtension `levels Nat GameLevel
|
|
|
|
|
/-! ## World -/
|
|
|
|
|
|
|
|
|
|
def getCurLevel [MonadError m] : m GameLevel := do
|
|
|
|
|
let idx ← getCurLevelIdx
|
|
|
|
|
match (← levelsExt.find? idx) with
|
|
|
|
|
| some level => return level
|
|
|
|
|
| none => throwError "Couldn't find level {idx}"
|
|
|
|
|
structure World where
|
|
|
|
|
name: Name
|
|
|
|
|
title: String := ""
|
|
|
|
|
introduction: String := ""
|
|
|
|
|
conclusion : String := ""
|
|
|
|
|
levels: HashMap Nat GameLevel := {}
|
|
|
|
|
deriving Inhabited
|
|
|
|
|
|
|
|
|
|
/-! ## Game -/
|
|
|
|
|
|
|
|
|
|
structure Game where
|
|
|
|
|
name : Name
|
|
|
|
|
title : String := ""
|
|
|
|
|
introduction : String := ""
|
|
|
|
|
conclusion : String := ""
|
|
|
|
|
authors : List String := []
|
|
|
|
|
worlds : Graph Name World := {}
|
|
|
|
|
deriving Inhabited, ToJson
|
|
|
|
|
|
|
|
|
|
/-! ## Game environment extension -/
|
|
|
|
|
|
|
|
|
|
def HashMap.merge [BEq α] [Hashable α] (old : HashMap α β) (new : HashMap α β) (merge : β → β → β) :
|
|
|
|
|
HashMap α β :=
|
|
|
|
|
new.fold (fun acc a b =>
|
|
|
|
|
if let some bOld := acc.find? a
|
|
|
|
|
then acc.insert a (merge bOld b)
|
|
|
|
|
else acc.insert a b) old
|
|
|
|
|
|
|
|
|
|
def GameLevel.merge (old : GameLevel) (new : GameLevel) : GameLevel :=
|
|
|
|
|
new
|
|
|
|
|
|
|
|
|
|
def World.merge (old : World) (new : World) : World :=
|
|
|
|
|
{ new with
|
|
|
|
|
levels := HashMap.merge old.levels new.levels GameLevel.merge}
|
|
|
|
|
|
|
|
|
|
def Game.merge (old : Game) (new : Game) : Game :=
|
|
|
|
|
{ new with
|
|
|
|
|
worlds := {
|
|
|
|
|
nodes := HashMap.merge old.worlds.nodes new.worlds.nodes World.merge
|
|
|
|
|
edges := old.worlds.edges ++ new.worlds.edges
|
|
|
|
|
} }
|
|
|
|
|
|
|
|
|
|
initialize gameExt : PersistentEnvExtension (Name × Game) (Name × Game) (HashMap Name Game) ←
|
|
|
|
|
do registerPersistentEnvExtension {
|
|
|
|
|
name := `gameExt,
|
|
|
|
|
mkInitial := pure {},
|
|
|
|
|
addImportedFn := fun ess => do
|
|
|
|
|
let mut games := {}
|
|
|
|
|
for es in ess do
|
|
|
|
|
for (name, game) in es do
|
|
|
|
|
match games.find? name with
|
|
|
|
|
| some oldgame =>
|
|
|
|
|
games := games.insert name (Game.merge oldgame game)
|
|
|
|
|
| none =>
|
|
|
|
|
games := games.insert name game
|
|
|
|
|
return games
|
|
|
|
|
addEntryFn := (λ s n => s.insert n.1 n.2),
|
|
|
|
|
exportEntriesFn := HashMap.toArray,
|
|
|
|
|
statsFn := fun s => format "number of local entries: " ++ format s.size
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
def getGame? (n : Name) : m (Option Game) := do
|
|
|
|
|
return (gameExt.getState (← getEnv)).find? n
|
|
|
|
|
|
|
|
|
|
def insertGame (n : Name) (g : Game) : m Unit := do
|
|
|
|
|
modifyEnv (gameExt.addEntry · (n, g))
|
|
|
|
|
|
|
|
|
|
def getLevel? (levelId : LevelId) : m (Option GameLevel) := do
|
|
|
|
|
let some game ← getGame? levelId.game
|
|
|
|
|
| return none
|
|
|
|
|
let some world := game.worlds.nodes.find? levelId.world
|
|
|
|
|
| return none
|
|
|
|
|
let some level := world.levels.find? levelId.level
|
|
|
|
|
| return none
|
|
|
|
|
return level
|
|
|
|
|
|
|
|
|
|
def getCurGame [MonadError m] : m Game := do
|
|
|
|
|
let some game ← getGame? (← getCurGameId)
|
|
|
|
|
| throwError m!"Game {← getCurGameId} does not exist"
|
|
|
|
|
return game
|
|
|
|
|
|
|
|
|
|
def modifyCurGame (fn : Game → m Game) [MonadError m] : m Unit := do
|
|
|
|
|
let game ← getCurGame
|
|
|
|
|
insertGame game.name (← fn game)
|
|
|
|
|
|
|
|
|
|
def addWorld (world : World) [MonadError m] : m Unit := do
|
|
|
|
|
modifyCurGame fun game => do
|
|
|
|
|
return {game with worlds := game.worlds.insertNode world.name world}
|
|
|
|
|
|
|
|
|
|
def getCurWorld [MonadError m] : m World := do
|
|
|
|
|
let some world := (← getCurGame).worlds.nodes.find? (← getCurWorldId)
|
|
|
|
|
| throwError m!"World {← getCurWorldId} does not exist"
|
|
|
|
|
return world
|
|
|
|
|
|
|
|
|
|
def modifyCurWorld (fn : World → m World) [MonadError m] : m Unit := do
|
|
|
|
|
modifyCurGame fun game => do
|
|
|
|
|
let world ← getCurWorld
|
|
|
|
|
return {game with worlds := {game.worlds with nodes := game.worlds.nodes.insert world.name (← fn world) }}
|
|
|
|
|
|
|
|
|
|
def addLevel (level : GameLevel) [MonadError m] : m Unit := do
|
|
|
|
|
modifyCurWorld fun world => do
|
|
|
|
|
return {world with levels := world.levels.insert level.index level}
|
|
|
|
|
|
|
|
|
|
def getCurLevel [MonadError m] : m GameLevel := do
|
|
|
|
|
let some level := (← getCurWorld).levels.find? (← getCurLevelIdx)
|
|
|
|
|
| throwError m!"Level {← getCurLevelIdx} does not exist"
|
|
|
|
|
return level
|
|
|
|
|
|
|
|
|
|
def modifyCurLevel (fn : GameLevel → m GameLevel) [MonadError m] : m Unit := do
|
|
|
|
|
modifyCurWorld fun world => do
|
|
|
|
|
let level ← getCurLevel
|
|
|
|
|
return {world with levels := world.levels.insert level.index (← fn level)}
|
|
|
|
|
|
Alexander Bentkamp
2 years ago