Concurrent Clean : Re: 参照型

[id:lethevert:20070426:p5]で作った参照型を使って、ログ機能を作る。

log :: !(*File->*File) !(.b,!*(Ref *File)) -> (.b, !*(Ref *File))
log f (b,rf) = (b, apply f rf)

というログ関数を作っておいて、（ちょっと関数名をかえて、整理した）

Start w
    # (_,f,w) = fopen "log.txt" FWriteText w
      (rf1,rf2,rf) = copy3 $ refer f
      (ri1,ri2) = copy $ refer 1
      ls1 = process 1 ri1 rf1
      ls2 = process 2 ri2 rf2
      ls = interleave ls1 ls2
      ((_,w),rf) = access (close w) rf
    = (take 10 ls, w)

close w f
    # ret = fclose f w
    = (ret,file 0)
  where
    file :: !Int -> *File
    file i = code {
               push_b 0
           }

process a ri rf
    # ((e,rf),ri) = access (f rf) ri
    = [e:process a ri rf]
  where
    f rf i = let ia = i+a in (log (p i ia) (i,rf),ia)
    p i ia f = f $> i $> "->" $> ia $> newline

interleave [a:aa] bb
    = [a:interleave bb aa]

とすると、log.txtにログが取られる。

      • -

ところで、これは評価順序が実装に依存している。

    = (take 10 ls, w)

のところを

    = (w, take 10 ls)

とすると、closeが先に呼ばれるので、ログがlog.txtに出力されない。
なので、これを正しく制御できるようにするには（#!で制御してもよいが）、適当な補助関数を作ってあげるとよいと思う。

a before b = (a,b) // まずaを評価し、次にbを評価する
a after b  = (a,b) // まずbを評価し、次にaを評価する

のようなのを作っておいて、

    = take 10 ls
      before w

としておくのがよい。

      • -

ちなみに、file 0としている場合は標準エラー出力に出力されて、file 1としている場合は標準出力に出力されるようだ。しかし、これはたまたまで、Segmentation faultになってもおかしくない。（file 2とすれば、Segmentation faultになる）