これはML Advent Calendar 2017の20日目の記事です。

背景

愛知県にて名古屋PFDS読書会を開いています。
PFDSでは正格評価と遅延評価を混合した戦略を取り、償却上限や最悪上限を計算・証明・さらには小さくする方法が議論されています。
この戦略はひじょうに強力で、例えば永続性を持つキューに対する操作（push/pop）を、定数最悪時間で実行できるようにします。

このPFDSに登場するコードはSMLで書かれています。
また、PFDSの付録には、Haskellで動作するコードが載っています。
おかげで、PFDSの読者はコードを読んだり、実際に動作を試しながら学習することができるようになっています。

よく知られているように、SMLは正格評価なプログラミング言語です。
PFDSではどうやって正格評価と遅延評価を混合した戦略をとっているのでしょうか。
実はPFDSでは、SML/NJコンパイラの拡張機能を使って遅延評価を手に入れています。
コンパイラ自体のサポートのため、ひじょうに簡単に遅延評価が使え、効率よく実行されます。
例えば、SML/NJでは下記のように書けます。

(* SML/NJのコンパイラスイッチの切り替え *)
val () = Control.lazysml := true
open Lazy
fun force ($ x) = x

(* 利用方法 *)
fun lazy f ($ x) = $ (print "Hi"; x + 1)
val a = f ($ 0)
val b = force a  (* 1回目のforceでしか"Hi"がプリントされない *)
val c = force a

$は値を遅延するコンストラクタです。
このコンストラクタにより、'a susp型の遅延型の値をつくることができます。¹
また、専用構文fun lazyにより、'a susp -> 'a susp型が定義できます。
上記の例ではこの構文を使って関数fを定義しています。

問題点

しかし、SML/NJ拡張機能のため、SML/NJ以外のSMLコンパイラでは、コードを効率よく動作させることができません。
SML/NJ以外でも動作はしますが、全体が正格評価として実行され、想定されていない計算時間になってしまいます。

また、PFDSでは複雑なデータ構造がたくさんでてきます。
複雑な計算量解析の学習において、値の評価状況（遅延されているかメモ化済みか）が見たくなります。
しかし、SML/NJコンパイラの遅延評価機能では、値の評価状況を見る機能はありません。

解決

そこで、他SMLでも使える遅延データ構造を実装することにしました。

方針

実装はSML/NJ以外で行う。今回はSML#コンパイラを使う
PFDSの例であるStreamを実装できるようにする
- ただし、SML/NJの遅延データと完全に同じコードが再利用できなくてもよい
- 遅延をするために、ユーザに余分なコードを書かせても良いことにする

設計

SMLで遅延とメモ化をどうやって実現するかを説明します。

遅延の実現

SMLでユーザができる遅延として、クロージャで包む方法があります。
例えば、以下のような関数では、printの実行はf ()が行われるまで遅延されます。

val f = fn () => print "Hi"

今回はよくあるユニットを受け取って値を返すクロージャを使って遅延評価を実装します。
よって、遅延された値はunit -> 'aのような型を持ちます。

メモ化の実現

メモ化を実現するために、今回の実装では遅延データが2種類のパターンを持つようにします。
まずは「未評価ラベルと計算」、もう一つは「評価済みラベルと計算結果」です。
よってデータ構造は以下のようになります。

datatype 'a lazy = Lazy of unit -> 'a | Done of 'a

この値を使うには、値が持つラベルを見て動作を決めます。
未評価であれば、計算を実際に実行し、計算結果を返します。
一方で、評価済みであれば、データが持つ計算結果を返すだけです。

fun force x = case x of
                Lazy cls => ... (* 計算する *)
              | Done a => a

さらに、メモ化を共有する必要があります。
つまり、以下のようなコードがあった場合、g x時のxの計算は実行されずに、前に計算した結果を使ってほしいです。

val x = $(...)  (* lazyな計算 *)
val y = x
val _ = f x  (* ここでxが計算される *)
val _ = f x  (* ここ以下のxとyは計算されず、前にxを評価した値を使ってほしい *)
val _ = f y

そのために、参照型を導入します。
参照した先に、未評価・評価済みのラベル付きの値を持つようにします。
こうすることで、参照値がコピーされたとしても、参照先の未評価・評価済みの値は共有されます。
また、参照先を書き換える操作によって、未評価な値を実際に評価した値に書き換えることができます。

type 'a susp = 'a lazy ref
fun force x = case x of
                ref Lazy cls => ... (* 計算してからxを書き換える *)
              | ref Done a => a

実装

最終的な実装は下記のようになります。
遅延された値の型は、SML/NJに合わせてsuspという名前をつけています。
ユーザが遅延されたexpをつくるには、$ (fn () => exp)のように手で書く必要があります。
SMLは値渡しされるため、このクロージャ生成は関数化できません。
また、遅延された値を利用するには、forceを使います。

signature LAZY =
sig
  type 'a susp
  val $ : (unit -> 'a) -> 'a susp
  val force : 'a susp -> 'a
end

structure Lazy :> LAZY =
struct
  datatype 'a lazy = Done of 'a | Lazy of unit -> 'a

  type 'a susp = 'a lazy ref

  fun $ cls = ref (Lazy cls)

  fun force (ref (Done x)) = x
    | force (s as ref (Lazy cls)) =
  let
    val x = cls ()
    val () = s := Done x
  in
    x
  end
end

実行例

例えば、以下のようなコードを実行してみます。
プリントされるのは1回のみで、再評価されていないことがわかります。

example.sml

local
  open Lazy
in
val x = $ (fn () => (print "Evaluated!\n"; 0))
val y = x
val z1 = force x
val z2 = force y
end

# use "example.sml";
Evaluated!
val x = _ : int susp
val y = _ : int susp
val z1 = 0 : int
val z2 = 0 : int

実装の利用例

上記Lazyモジュールを利用して、PFDSにあるStreamとRealTimeQueueを再実装しました。
詳しくはリンク先のGithubコードを確認してください。

Stream
RealTimeQueue
- 利便性のためにSML#のレコード拡張を使っています。等価なSMLのコードが存在するため、他SMLへの移植は容易です。

今後の課題

`toString`の実装

そもそも、遅延評価の様子を観察するのが目的でした。
しかし、内容をプリントするための'a susp -> stringな関数をまだ作っていません。
自力でフォーマッタを手書きしたり、SML#のSMLFormatterを利用したり、が考えられます。

暗示的なメモ化

今回の実装では明示的にコピーをしないとメモ化が効きません。
例えば以下のようなfib関数でfib 10を評価するとき、fib 9がつくるfib 8とfib 10がつくるfib 8は共有されず、別々に計算され無駄になります。

local
  open Lazy
in
fun fib 0 = $ (fn () => 0)
  | fib 1 = $ (fn () => 1)
  | fib n = $ (force (fib (n-1)) + force (fib (n-2)))
end

fib 10 => fib 9 + fib 8
       => (fib 8 + fib 7) + fib 8 => ...
               ^                ^
fib 8が2回出て来るが、共有されない

解決には別のアイディアが必要です。
例えば、メモ化を「関数fとその引数xの2つをキーとしてテーブルを引く」という実装にする必要があります

他にも、参考文献2にて大堀淳先生は、以下のようなmemoを実装して解決しています。

(* val makeMemoFun : (''a -> ''b) -> ''a -> ''b *)
fun makeMemoFun f =
  let
    exception NotThere
    val memo = ref (fn x => (raise NotThere))
  in
    fn x => !memo x
            handle NotThere =>
                   let
                     val v = f x
                     val oldMemo = !memo
                     val () = memo := (fn y => if x = y then v else oldMemo y)
                   in
                     v
                   end
  end

ユーザビリティの向上

fn () => ...を毎回書くのは本当に辛いです。
これ以上のアイディアが出ませんでした。
これには、マクロなど別な力が必要なのではと思っています。

まとめ

SMLで使える汎用な遅延モジュールを作成した
- あとあと考えると、SML/NJは関数型しか遅延できないが、このデータ構造は関数型以外も遅延できる。
遅延にはunitを受け取るクロージャを利用した
評価結果をメモ化するために参照型を利用した。

参考文献

ソースコード

Github

SML/NJのLazy機能では、val x = $ (heavy_eval)と書いてもsusp型になりますが、値の計算は遅延されません。fun lazy f x = $ (heavy_eval)に対してf xしたときのみ、実際の計算が遅延されます。 ↩

SMLで遅延評価なデータ構造

背景

問題点

解決

方針

設計