Oath: 安全、高速、合成可能な並行処理

TL;DR

github.com

並行処理を簡潔かつ安全に記述できるライブラリを作った。ApplicativeDo拡張を使って、以下のようにoathの引数として与えたIOアクションを同時に実行し、結果を集める処理を書ける。いずれかが例外を投げた場合、残りをキャンセルするためリソースを漏らす心配がない。

evalOath $ do
   a <- oath $ ...
   b <- oath $ ...
   f a b

経緯

Haskellは並行処理が得意とされている。事実、軽量スレッド、MVar、STMといった処理系によるサポートが充実しており、HackageのConcurrencyカテゴリには235ものパッケージがあることからもユーザの関心の高さが窺える。 並行処理を実用する上では、単にスレッドをフォークするだけでなく、計算の結果を集める必要がある―—Scalaなどで言うFutureに近いものがあると嬉しい。案の定、並行計算の結果を取り出すためのHaskellライブラリは数多く作られてきた。

futuresというなかなかいい名前のパッケージがある。APIもかなりシンプルだ。 スレッドをフォークして、計算結果をMVarに代入し、MVarの中身を取り出すアクションを返すというものだ。

fork :: IO a -> IO (Future a)
fork io = do
  mv <- newEmptyMVar
  forkIO $ do
    a <- io
    putMVar mv a
  return $ Future $ readMVar mv

考え方はわかりやすいが、この実装には致命的な欠点がある―—例外処理である。forkに与えたアクションが例外を発生させても、誰も対応ができない。しかも、putMVarが呼ばれなくなるのでreadMVarが発散してしまう(実行時エラーになる)。これでは実用するのは難しい。また、forkIOの結果であるThreadIdが捨てられていることからわかるように、一度始めた計算を外部から止めるすべはない。

spawnは、Future型ではなく直接IOを返す点を除けばfuturesと似ている。

spawnTry :: IO a -> IO (IO (Result a))
spawnTry m = do
  v <- newEmptyMVar
  _ <- mask $ \restore -> forkIO (try (restore m) >>= putMVar v)
  return (readMVar v)

spawn :: IO a -> IO (IO a)
spawn m = do
  r <- spawnTry m
  return (r >>= either throwIO return)

こちらはきちんと例外処理をしており、putMVarが呼ばれることが保証されるためいくらか実用的だ。しかし、やはり計算は止められない。

promiseは、ApplicativeとMonadインスタンスであるPromise型が売りだ。

newtype Promise a = Promise { unPromise :: IO (Async a) }
  deriving (Functor)

instance Applicative Promise where
  pure = Promise . async . return
  Promise mf <*> Promise mx = Promise $ do  
      f <- mf
      x <- mx
      (f', x') <- waitBoth f x
      async $ return $ f' x'

instance Monad Promise where
   return = liftIO . return
   Promise m >>= f = Promise $ m >>= wait >>= unPromise . f 

liftIO :: IO a -> Promise a
liftIO = Promise . async

外側のIOでスレッドをフォークし、内側のAsyncで結果を待つという仕組みのようだ。だが、m <*> nはmとnをそれぞれ並行して実行したのち、両方の結果が返ってくるのをその場で待つ必要がある(「待つAsyncを返す」のではなく、「待ってからAsyncを返す」)。これでは(a *> b) *> ca *> (b *> c)の挙動が異なってしまうため、Applicativeの則を満たさない。また、Asyncは本来cancel`できるはずだが、合成中に結果を待ってしまうので事実上中断ができない(どちらにせよ、Promiseの実装が隠蔽されているのでどうしようもないが)。 さらに、Monadは左の計算の結果を待ってから右に進むという挙動で、Applicativeとの一貫性がない。いくらインスタンスがあっても、これでプログラムを組み立てるのは難しいだろう。

非同期処理の定番であるasyncパッケージには、Concurrentlyという型がある。

newtype Concurrently a = Concurrently { runConcurrently :: IO a }

instance Applicative Concurrently where
  pure = Concurrently . return
  Concurrently fs <*> Concurrently as =
    Concurrently $ (\(f, a) -> f a) <$> concurrently fs as

instance Alternative Concurrently where
  empty = Concurrently $ forever (threadDelay maxBound)
  Concurrently as <|> Concurrently bs =
    Concurrently $ either id id <$> race as bs

(<*>)concurrently :: IO a -> IO b -> IO (a, b)を使って両方の結果を待つ計算を表現し、(<|>)race :: IO a -> IO b -> IO (Either a b)はどちらかが返ってくるまで待つ計算を表現する。promiseと違い、その場で待機する必要がないので、Applicative則を満たしそうだ。 concurrentlyおよびraceは、スレッドを必ず二つフォークする上、かなり複雑な実装なので、オーバーヘッドが大きそうだ。ここまで見た中では一番正しそうで使いやすそうな実装だが、もっといい方法はないだろうか。

継続とSTMのコンボ

非同期処理を安全に合成する方法には覚えがある。単純で頑強なメッセージングシステム、franz - モナドとわたしとコモナドで紹介した、継続渡しを用いて結果を待つトランザクションを渡すという仕組みだ。この方法なら、継続が終了したタイミングで処理を中断できるため、待つもやめるも自由自在、お漏らしの心配はない(franzはこのメカニズムによって非同期リクエストを管理している)。そのエッセンスを独立したライブラリに蒸留できそうだ。それっぽい名前はだいたい取られていたので、Promiseからの連想でOathと名付けた。

github.com

newtype Oath a = Oath { runOath :: forall r. (STM a -> IO r) -> IO r } deriving Functor

instance Applicative Oath where
  pure a = Oath $ \cont -> cont (pure a)
  Oath m <*> Oath n
    = Oath $ \cont -> m $ \f -> n $ \x -> cont (f <*> x)

Oathは、IO (STM a)CPS変換したもので、Compose (Codensity IO) STMと等価である*1 *2。外側のIOで計算を起動し、内側のSTMで結果を待つ。OathApplicativeインスタンスを持ち、STM (a -> b)STM aを用意してから、それらを合成したSTM bを返す――計算の起動と、結果の待機を別々に合成するというわけだ。

oath :: IO a -> Oath a
oath act = Oath $ \cont -> do
  v <- newEmptyTMVarIO
  tid <- forkFinally act (atomically . putTMVar v)
  let await = readTMVar v >>= either throwSTM pure
  cont await `finally` killThread tid

oathは、IOアクションを別のスレッドで実行し、その結果をTMVar経由で取り出す。forkFinallyが例外を受け止め、throwSTMがそれを伝える。

生殺与奪の権は継続が握っており、終了したときにThreadKilled例外が投げられる。このような挙動をwithAsyncなどで安全に表現しようとすると、withAsync foo $ \a -> withAsync bar $ \b -> ...のように ネストが深くなってしまいがちだが、Oathは継続渡しの抽象化によって、combine <$> oathSTM foo <*> oathSTM barのようにフラットに書ける。それだけでなく、traverseでコンテナに対しても簡単に適用できるという利点もある。

Oathを実行するには、単にevalOathを呼び出す。もちろん、runOathを直接呼ぶべき場面もある。

evalOath :: Oath a -> IO a
evalOath m = runOath m atomically

Alternative<|>は、Concurrentlyと同様両方の計算を起動するが、一方が完了した段階でもう片方はキャンセルする(STMのAlternativeインスタンスを継承している)。 Control.Concurrent.STM.Delayのラッパーも提供しており、<|>で合成するだけで、タイムアウト処理を非常に簡単に記述できる。 また、「リソースの確保」「解放」「使用」という三つの挙動を一つにまとめられるという継続渡しの強みがdelayの実装によく表れている。

instance Alternative Oath where
  empty = Oath $ \cont -> cont empty
  Oath m <|> Oath n = Oath $ \cont -> m $ \a -> n $ \b -> cont (a <|> b)

delay :: Int -> Oath ()
delay dur = Oath $ \cont ->
  bracket (newDelay dur) cancelDelay (cont . waitDelay)

Concurrentlyと違い、Oathはフォークは必須ではないのもポイントだ。例えばネットワーク経由でリクエストを送信する処理は書いた順序で実行し、結果を待つ部分だけ非同期にするといった実装もできる。forkOnなど、forkIO以外のフォークも使えるため自由度が高く、決定性が求められる単体テストの実装などにも役に立つだろう。

パフォーマンス

最後に、Concurrentlyと比較するためのベンチマークを行った。他のパッケージはまともに動作しないため、評価の対象から外した(単体テストは残してある)。

  , bench "oath STM 100" $ nfIO $ O.evalOath $ traverse (O.oath . pure) [0 :: Int ..99]
  , bench "async 100" $ nfIO $ A.runConcurrently $ traverse (A.Concurrently . pure) [0 :: Int ..99]
  oath IO 10:   OK (0.86s)
    3.18 μs ± 206 ns
  oath STM 10:  OK (0.34s)
    5.10 μs ± 169 ns
  async 10:     OK (0.66s)
    10.0 μs ± 190 ns
  oath IO 100:  OK (0.60s)
    35.8 μs ± 2.4 μs
  oath STM 100: OK (0.39s)
    48.0 μs ± 1.3 μs
  async 100:    OK (0.21s)
    100  μs ± 5.6 μs

オーバーヘッドはConcurrentlyの約半分に抑えられている。Concurrentlyは(<*>)の左右ごとにスレッドをフォークするため、項の二倍フォークする必要があるという点が表れているのだろう。

まとめ

Oathは、継続渡しスタイルとSTMを組み合わせることによって、柔軟、安全、高速、そして合成可能な非同期処理の表現を可能にした。単にIOアクションを組み立てる道具としても便利だが、今後はOathに基づいたAPIデザインにも一考の余地があると考えている。並行処理の新定番を狙っていきたい。

新しいGHC拡張、NoFieldSelectorsについて

今まで不満の多かったHaskellのレコードの扱いを改善するための一歩として、NoFieldSelectorsというGHC拡張の実装を進めている。

動機

Haskellにはレコードを定義するための構文がある。

data User = User
    { userId :: Int
    , userName :: Text
    }

こう定義すると、各フィールドごとにuserId :: User -> IntuserName :: User -> Textというゲッターに相当する関数が生成される。これらの関数は特別な意味合いを持っており、以下のレコード操作の構文にも利用できる。

  • 構築 User { userId = 0, userName = "Zero" }
  • パターンマッチ case foo of User { userId = x, userName = name } -> ...
  • 更新 foo { userId = 1 }

しかし、フィールドと同じ名前の関数こそが使いづらさの原因となっている。 多くのプログラミング言語では、構造体のフィールドはそれぞれ固有の名前空間に属するが、Haskellはそうではない。以下のような定義は、idUserなのかArticleなのか、それともPreludeid :: a -> aなのか判別できないため、実際には使えない。

data User = User { id :: Int, name :: Text }
data Article = Article { id :: Int, title :: Text }

そのため、userIdarticleIdのように型名を接頭辞にするのが通例となっている。 するとタイプ数が増えるばかりか、JSONなどのフォーマットに変換する際に接頭辞を切り取るための仕組みなども必要になり、使い勝手がよくない。lensや拡張可能レコードなどの技法で改善できる面もあるものの、RecordWildCardsNamedFieldPunsなどの構文的な支援や、網羅性のチェックが受けられなくなるのは痛い。

DuplicateRecordFields拡張を用いれば、複数のデータ型で同じフィールド名を採用することも一応許される。しかし、ゲッター関数がどのデータ型に属するか判定するためのマジカルな実装があり、進んで使いたいものではないのが実情である(そのハックを無くす提案が最近受理された *1 )。

忘れがちだが、複数のコンストラクタを持つデータ型においてもレコードの構文は使える。その場合、対応するコンストラクタ以外にはエラーを出す部分関数が生成されるため大変使い勝手が悪く、実質的にないものとして扱われている。

提案

そんな問題を解決するアプローチとして、NoFieldSelectorsという拡張が提案された。

github.com

この拡張を有効にすると、レコードを定義しても、ゲッター関数としては使えなくなるが、レコードの構文としては使える――つまり、短い名前のデメリット(コンフリクト)をなくし、メリット(簡潔なコード)だけを得られるというわけだ。DuplicateRecordFieldsと併用すれば、複数のデータ型で同じフィールド名を気兼ねなく定義できる。

目の上のたんこぶだったゲッター関数の問題を回避できれば、他の言語と遜色ないレコード操作が可能になり、レコード自体の採用率も高まることが予想される。 プレーンなデータ型で起きがちな、変更に伴う破壊や、値の順番を間違えるバグを回避しやすくなり、Haskellの強みの一つであるジェネリクスを使った導出機構を活用できる場面も増える。

さらに、いずれ実装されるであろうRecordDotSyntax(プロポーザル, 日本語の紹介スライド)の実用性を飛躍的に高めるだろう。

要約すると、NoFieldSelectorsは以下のメリットをもたらす。

  • フィールド名に接頭辞を付けなくてよくなる
  • instance FromJSON Fooのように、そのままインスタンスを導出できる場面が増える
  • 今までは単なるバッドプラクティスだった、複数コンストラクタのレコードが実用的になる
  • 害を及ぼす心配なくレコードを導入できる

実装

提案者のSimon Hafner氏により、フラグの追加や試験的な実装が作られ、私が実際に機能する段階まであらかた完成させた。現在はレビュー段階にある。

Implement NoFieldSelectors (!4017) · Merge Requests · Glasgow Haskell Compiler / GHC · GitLab

単に関数の生成をやめればいいかと思いきや、そこまで単純な話ではなかったようだ。各種レコード操作をコンパイルするときの振る舞いは、ゲッター関数の存在を前提としている。それを省いてしまうと、単なるレコードでないデータ型と同じになってしまうのだ。フィールドに相当するシンボルは今まで通り作られるが、項としてコンパイルするときはそれを隠す、というアプローチをとった。この辺りは、DuplicateRecordFieldsなどの機能との兼ね合いで泥臭いものとなったが、Adam Gundry氏の助言のおかげで実装まで持っていくことができた。

このブランチはGHC 9.2までにはマージできるようにしたい。NoFieldSelectorsは、今まで避けようのなかった慣習を覆す機能であり、これが広まればGHC/Haskellという言語の全体像が変わるに違いない。まだ捕らぬ狸の皮算用でしかないが、GHCのレコードの進化を楽しみにしていただきたい。

2021/02/17 追記 Adam Gundry氏がGHCのレコード周りの内部仕様をブラッシュアップしたため、実装をリベースして再投稿していただいた。そしてついに16日、masterにマージされた。

gitlab.haskell.org

将来

PolyKindsやStrictDataと同様、NoFieldSelectorsはモジュール単位でしか振る舞いを制御できない。将来的には、データ型単位で挙動をコントロールしたり、その旨をドキュメントにも反映させるための仕組みが必要であると考えている。

動的配列の無難なHaskell実装

qiita.com

C++、Rust、Pythonなど、他の言語では当たり前のように多用される動的配列だが、Haskell実装は(開発を始めた時点では)見当たらなかったので作ってみたお話*1

動的配列とはミュータブルな配列の一種で、通常の配列操作だけでなく、末尾への要素の追加・削除が定数時間で行える構造である。確保しておいた領域がいっぱいになったら、その2倍の大きさの領域を確保するという方法によって、漸近的には要素の追加は定数時間となる。

内部の配列には、デファクトスタンダードであるvectorパッケージを用いる。Vectorには無印(boxed)、Unboxed、Storableの三種類の変種があり、それぞれ以下のように使い分ける。

  • 無印(Data.Vector): サンク含め、任意のHaskellのオブジェクトを格納できる。Traversableなどのインスタンスであり、汎用性が高い
  • Unboxed (Data.Vector.Unboxed): ポインタを経由せず、要素がメモリ上に連続的に配置される。タプルはfst側の配列とsnd側の配列の二つが内部で作られる。効率が求められるときに使う
  • Storable (Data.Vector.Storable): Storableクラスを通してメモリ上の表現と対応させる。外部のライブラリと連携したい際に有用

それぞれにミュータブル版(.Mutable)のモジュールも存在する。幸運なことに、これらのAPIを共通化するData.Vector.Genericというモジュールがあるので、それを土台として実装していく。完成したのがこれだ。

github.com

hackage.haskell.org

実装のポイント

vectorAPIは、primitiveパッケージによって抽象化されており、IOとSTの違いを吸収できる。こちらもそれに合わせて設計する。

data GVState v s a = GVState !Int !(v s a)

-- | 'Growable' is a dynamic vector based on mutable vector @v@.
newtype Growable v s a = Growable (MutVar s (GVState v s a))

Vectorの実装を表すパラメータv、世界の型を表すパラメータs、要素の型aを引数に持つGrowableを定義する。IORefの一般化であるMutVarに格納し、配列を入れ替える挙動を可能にする。 配列の末尾に要素を追加する操作pushを定義してみよう。

-- | Append an element to the vector (not atomic).
push :: (PrimMonad m, MVector v a) => Growable v (PrimState m) a -> a -> m ()
push (Growable ref) val = do
  GVState len vec <- readMutVar ref
  vec' <- if MV.length vec == len
    then MV.unsafeGrow vec (max 1 len)
    else pure vec
  writeMutVar ref $ GVState (len + 1) vec'
  MV.write vec' len val
{-# INLINE push #-}

定義について特筆すべきことはないが、ここではINLINE化が重要になってくる。インライン化しないと、PrimMonadMVectorも辞書渡しになってしまい、実行時のパフォーマンスに大きな影響を及ぼす。プリミティブな動作を定義するコードでは特に影響を受けやすいため、辞書渡しされないようしっかり対策を忘れないようにしたい。

まとめ

Haskellのエコシステムは、ありそうなものがないということが多々ある。自作する際も、ベストプラクティスをしっかりと押さえ丁寧に実装していきたい。

なお、当初はアトミック(複数のスレッドが同時に実行しても干渉せず正しく動く)なpushを実装する予定だった。アルゴリズムはさほど難しいものではないが*2、BoxedおよびUnboxed Vectorに対するCASを実装する必要があり、時間がなかったため断念した。しかし、役に立つ場面は必ず出てくるはずなのでいずれ実装したい。

追記 バージョン0.0.1で、ロックフリー版のatomicPushとatomicPopを追加した。

*1:改めて確認すると、grow-vector: Mutable vector with efficient appendsというパッケージが最近アップロードされたようだ

*2:Damian Dechev, Peter Pirkelbauer, and Bjarne Stroustrup - Lock-free Dynamically Resizable Arrays

liszt: Append onlyでリーダーとライターが分離されたKVS

adventar.org

以前仕事で使おうとして没になったアイデアを改めて記事にまとめる。

動機

以前書いた記事で説明したものとほとんど一緒である。

fumieval.hatenablog.com

プログラムのログをリアルタイムに監視する仕組みが欲しいが、その仕組みがダウンしても監視対象には影響を及ぼさないようにしたいというのポイントだ。 そのため、ライター側はファイルに書き込み、リーダーはinotifyなどでファイルを監視するという、書き込みにサーバーを必要としない仕組みにした。 さらに、途中でクラッシュしても問題ないよう、ファイルはappend-onlyとし、ファイルの最後にページを書き込む。そのため、ページはなるべく小さくしたい。

ログしたいデータは大きく分けてスナップショットとイベントの二種類あり、内容に応じて20本程度のチャネルに分ける。それぞれのチャネルは、ペイロードのリストからなる。つまり、構造としてはMap Key [Value]のような感じとなる。 これらの点を総合し、Skew binary random access list2-3木に格納することにした。

  • Skew binary random access listは、完全二分木のリストからなる構造で、consは常に定数時間、任意の要素の取り出しが対数時間という特徴がある。
  • 2-3木はB木の特殊な場合で、ノードは2つか3つの子を持つ。

どちらも分岐が少ないため、append-onlyにしたときの空間的なオーバーヘッドが少ない(ただし、読み込むときのシーク回数が多く、パフォーマンスは悪い)。物は試し、さっそく実装してみた。

実装

github.com

バイナリ表現は以下のようになった。KeyおよびPayloadはバイト列で、ファイルに直に書き込む。アスタリスクはポインタを表す。

Node:
    Empty node: 0x00
    1-leaf: 0x01 *Key Spine
    2-leaf: 0x02 *Key Spine *Key Spine
    2-node: 0x12 *Node *Key Spine *Node
    3-node: 0x13 *Node *Key Spine *Node *Key Spine *Node

Spine: Int [Int *Tree]

Tree:
    Tip: 0x80 *Payload
    Bin: 0x81 *Payload *Tree *Tree

ライターのAPIは、モナドを活用したシンプルなものになった。Transactionモナドは、まだ書き込まれていないノードなどを管理しており、commitFileを実行すると内容を一斉に書き込む。

commitFile :: FilePath -> Transaction a -> IO a
insert :: Key -> Builder -> Transaction ()

ノードを表すデータ型を多相化し、各要素は「既にファイルに書き込まれたノード」「まだ書き込んでいないノード」のどちらかを含むStagePointer型で表した。コミットする際に再帰的にStagePointerをファイルのオフセットに変換するというHaskellらしいアプローチができた。

data StagePointer = Commited !RawPointer | Uncommited !(Node StagePointer) deriving Eq

data TransactionState = TS
  { dbHandle :: !LisztHandle
  , currentRoot :: !(Node StagePointer)
  , currentPos :: !Int
  }

type Transaction = StateT TransactionState IO

なお、insertの引数はByteStringではなくBuilderになっているため、アロケーションを抑えながらデータを書き込める。これは標準のBuilderではなく、最強にして最速のビルダー、mason - モナドとわたしとコモナドで紹介した自作のビルダーを使っている。標準にはないhPutBuilderLen関数が書き込んだペイロードのバイト数の取得を可能にしている。

リーダー(サーバー)側の実装には、クロスプラットフォームなファイル監視ライブラリのfsnotify: Cross platform library for file change notification.を使った。 クライアントとサーバーのコミュニケーションのプロトコルにはJSONを採用した。DerivingViaを使ってFromJSONとToJSONのインスタンスを導出するライブラリ、deriving-aesonで簡単に実装できる。 なお、レスポンス部分に関しては、sendfile(ユーザランドを介さずにファイルデスクリプタ同士でデータを転送するシステムコール)を使う都合上単純なバイナリフォーマットにした。

data Offset = SeqNo !Int
  | FromEnd !Int
  deriving (Show, Generic)
  deriving (FromJSON, ToJSON) via CustomJSON '[SumObjectWithSingleField] Offset

data Request = Request
  { reqKey :: !Key
  , reqTimeout :: !Int
  , reqLimit :: !Int
  , reqFrom :: !Offset
  , reqTo :: !Offset
  } deriving (Show, Generic)
  deriving (FromJSON, ToJSON) via PrefixedSnake "req" Request

実際に動かしてみるとこんな感じだ。まず、ライターのAPIを使ってデータベースに書き込む。

*Database.Liszt> :set -XOverloadedStrings
*Database.Liszt> commitFile "msg.liszt" $ insert "message" "hello" >> insert "message" "world" 
*Database.Liszt>

次にサーバーを立ち上げる。

$ cabal run lisztd

雑な作りだがコマンドラインツールも用意している。0番目から1番目までのペイロードを読み出し、改行区切りでターミナルに出力する。

$ cabal run liszt -- msg.liszt message -r 0:1 -f "%p\n"
Up to date
hello
world

無事動作が確認できた。

所感

凝った木構造全般に言えることだが、最も簡単であるはずの2-3木への挿入ですら分岐が多く(https://github.com/fumieval/liszt/blob/master/src/Database/Liszt/Internal.hs#L291)、実装するのに手間がかかった。QuickCheckを活用しながらまずは純粋に実装し、のちに本実装に書き換えるというアプローチをした。 Append onlyなDBMShttps://couchdb.apache.org/という先例がある(cf. The Power of B-trees)。あちらはかなりリッチなAPIを用意しており、実装の複雑さは計り知れない(少なくとも、私一人では実装できる気がしない)。DBというのは往々にしてそういうものなのかもしれない。

自動printfデバッグ

関数をデバッグするために、引数と戻り値をそれぞれ表示するというのを誰しもやったことがあると思う。今回はそれを自動化するからくりをHaskellで実装してみる。

目標となるのは、関数が与えられたとき、その引数と結果をターミナルに出力する関数に変換する高階関数probe :: Traceable a => String -> a -> aである。

testDelay :: Double -> Double -> IO ()
testDelay dur dur' = threadDelay $ round $ (dur + dur') * 1000000
*Probe> probe "testDelay" testDelay 1 2
testDelay 1.0 2.0: ()

これは型クラスを活用すればお茶の子さいさいである。以下のように型によって挙動を切り替える関数withTraceDataを定義すればよい。

  • 関数r -> aは、rの値を文字列にしてリストに積み、aについても再帰的にwithTraceDataを適用する。
  • IOアクションからは結果が返されるとみなし、与えられた引数のリストと結果を表示する。

実装するとこのようになる。

module Probe (Traceable(..), probe) where

import System.IO
class Traceable a where
    withTraceData :: String -- 名前
      -> [String] -- 文字列化した引数
      -> a -> a

instance (Show r, Traceable a) => Traceable (r -> a) where
    withTraceData name args cont arg = withTraceData name
      (showsPrec 11 arg "" : args) -- showsPrecを使うことで適切に括弧を表示する
      (cont arg)

instance Show a => Traceable (IO a) where
    withTraceData name args m = do
        hPutStr stderr $ unwords (name : args) ++ ": "
        hFlush stderr
        a <- m
        hPrint stderr a
        pure a

probe :: Traceable a => String -> a -> a
probe name = withTraceData name []

このままでは純粋な関数には使えないので、unsafePerformIOを使ったインスタンスも作っておこう。

newtype Result a = Result { unResult :: a }
instance Show a => Traceable (Result a) where
    withTraceData name args (Result a) = Result $ unsafePerformIO $ withTraceData name args $ pure a

Traceable Intなどを直接定義せず、まずnewtypeへのインスタンスとして定義するのには理由がある。 Haskellの多引数関数はカリー化されており、「a -> b -> cb -> cを結果として返す関数」でもあるため、どこで区切るかがwell-definedではない。そのため、明示的な型によって区別することは理にかなっている。 さらに、他のプリミティブ型の定義をDerivingViaとStandaloneDerivingによって簡潔に書けるという最近のGHCならではの利点もある。

deriving via Result Bool instance Traceable Bool
deriving via Result Int instance Traceable Int
deriving via Result Double instance Traceable Double
...

小さなコードではあるが、ここで紹介したテクニックは日常で役に立つに違いない。 この手法は色々と応用が利く。例えば、printする代わりにシリアライズして外部のファイルに書き込めば、probe関数を刺して動かすだけでテストケースを抽出できる道具にもなる。

最近やる気が出てきたので、これらのアイデアをそのうちライブラリにまとめるかもしれない。

barbies-thで気軽にHKDを堪能しよう [Haskell AdC 14]

ミーハーな読者なら、barbiesというライブラリをご存知の方も多いと思う。そう、HKDを扱う定番ライブラリだ。HKDは、同アドベントカレンダーにも寄稿されている他、Haskell Dayでも紹介された(https://assets.adobe.com/public/b93f214d-58c2-482f-5528-a939d3e83660)注目の技法だ。Higher-Kinded Data (HKD) について - Qiita

HKDは、一番簡単な場合であるはずのIdentityを使うと着脱が面倒になるという問題がよく知られている。Data.Barbie.BareモジュールのWearという型族を使って定義すれば、それを簡単にはがせ、普通のレコードと全く同じように使える。

data Barbie t f = Barbie
      { name :: Wear t f String
      , age  :: Wear t f Int
      }
instance BareB Barbie
instance FunctorB (Barbie Covered)
instance TraversableB (Barbie Covered)
instance ProductB (Barbie Covered)
instance ConstraintsB (Barbie Covered)
instance ProductBC (Barbie Covered)

bstrip :: b Covered Identity -> b Bare Identity
bcover :: b Bare Identity -> b Covered Identity

とても便利だが、いくつかの不満点が残っている。まずフィールド1つにつきWear t fを被せないといけないのは面倒で、可読性の面でもよくないし、ジェネリクスとはいえインスタンス宣言をずらずら書くのも面倒極まりない。また、Bare関係なしに、フィールドの数が多いとコンパイル時間が増えるばかりか、インライン化に失敗して実行時の効率まで悪化する可能性も高い。20個程度のフィールドを扱うコードで2分以上かかる例もあり、インスタンス定義だけでなくメソッドを使っている場所にも影響する。

こんなことで消耗するくらいなら、全部Template Haskellという爆弾で解決してしまえば良い、というコンセプトで作ったのがbarbies-thだ。使い方は簡単、Template Haskellを有効にし、declareBareB普通のデータ型の定義に被せればよい。

import Data.Barbie.TH

declareBareB [d|
  data Barbie = Barbie
      { name :: String
      , age  :: Int
      }
  |]

すると、あら不思議、何もかもいい感じに揃えてくれる。

data Barbie sw h = Barbie
    { name :: Wear sw h String,
    , age :: Wear sw h Int
    } deriving Generic
instance BareB Foo
instance FieldNamesB (Barbie Covered) where
  bfieldNames = Foo (Const "name") (Const "age")
instance ProductB (Barbie Covered) where ...
instance FunctorB (Foo Covered) where ...
instance TraversableB (Foo Covered)where ...
instance ConstraintsB (Foo Covered)
instance ProductBC (Foo Covered)

主要なインスタンスについても、ジェネリクスではなくTemplate Haskellによって実装を導出しているため、コンパイル時間や最適化に対する心配もいらない。HKD(barbies)を実用する上での障害を一通り解決するというわけだ。おまけとして、全フィールド名をt (Const String)の形で取得できるFieldNamesBというクラスも用意しており、FromJSONなどのインスタンスを定義するのに役立つ。

これからは、ジェネリックプログラミングやテンプレートメタプログラミングを活用し、仕事の半分はデータ型を書くだけで終わらせてしまおう。それでは、Happy higher-kinded holiday!

hackage.haskell.org

最強にして最速のビルダー、mason

Haskell Advent Calendar 2019 5日目

この冬、神速のサンタクロースがやってくる——

Haskellにおいて、バイト列の表現はByteStringが定番である。ByteStringはPinned領域に直接格納され、空間効率はリストに比べればはるかに良い。しかし、Pinned領域にあるとヒープフラグメンテーションが起こりやすくなるということでもあり、細かい文字列をつなぎ合わせるような使い方はパフォーマンスに悪影響が及ぶ。そのような問題を避けるため、ビルダーと呼ばれる構造が用意されている。 Data.ByteString.Builderは、word8 42 <> byteString "hello" <> doubleLE 42のように細かいプリミティブを連結し、toLazyByteStringを呼ぶと最後にByteStringを一気に鋳出せるという仕組みである。ByteStringをちまちま結合するよりも格段に高速であり、waiなどのインターフェイスにも利用されている。

しかし、各パーツをバッファに書き込んでポインタをずらすだけで済む処理にしてはやたら遅い。Builderの実体は、Freeモナドのような再帰的なADTにコンストラクタを重ねる関数であり、構築・分解するオーバーヘッドが大きいのだろう——結局、中間構造を作らないという目的を完全に達成したわけではないのだ。

type BuildStep a = BufferRange -> IO (BuildSignal a)

-- | 'BuildSignal's abstract signals to the caller of a 'BuildStep'. There are
-- three signals: 'done', 'bufferFull', or 'insertChunks signals
data BuildSignal a =
    Done {-# UNPACK #-} !(Ptr Word8) a
  | BufferFull {-# UNPACK #-} !Int {-# UNPACK #-} !(Ptr Word8) (BuildStep a)
  | InsertChunk {-# UNPACK #-} !(Ptr Word8) S.ByteString (BuildStep a)

そのパフォーマンスの問題に目を付けたのがfast-builderで、ポインタやRealWorld(IOモナドの実装に使われるステートトークン)をUnboxedタプルに格納するという徹底的な最適化を施した。

newtype Builder = Builder { unBuilder :: DataSink -> BuilderState -> BuilderState }
type BuilderState = (# Addr#, Addr#, State# RealWorld #)

その結果、標準のビルダーの数倍もの高速化を達成した。fast-builderは、バッファに直接データを書き込むという動作を基本とし、3つのモードをサポートしている。

  • toStrictByteString: 指数関数的に大きくなるバッファにデータを書き込み、StrictなByteStringとして取り出す。
  • toLazyByteString: スレッドを立ち上げ、バッファが満タンになるたびに新しいチャンクを生成することによって、LazyなByteStringを作り出す。
  • hPutBuilder: バッファがいっぱいになるたびに、ハンドルにその内容を書き込む。

3つのモードを実現するために、内部のDataSinkというデータ型に必要な情報をまとめているため、拡張性に乏しいという難点がある。ローレベルな内部構造も拡張の難しさに拍車をかけている。

-- | Specifies where bytes generated by a builder go.
data DataSink
  = DynamicSink !(IORef DynamicSink)
    -- ^ The destination of data changes while the builder is running.
  | GrowingBuffer !(IORef (ForeignPtr Word8))
    -- ^ Bytes are accumulated in a contiguous buffer.
  | HandleSink !IO.Handle !Int{-next buffer size-} !(IORef Queue)
    -- ^ Bytes are first accumulated in the 'Queue', then flushed to the
    -- 'IO.Handle'.

そんな問題を解決するため、新たにmasonというライブラリを作った。

github.com

masonは、ビルダーを実行する手段として4つの関数を提供する。Strict、LazyなByteStringと、ハンドルおよびソケットへの書き込みだ。StrictなByteStringやソケットに使えるというだけでもオリジナルよりかなり便利になったが、ライブラリに変更を加えずとも新しい使い道を定義することもできる。

toStrictByteString :: BuilderFor GrowingBuffer -> B.ByteString
toLazyByteString :: BuilderFor Channel -> BL.ByteString
hPutBuilderLen :: Handle -> BuilderFor PutBuilderEnv -> IO Int
sendBuilder :: S.Socket -> BuilderFor SocketEnv -> IO Int

そのからくりは型パラメータにある。Builderの中身は、バックエンドに応じた値と、バッファへのポインタをBuffer型として受け取り、何らかのアクションを実行して返すという至極単純なものだ。

data BuilderFor s = Builder { unBuilder :: s -> Buffer -> IO Buffer }

data Buffer = Buffer
  { bEnd :: {-# UNPACK #-} !(Ptr Word8) -- ^ end of the buffer (next to the last byte)
  , bCur :: {-# UNPACK #-} !(Ptr Word8) -- ^ current position
  }

type Builder = forall s. Buildable s => BuilderFor s

Buildableクラスを通して、目的に合わせた処理を具現化している。

class Buildable s where
  byteString :: B.ByteString -> BuilderFor s
  flush :: BuilderFor s
  allocate :: Int -> BuilderFor s

StrictなByteStringを生成する場合、allocate nは現在の倍以上かつn以上の長さのバッファを作るアクションで、flushは何もしない。byteStringは与えられたバイト列をバッファにコピーする関数となる。ハンドルに書き込む場合、flushは現在のバッファの中身をハンドルに落とし、byteStringの引数が大きい場合はバッファを介さずに直接書き込む——というように、バックエンドに合わせた処理を実装している。

これらのメソッドが与えられると、ensureという関数が定義できる。ensure nは、バッファにnバイト以上の余裕があることを保証して関数を呼び出し、足りない場合はその前に領域を確保する。実質的にはこれがBuilderのスマートコンストラクタであり、新たな部品を作ることを容易にしている。

ensure :: Int -> (Buffer -> IO Buffer) -> Builder
ensure mlen cont = Builder $ \env buf@(Buffer end ptr) ->
  if ptr `plusPtr` mlen >= end -- 現在のバッファに収まらない?
    then do
      buf'@(Buffer end' ptr') <- unBuilder flush env buf -- 一度バッファを流してみる
      if mlen <= minusPtr end' ptr' -- それでも収まらない?
        then cont buf'
        else unBuilder (allocate mlen) env buf' >>= cont -- 新たな領域を確保する
    else cont buf

このようなチェックをいちいち実行するのは無駄だが、ensureはモノイドの準同型写像であるため、融合変換によって一つにまとめることができる。最適化が理想的に回れば、可変長の要素がある時だけ空きがチェックされるようにコンパイルされるはずだ。flushやallocateなどが呼ばれるタイミングが変わってしまう半グレ的な最適化だが、まさに必要な振る舞いなので仕方がない。

{-# INLINE[1] ensure #-}
{-# RULES "<>/ensure" forall m n f g.
  ensure m f <> ensure n g = ensure (m + n) (f >=> g) #-}

masonは基本的に最適化が鬼回りする前提で設計されているので、インライン化を怠ったり、中途半端な場所に保存したりすると最高のパフォーマンスが発揮できない点には注意する必要がある。

ベンチマーク

長々とテクニックをひけらかしたところで、実際遅かったら意味がない。fast-builderのJSONデータを扱うベンチマークを拝借し、Textのエンコード方法などを少し改良して比較してみた*1

mason/hPutBuilder                        mean 187.6 μs  ( +- 14.02 μs  )
fast-builder/hPutBuilder                 mean 366.5 μs  ( +- 50.78 μs  )
bytestring/hPutBuilder                   mean 294.3 μs  ( +- 83.62 μs  )
mason/toStrictByteString                 mean 105.1 μs  ( +- 23.33 μs  )
fast-builder/toStrictByteString          mean 223.1 μs  ( +- 7.506 μs  )
bytestring/toLazyByteString              mean 249.3 μs  ( +- 16.76 μs  )
mason/toLazyByteString                   mean 101.9 μs  ( +- 4.787 μs  )
fast-builder/toLazyByteString            mean 226.4 μs  ( +- 10.56 μs  )

圧勝である。bytestringやfast-builderの倍以上と、大変満足のいく結果だ。元のベンチマークのようにTextを一旦Data.Text.Encoding.encodeUtf8で変換すると差は若干縮まるが、それでも最速であることに変わりはない。

fast-builder/hPutBuilder                 mean 372.2 μs  ( +- 68.48 μs  )
bytestring/hPutBuilder                   mean 603.6 μs  ( +- 641.7 μs  )
mason/toStrictByteString                 mean 215.4 μs  ( +- 71.29 μs  )
fast-builder/toStrictByteString          mean 302.2 μs  ( +- 78.57 μs  )
bytestring/toLazyByteString              mean 498.3 μs  ( +- 154.5 μs  )
mason/toLazyByteString                   mean 196.2 μs  ( +- 10.76 μs  )
fast-builder/toLazyByteString            mean 230.7 μs  ( +- 17.19 μs  )
bytestring/toLazyByteString              mean 381.3 μs  ( +- 18.35 μs  )

fumieval.hatenablog.com

wineryのビルダーをfast-builderからmasonに差し替え、ベンチマークを実行した。

serialise/list/winery/old                    mean 223.2 μs  ( +- 16.28 μs  )
serialise/list/winery/new              mean 119.8 μs  ( +- 21.57 μs  )
serialise/list/binary                    mean 1.597 ms  ( +- 394.7 μs  )
serialise/list/cereal                    mean 747.0 μs  ( +- 196.5 μs  )
serialise/list/serialise                 mean 494.4 μs  ( +- 126.2 μs  )
serialise/list/store                     mean 50.83 μs  ( +- 4.517 μs  )
serialise/list/aeson                     mean 7.403 ms  ( +- 1.628 ms  )
serialise/item/winery/old               mean 234.3 ns  ( +- 18.57 ns  )
serialise/item/winery/new                mean 62.61 ns  ( +- 4.216 ns  )
serialise/item/binary                    mean 1.738 μs  ( +- 383.9 ns  )
serialise/item/cereal                    mean 709.8 ns  ( +- 223.7 ns  )
serialise/item/serialise                 mean 583.1 ns  ( +- 132.6 ns  )
serialise/item/store                     mean 60.91 ns  ( +- 14.96 ns  )
serialise/item/aeson                     mean 8.440 μs  ( +- 5.778 μs  )

圧倒的に速い!Textをメモリ表現のまま扱うstoreと比較すると、UTF-8エンコードするwineryには幾らかのハンデがあるが、各要素のエンコードに関してはstoreと同等の記録を出している。

bytestringにも包括的なベンチマークが付属しているので現在取り組んでいる。まだ作業中だが、ぶっちぎりで速いことに疑いの余地はない。

ここからはおまけ。Grisu3というアルゴリズム浮動小数点数の表示を高速化するプルリクエストがbytestringに送られていたが、長年放置されていた(Reimplement floatDec/doubleDec by winterland1989 · Pull Request #115 · haskell/bytestring · GitHub)のでどのくらい速くなるか試してみた。その差、実に22倍である。

mason/double                             mean 138.0 ns  ( +- 58.45 ns  )
fast-builder/double                      mean 2.379 μs  ( +- 231.6 ns  )
bytestring/double                        mean 3.033 μs  ( +- 813.4 ns  )

また、文字列リテラルをStringを介さずに扱う変更([RFC] Builder: Efficiently handle literal strings by bgamari · Pull Request #132 · haskell/bytestring · GitHub)も放置されていたので、同等のものをこちらで実装した。派手な差はないが確実に速くなっている。

mason/literal                            mean 599.2 ns  ( +- 249.7 ns  )
fast-builder/literal                     mean 759.4 ns  ( +- 165.2 ns  )
bytestring/literal                       mean 640.1 ns  ( +- 16.93 ns  )

まとめ

masonは、高い抽象度を保ちつつも効率がよく、拡張性も確保されている、ある意味Haskellらしいライブラリだ。2020年の世界標準を目指し、さらに磨きをかけていきたい。

hackage.haskell.org