Monadic Scripting in F# for Computer Gamesを読んで

以前たまたま見つけた、F#でモッナードなスクリプティングしようず！な論文が面白かった。

[Monadic Scripting in F# for Computer Games](http://www.dsi.unive.it/~orsini/documenti/MonadicScripting2.pdf "Monadic Scripting in F# for Computer Games")


論文の内容をかいつまんで書く。


###ゲームのスクリプトシステムに必要な要件
>- コルーチンのサポートが欲しいよね
- プログラミングし易くしたいよね（シンプルに）
- スピードが欲しいよね（ゲームは非常に高速な実行が必要）
- 拡張性が欲しいよね（より良くゲームエンジンに適合させるために）

あたりを挙げている。あとは、ステートマシンなコードを書くのは複雑になるし難しいよねとか。そこでモッナード。



みなさんご存じモナドは多くの目的のために使用することができるメタな抽象表現。F#にはコンピュテーション式があるので、モナドでコルーチンなスクリプトシステムを表現できれば、プログラミングし易くてうれしい。スクリプトがF#で書けるなら優れた実行時のパフォーマンスも提供できるし、なにより型に守られているからうれしいよね。当然、拡張性も高いですしおすしってゆー流れのお話でした。


論文で示されているシンプルなScriptモナドは、Stateモナドにちょっと似ている。で、スクリプト言語(あるいはDSL)というよりかは、むしろ透過的にコルーチンをサポートするための基盤的なランタイムフレームワークって位置付けですよ、と。


## Scriptモナド
いろいろわからない部分もあったけど、面白かった。そんなわけで、論文のシンプルな例を参考に、より使いやすい感じ（？）にオレオレ改良。


```fsharp:Script.fs
namespace Monadic
open System

module Script = 
  type Script<'a,'s> = 's -> Step<'a,'s>
  and Step<'a,'s> = 
   | Done of 'a 
   | Next of Script<'a,'s>

  let sreturn x = fun _ -> Done x
  let rec (>>=) m f = fun s ->
    match m s with
    | Done x -> Next(f x)
    | Next m' -> Next(m' >>= f) 

  type ScriptBuilder internal () =
    member this.Zero() = fun k -> (sreturn ()) k
    member this.Return(x) = fun k -> (sreturn x) k
    member this.ReturnFrom(x) = x
    member this.Bind(p, k) = p >>= k
    member this.Combine(f, rest) = fun k -> f rest
    member this.Using(res: #IDisposable, body) =
      try
        body res 
      finally
        match res with null -> () | x -> x.Dispose()
    member this.TryWith(f, h) = try f () with e -> h e
    member this.TryFinally(c, f) = try c ()  finally f ()
    member this.Delay (f) = f
    member this.Run(f) = f ()

  let script = ScriptBuilder ()

  let rec runS s gs =
    s gs |> function
    | Done x -> x
    | Next k -> runS k gs

  let liftS f s = s >>= (fun x -> sreturn(f x))
  let liftS2 f s1 s2 = s1 >>= (fun x1 -> s2 >>= (fun x2 -> sreturn(f x1 x2)))

  let notS s = liftS not s
  let andS s1 s2 = liftS2 (&&) s1 s2
  let orS s1 s2 = liftS2 (||) s1 s2
  let ignoreS s = liftS ignore s

  let (!!.) s = notS s
  let (&&.) s1 s2 = andS s1 s2
  let (||.) s1 s2 = orS s1 s2

  let rec guardS c s = 
    script{
      let! x = c
      if x then
        return! s
      else
        return! guardS c s }

  let repeatS n k =
    let rec f s n c =
      script {
        let n = n - 1
        match c >= n  with
        | true -> 
          return! k ()
        | false -> 
          let! _ = k ()
          return! f s n c }
    f k n 0

  let ifS c a b = 
    script{
      let! x = c
      if x then
        return! a
      else
        return! b}

  type ScriptBuilder with
    [<CustomOperation("not'", MaintainsVariableSpaceUsingBind = true)>]
    member this.Not (source, f) = !!. f
    [<CustomOperation("and'", MaintainsVariableSpaceUsingBind = true)>]
    member this.And (source, f) = f &&. source
    [<CustomOperation("or'", MaintainsVariableSpaceUsingBind = true)>]
    member this.Or (source, f) = f ||. source
    [<CustomOperation("guard'", MaintainsVariableSpaceUsingBind=true)>]
    member this.Guard (source, f) = guardS f source
    [<CustomOperation("ignore'", MaintainsVariableSpace=true)>]
    member this.Ignore (source) = ignoreS source
    [<CustomOperation("repeat'", MaintainsVariableSpace=true)>]
    member this.Repeat (source, f) = repeatS f (fun () -> source)
```


シンプルってゆーか割と小手先感あるけど、これで簡単便利にモナディックにコルーチン的スクリプティングができる。状態をScriptモナドで継続で持ちまわしてドーン（！）、みたいな？


##おまけ：IOモッナード
状態遷移をScriptモナドに任せるのに加えて、IOモナドも使って書くと副作用も分離しつつ全体的にモナディックに。


いげ太さん作の IOモッナードを利用してみる。

[Tiny IO Monad - F# Snippets](http://fssnip.net/6i "Tiny IO Monad - F# Snippets")



コンピュテーション式で``if``式のelseを省略したい。あと乱数の取得。ちょっとだけ手を加える。

```fsharp:IO.fs
namespace Haskell.Prelude
open System 

type IO<'T> = private | Action of (unit -> 'T)

[<AutoOpen>]
module MonadIO =
    let private raw  (Action f) = f
    let private run  io         = raw io ()
    let private eff  g   io     = raw io () |> g
    let private bind io  rest   = Action (fun () -> io |> eff rest |> run)
    let private comb io1 io2    = Action (fun () -> run io1; run io2)
    
    type IOBuilder() =
        member b.Return(x)              = Action (fun () -> x)
        member b.ReturnFrom(io) : IO<_> = io
        member b.Delay(g) : IO<_>       = g ()
        member b.Bind(io, rest)         = bind io rest
        member b.Combine(io1, io2)      = comb io1 io2
        member b.Zero ()                = Action ignore // add

    let io = new IOBuilder()
    let (|Action|) io = run io

[<AutoOpen>]
module PreludeIO =
    let putChar  (c:char)   = Action (fun () -> stdout.Write(c))
    let putStr   (s:string) = Action (fun () -> stdout.Write(s))
    let putStrLn (s:string) = Action (fun () -> stdout.WriteLine(s))
    let print x             = Action (fun () -> printfn "%A" x)
    let getChar     = Action (fun () -> stdin.Read() |> char |> string)
    let getLine     = Action (fun () -> stdin.ReadLine())
    let getContents = Action (fun () -> stdin.ReadToEnd())
    let randNext min max = Action (fun () -> let rnd = new Random() in rnd.Next(min,max)) // add
```



モナドティックあげるよ的、雑なサンプル。

```fsharp:Sample.fs
open System
open Haskell.Prelude // Reference : Tiny IO Monad http://fssnip.net/6i Author:igeta
open Monadic.Script 

type GameState = 
  { HP:int; IsGameOver : bool }
  member this.Damage (x) = let s = this.HP - x in { this with HP = if s <= 0 then 0 else s }
  member this.Repare (x) = { this with HP = this.HP + x }
  member this.GameOver () = { this with IsGameOver = true }

let damage s x = script { let! gs = s in return (gs:GameState).Damage(x) }
let repare s x = script { let! gs = s in return (gs:GameState).Repare(x) }
let gameOver s = script { let! gs = s in return (gs:GameState).GameOver() }
let isNotGameOver s = script { let! gs = s in return (gs:GameState).HP > 0 } 
let isGameOver s = !!.(isNotGameOver s)
let damageIfGameOver s x = script{ return! ifS (isGameOver s) (gameOver s) (damage s x) }
let repareIfGameOver s x = script{ return! ifS (isGameOver s) (gameOver s) (repare s x) }
let showHP (gs:GameState) = (sprintf "残りHP：%s" <| string gs.HP) |> putStrLn

let rec update gs = 
  io {
    let! x = randNext 5 10
    let s = damageIfGameOver (sreturn gs) x
    let gs = runS s gs 
    if gs.IsGameOver |> not then
      do! putStrLn (sprintf "%sダメージを受けた" <| string x)
    do! showHP gs

    let! x = randNext 3 5
    let s = repareIfGameOver (sreturn gs) x
    let gs = runS s gs
    if gs.IsGameOver |> not then
      do! putStrLn (sprintf "%s回復した" <| string x)
      do! showHP gs

    if gs.IsGameOver  then
      return! putStr "GAME OVER" 
    else
      return! update gs }

[<EntryPoint>]
let main _ =
  let (Action ()) = update { HP = 50; IsGameOver = false }
  Console.ReadKey () |> ignore
  0
```

そうですね。割と純粋。手続きはモナド。モナドとは手続きってエロい人が言っていたような気がしました。はい。「だからどーした」という感じ。あるよ。


※コンパイラ オプション ``--tailcalls``