Concurrent Clean : 例外処理

以下のようなコードがある。

retcode = OK;
if (socket.read(name) != OK) {
  retcode = BAD_READ;
}
else {
  processName(name);
  if (socket.read(address) != OK) {
    retcode = BAD_READ;
  }
  else {
    processAddress(address);
    if (socket.read(telNo) != OK) {
      retcode = BAD_READ;
    }
    else {
      //などなど\ldots
    }
  }
}

これは、達人プログラマー―システム開発の職人から名匠への道のp.128からの転載だが、このようなコードは、普通の手続き的な言語では、例外を使って処理するのが一般的だろう。（実際、出典元では、このコードを例外処理の説明に使っていた）
しかし、上の処理、よく見ると似たようなプロセスの繰り返しになっていることが分かる。つまり、

if (socket.read(xxx) != OK) {
  retcode = BAD_READ;
}
else {
  processYYY(xxx);

という処理がワンセットで、これを必要な数だけ繰り返している。しかも、xxxはただの変数なので、置き換わっているのは、processYYYという手続きだけ。ということは、これは、関数型言語なら、リスト処理として書けるということだ。
ということで、Cleanで書き下してみた。ここから、さらにパターンを抽出すれば、便利関数を増やせるかもしれない。

id :: u:a -> v:a, [u <= v]
id a = a

::*Socket
read :: *Socket -> (Bool, String, *Socket)

processName :: String *World -> *World
processAddress :: String *World -> *World
//などなど\ldots

processAll :: *World -> (Bool, *World)
processAll w
    # (sock, w) = openSocket w
    # (ps, rs, sock) = mapUwhile (map read_process processes) sock
    # w = closeSocket sock w
    = case rs of
        [] = (True, reelU ps w)
        _  = (False, w)
  where
    processes :: [(String *World -> *World)]
    processes = [processName
                ,processAddress
                //などなど\ldots
                ]

    read_process (String *World -> *World) *Socket -> (Bool, (*World -> *World), *Socket)
    read_process proc sock
        # (ok, str, sock) = read sock
        = (ok, if ok (proc str) id, sock)

processAllは、以下のように書くこともできると思う。ただし、上と下とでは動作が若干違う。

processAll w
    # (sock, w) = openSocket w
    # (w, (ok, rs, sock)) = sock --> foldU (\w p = p w) w
                                       $ mapUwhile (map read_process processes)
    # w = closeSocket sock w
    = case rs of
        [] = (True, w)
        _  = (False, w)