北海道苫小牧市出身の初老PGが書くブログ

永遠のプログラマを夢見る、苫小牧市出身のおじさんのちらしの裏

Data.Vaultの非GHC実装

ふと、 Data.Vault ってどうやって実装してるんだろと中身を覗いていたら、なんかすごいものを見つけた。

vault/IORef.hs at 39cf64b47c24b83c24924d47d2385f8213a3f322 · HeinrichApfelmus/vault · GitHub

今はほぼ GHC 一択なのでこの実装を使っている人はほとんどいないんだろうけど、 issue を読む限り UHC 向けに実装されたもののようだ。

Vault の定義を見ると、一瞬ぎょっとなる。

data Locker s = Locker !Unique (IO ())
newtype Vault s = Vault (Map Unique (Locker s))

まさかの IO () なんだが。どうしてこれで値を保存できるかというと、 Key の方に IORef があるからである。

data Key s a  = Key    !Unique (IORef (Maybe a))
unlock (Key k ref) (Locker k' m)
    | k == k' = unsafePerformIO $ do
        m
        readIORef ref     -- FIXME: race condition!
    | otherwise = Nothing
lookup key@(Key k _)   (Vault m) = unlock key =<< Map.lookup k m

lookup すると、 Vault に保存されている IO ()unsafePerformIO で実行した上で IORef から値を読むことになる。ここまで来るともう察しが付くように、 insert はこのように IORef に値を書き込む IO アクションを保存している。

lock (Key u ref) x = Locker u $ writeIORef ref $ Just x
insert key@(Key k _) x (Vault m) = Vault $ Map.insert k (lock key x) m

こうすることで、 Vault の値の型を IO () 単一に固定しつつ、 Key a 側の型 a の値を読めるようになっている。この発想はなかった。ただ、だいぶ雑に IORef を読み書きしているので、まあ、レースコンディションになるわなって感じではある。

ちなみに、 GHC 向けの実装は GHC.Exts.Any を使った平和な実装になっている。知りたかったのはこっちだ。

vault/GHC.h at 39cf64b47c24b83c24924d47d2385f8213a3f322 · HeinrichApfelmus/vault · GitHub