Free Monadic Parser
動機
Haskellでは * -> * カインドを持つデータ型からFreeモナド(Operational)を使って5秒でDSLが作れることは有名だけど、
そうやって作ったDSLをスクリプトとして外部ファイルから読み込むようなことがしたいこともあるかもしれない。
そういう時にわざわざパーサーを頑張って1から書くのはしんどいし、うまい具合にやってくれてもいいのだろうか、という話。
結論から言うとある程度うまい具合にできます
Freeモナドについて
FreeモナドはFreeなので特別なprimitive operationは定義されていないから、モナドのoperationだけをパースすることを考えればいい。 つまり、
ex = do Con1 x y t <- Con3 a b c Con4 t
のようなものがパースできればよさそうなことがわかる。 本来はモナドで定義可能な関数(whenとか)は使えるようにするべきなのかもしれないけど今回は面倒なのでパス。
さて、do式では好きな変数にbindすることができて、実体は適当な型の値がそこには束縛されている。 それを上手くパースして適当なデータ型に押し込める必要がある。
そこで、データ型の定義をする際に、実際に来るべき型とリファレンス(変数名)をどちらも取れるようにしておくことにしよう。
例えば上の例では Con4 がIntを受け取るとしたい場合、コードでは
Con4 :: ref Int Var -> DSL ()
のように定義することにする。 ref は後で具体的に適当な型が来るが、今は Int, Var のいずれも来る可能性があることを示していると思えば十分だと思う(=Var= はString)。
例: Add-Double計算機
一番下に今回使うコードを貼っておくので見てもらうとして、いくつか抜粋して解説をする。
例として、次のような命令を持つDSLを考えよう。
data DSL ref a where Add :: ref Int Var -> DSL ref () Double :: DSL ref () Get :: DSL ref Int Print :: DSL ref ()
これは内部に1つのIntを持つ計算機で、加算、内部の値を2倍、内部の値を取得、内部の値を出力できる。
ただし型を見ると分かるとおり、 Add は普通に値を受け取ることもできれば、 Get で取得して束縛したreferenceを渡すこともできる。
これのパーサーを書き、さらにそれのインタープリターをFreeモナドを使って書くことを考えよう。
従来なら DSL と同じような(ただしreferenceを保持する等の微妙な違いがある)Syntaxに沿ったデータ型を作ってパーサーを書いていたけれど、それをやめて上の DSL だけでパーサーもインタープリターも書いてしまうことにする。
パーサー
いきなり上のパーサーを書いてしまう。
pDSL :: Parser [Syntax (DSL Either)] pDSL = fromConParsers $ [ pbind padd , pbind pduplicate , pbind pget , pbind pprint ] where padd = do symbol "Add" choice $ fmap try $ [ Add . Left . fromInteger <$> integer , Add . Right <$> some letter <* newline ] pduplicate = (\_ -> Double) <$> symbol "Double" pget = (\_ -> Get) <$> symbol "Get" pprint = (\_ -> Print) <$> symbol "Print"
ここではtrifecta(persecみたいなもの)を使っているけれど、 DSL の各コンストラクタを fromConParsers に渡していることだけ分かればOK。
fromConParsers はコンストラクタのパーサーからFreeモナドのパーサーを作るやつ。
実際は、bind syntax x <- Get みたいなのをパースするんだけどあまり細かいことは気にしなくていいと思う。
パーサーでは色々型やらなんやらをごまかして書いたので、インタープリターを書くためには少しだけトリックが必要になる。
Value Universe
上でも述べたけれどreferenceを受け取ることを常に考える必要があり、さらにそれらには型がついているので、型が合わない操作を許容するわけにはいかない。
例えば x : String のときに Add x を解釈することは出来ないので、つまりどんな型が来るかも込みでインタープリターを書く必要がある。
ただし当然どんな型が来るべきかはコンパイル時には決定できないので、結論としてこのDSLが取りうる値を全て含んだ型を作ることになる。
今回のDSLは (), Int しかないので、それを含んだ型を定義する。
data BindVal = VU () | VInt Int
Resolver
インタープリターを書くためには、次のようなことを気にする必要がある。
コンストラクタごとに、どうやって上のValue Universe(BindVal のこと)に変換するかを指定する必要がある。
それと、上でも述べたreferenceの解決を行いたい。つまり、今は Add : ref Int Var -> DSL ref () なるコンストラクタがあるけれど、 Add (varX) を Add 10 みたいに変換する機構が必要になる。
ここでは、Resolverという型クラスを用意した。
class Resolver dsl where type ValUniv dsl :: * toValue :: dsl Either a -> (a -> ValUniv dsl) resolve :: M.Map Var (ValUniv dsl) -> dsl Either a -> dsl Const a
ValUniv はDSLのコンストラクタが取りうる値を全て集めた型で、今の場合は BindVal になる。
toValue は、各コンストラクタをどうやって ValUniv に変換するかを指定する。
resolve は、 dsl Either を dsl Const に変換する。ここで先程の Add を思い出すと、 Add (Either Int Var) を Add (Const Int Var) 、つまり Add Int に変換すれば良いことが分かる。
resolve は現在束縛されている変数とその値のMapも引数にあるので、これを使って Add (Right ref) はMapからrefに対応する値を引っ張ってくるだけでよい。
このResolverのinstanceを書けば、欲しかったFreeモナドのデータが得られるので、最後はインタープリター部分を書けばOK。
interpret
インタープリターは適当に書けば良い。
DSL Const が来るので、bindの問題はなく、ただの値が入ったコンストラクタを受け取って動くものを書くだけでいい。
interpret :: Skeleton (DSL Const) () -> IO () interpret = go 0 where go :: Int -> Skeleton (DSL Const) () -> IO () go st skel = case debone skel of (Add (Const n) :>>= next) -> go (st + n) (next ()) (Double :>>= next) -> go (st * 2) (next ()) (Get :>>= next) -> go st (next st) (Print :>>= next) -> print st >> go st (next ()) Return _ -> return ()
動かす
Print Add 10 Print n <- Get Double m <- Get Print Add n Add m Print
みたいな文字列を渡すとパースしてインタープリットして動くプログラムが得られる。
やったね！
エラーハンドリングについて
型エラー、つまり x: String のとき Add x などと書くものは、上でのresolveできっちりキャッチできる。
上のresolveではMapから値を引っ張ってくるが、引っ張ってきたデータに Int 以外の値が入っている場合は、パースした文字列で型エラーが起きていることが分かるので適当なエラーを書けば良い。
補足
今はモナドの構文としてbind x <- f しか使えないけれど、他にletやifやらもちゃんとサポートするのもありだと思う。
また注意として、上の方法では常にValue Universeが必要になるので返す型が多相になったり複雑になったりするとまた考えないといけないことが出てくるかもしれない。 あんまりちゃんと考えてないけど実用したいときは注意。
コード
Object型とOpenUnion
Table of Contents
今現在Haskellを使ってゲームを作っていて、そこで「オブジェクト」的なものが欲しくなってあれこれした結果を説明として残しておきたいので書きます。 Haskellでオブジェクト指向をエミュレートするのには objective というのがあるんだけどまぁ大体そういう感じの話です。
Widget型
ゲーム内では、Widgetと呼ばれる、画面上に表示されたり内部状態が変化して見た目が変わったりするコンポーネントを扱うことにしている。 つまり画面に表示されたりするUIを司るための型を用意しておいて、それに対して特定の信号を送ると内部状態が変化したりしなかったりする。
Widget型の定義は以下の通り
newtype Widget ops = Widget { runWidget :: forall m x. Monad m => Union ops m x -> pick (Widget ops) m x }
ops はoperatorのリストで、メソッドを集めてきたもの、と思えばいい。ただし各operatorは2つの型変数を持ち、カインドが (* -> *) -> * になっている。
Union ops m x はOpenUnion(ops の直和)で、データとしては {op m x : op `in` ops} だと思えばいい。
ここで m が出現していることで、後にこのWidgetが実行されるモナドをメソッドごとに変えられるようにしている。
pick は Widget ops (自分自身)、 m (文脈)、 x (値) から実際に返すべき型を作るためのもの。
直和と直積
実際にゲーム内では pick として EitherT self m x つまり m (self + x) を選んでいるので、メソッドを呼ぶたびに自分自身を返すか値を返すかのいずれかができる。
pick が例えば pick self m x = m (x, self) の場合は大体objectiveのObject型と同じと思っていい。この場合はメソッドを呼ぶたびに自分自身と値のペアを返す。
大抵の場合はこの直和と直積のいずれかしか使う機会はないと思う。
一応違いとして、直和は常に内部状態を更新するのと値を返すのいずれかしか出来ないが、直積はどちらも必ず返す必要がある。 今回直和を選んだ理由として、値を返さないケース(メソッドチェインしたい時)にそうであることを明示する方法が直和にはあって直積にはないから、という感じだったけど 別に直積でもデータを捨てればいいのでどっちでもいいと思う。
内部状態
Widgetは「このメソッドが来たら」「内部状態を更新したり値を返したりする」ためのものだったけれど、当然内部状態を保持したいことがあると思う。 それは例えば次のようなループで書くと良い感じになる:
widget :: Widget [op1, op2] widget = go inititalState where go :: State -> Widget _ go state = Widget $ \case op1 -> go state' op2 -> go state''
内部状態は内部状態なので外からは見えないけれど、例えば内部状態を取り出すgetterやsetterを定義すれば いくらでも取り出したり変更したりはできる。
Widget Operation
Widget型で必要になるoperationは大体決まっていて、
Reset :: Widget ops -> Widget ops Render :: Position -> Widget ops -> GameM () Run :: Widget ops -> GameM (Widget ops) EventHandler :: KeyStates -> Widget ops -> GameM (Widget ops)
ぐらいを用意しておけばいいことにしてる。 これらの型は基本的にどんなwidgetでもあまり変わらないのでglobalに定義してexportしてる。
継承、合併
継承というか、2つのWidgetのメソッドを合併したWidgetというのが欲しい場合があって、単純には以下のようにすればいい。
union :: Widget [op1,op2] -> Widget [op3,op4] -> Widget [op1,op2,op3,op4] union = go where go wx wy = Widget $ \case op1 -> wx @. op1 op2 -> wx @. op2 op3 -> wy @. op3 op4 -> wy @. op4
しかしメソッドに被りがある場合、あるいは被りがあるかもしれない場合は重複を除く工夫が要る。 例えば明示的に直和を書くのも一つ。
union' :: Widget ops -> Widget ops' -> Widget (Sum ops ops') -- このときメソッドは -- InL op1 -- InR op3 -- のような形になる
そもそも、メソッドをただのリストとして持つのがいけない、という可能性もあって、本来ならば継承相当の機能を作るためには メソッドの間に順序っぽいものが定義されていたりすることが多いのでそういうのを上手く使って欲しいという気持ちもしないでもない。
というわけで無理やりどうにかする方法もなくはない:
union' :: Widget ops -> Widget [op1..opn] -> Widget (ops ++ [Lift op1 .. Lift opn])
力業感すごいけれどどちらかのメソッドを優先させて、優先されなかった方のメソッドもLiftで残すみたいなことも出来なくはない。 ただ最強にダサいのでどうにかして欲しい。
関係ないけれど
関係ないけれど、いわゆるeffect systemではこういうoperationが起きた順番を覚えておいて それが正しい順序で呼ばれているかを調べたりできるので、 そういうふうに使うことを考えると一般にメソッドのなす型はそれこそpreordered monoidぐらいにはなっていてほしいような気持ちもある。
リストじゃなくて自然にそういうpreorderが定義できるようなデータ構造で上のようなことを考えてやれば 継承も自然に定義できるじゃなかろうか。 と思って入るけどまだそれについてはちゃんと考えていない。
上でも言ったけれどWidgetのoperationは大体決まっているので、それを使ってこう良い感じに…みたいな。 困ったことにアイディアはなし。
おわりに
思ったよりobjectiveに寄せた感じの内容になってしまったけれど大体上のぐらいのものが用意されていると ゲーム制作には困らなさそうという実感があります。 現在はHaskellを2200行ぐらい書いてる模様ですが、特に破綻することなく苦しみもそんなになく普通に書けています。
でも、この記事を書いていてやっぱりリストで持つのはだめだなという考えに至りつつあるので そこも改善できたらしていきたい。 まぁあくまでゲーム制作が本来の目的なのでエターナらないようにだけは気をつけよう(自戒)。
ちなみに、この文書はorg-modeで書きました。
ゲーム制作進捗報告会その3
ようやく本質的な進捗が生まれ始めていて嬉しい
進捗報告
設計
前回異様に苦しんでいた設計問題はめでたく解決し、ちゃんと進捗しつつあってよい
結論だけ言うと
newtype W = W (forall (m:Monad) x. Union xs m x -> br W (m x))
の形の型を使っている。
再帰的なデータ型で、「自分自身を返す」というのがメソッドチェイン的な感じで使えるというのと、引数としてエフェクト(メソッド)を渡すというのが基本的な設計になっている。
あとはこれを適当な内部状態を引数に持たせたループで処理していい感じにしている。
多分そのうちコードを公開できると思うので細かいことはその時にでも
ゲームシステム
- ゲーム画面: スタート画面を用意して、始めからを選ぶと名前を入力したりするようにした 4/7
- 調合システム: そんなに進んでない 12/18
実際そんな進んでないんだけど、今まで作った画面の部品に当たる部分を全て書き直したのでちゃんと進んでいる、はず。
次は実績解除系の機能をつけようかと思う。
キャラとか
主人公のキャラデザがなんとなく決まってきた。
村の住人と話す機能もつけてみたいけどまだ考えてない
フィールドとか
いわゆるRPG的なマップチップを並べて街の中を移動するみたいなフィールド画面じゃなくて、地図の上でポイントを選んで移動する形式にしようかなと思っている。
そもそもフィールドを歩けることに特別な意味があるようなゲームでもないし…
とりあえず今のところはそんな感じで。
TODO
消化したTODOは42/87、TODO消化率は48%です。
