Concurrent Clean : Genericはすごい

Haskellで言うところのdeepSeqを定義することを考えていました。で、classで定義すると、任意のデータ型に対していちいち同じような関数を再定義し直さなければいけないので面倒なのですが、Genericを使うことでその手間を大幅に節約することができます。
下がGenericを利用したdeepSeqの定義です。

deepSeq :== gDeepSeq{|*|}

generic gDeepSeq a :: !.a !.w -> (!.a,!.w)
gDeepSeq {|Int|}          a            w = (a,w)
gDeepSeq {|Real|}         a            w = (a,w)
gDeepSeq {|Char|}         a            w = (a,w)
gDeepSeq {|Bool|}         a            w = (a,w)
gDeepSeq {|UNIT|}         a            w = (a,w)
gDeepSeq {|{}|}     f     a            w = seqArray f a w
gDeepSeq {|{!}|}    f     a            w = (a,w)
gDeepSeq {|{#}|}    f     a            w = (a,w)
gDeepSeq {|PAIR|}   fx fy (PAIR a1 a2) w # (a1,w) = fx a1 w
                                           (a2,w) = fy a2 w
                                         = (PAIR a1 a2,w)
gDeepSeq {|EITHER|} fl fr (LEFT a)     w # (a,w) = fl a w
                                         = (LEFT a,w)
gDeepSeq {|EITHER|} fl fr (RIGHT a)    w # (a,w) = fr a w
                                         = (RIGHT a,w)
gDeepSeq {|CONS|}   f     (CONS a)     w # (a,w) = f a w
                                         = (CONS a,w)
gDeepSeq {|FIELD|}  f     (FIELD a)    w # (a,w) = f a w
                                         = (FIELD a,w)
gDeepSeq {|OBJECT|} f     (OBJECT a)   w # (a,w) = f a w
                                         = (OBJECT a,w)

seqArray f ar0 w = seqArray 0 ar1 w
  where
    (s,ar1) = usize ar0
    seqArray i ar w | i >= s = (ar,w)
    seqArray i ar w          # (a,ar) = unsafeUselect ar i
                               (_,w) = f a w
                             = seqArray (inc i) ar w

暗号のようなこの定義を書いておけば、下のようにderiveを書くだけで新しい型に対応できます。

derive gDeepSeq [], A

::A a b = A a b

Start :: *World -> *World
Start w # (_,w) = deepSeq ls1 w
          (_,w) = deepSeq ls2 w
          (_,w) = deepSeq ar1 w
          (_,w) = deepSeq ar2 w
          (_,w) = deepSeq ar3 w
          (_,w) = deepSeq lsA w
        = w
  where
    ls1 = [trace "A" 1
          ,trace "B" 2
          ,trace "C" (trace "D" 3 + trace "E" 4)
          ]
    ls2 = [trace "F" 'a'
          ,trace "G" 'b'
          ,trace "H" (trace "I" 'A' + trace "J" 'A')
          ]
    ar1 = asArray
          {trace "K" 1
          ,trace "L" 2
          ,trace "M" (trace "N" 3 + trace "O" 4)
          }
    ar2 = asUnboxedArray
          {trace "P" 1
          ,trace "Q" 2
          ,trace "R" (trace "S" 3 + trace "T" 4)
          }
    ar3 = asString
          {trace "U" '1'
          ,trace "V" '2'
          ,trace "W" (trace "X" '3' + trace "Y" '4')
          }
    lsA = [A (trace "Z" 1) 1
          ,A (trace "a" 2) 2
          ,A (trace "b" (trace "c" 1 + trace "d" 2)) 3
          ]

なお、gDeepSeq{|(->)|}を定義できないので、部分適用型に対しては適用できないです。（マジックプログラミングを調査中なのですが・・・）