ふと、 Data.Vault ってどうやって実装してるんだろと中身を覗いていたら、なんかすごいものを見つけた。
vault/IORef.hs at 39cf64b47c24b83c24924d47d2385f8213a3f322 · HeinrichApfelmus/vault · GitHub
今はほぼ GHC 一択なのでこの実装を使っている人はほとんどいないんだろうけど、 issue を読む限り UHC 向けに実装されたもののようだ。
- Variant that uses no GHC-specific extensions / functions · Issue #5 · HeinrichApfelmus/vault · GitHub
- Add "pure" implementation. Make GHC implementation conditional on __G… · HeinrichApfelmus/vault@0d453b7 · GitHub
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