Scheme 的多値の実装

擬似的なものですが、Scheme の多値の受け渡しの仕組みを実装してみました。このようなものです:

call_with_values(
  function(){ values(1, 2, 3) },
  function(a, b, c){
    // a == 1, b == 2, c == 3
  }
);

call_with_values の第一引数は多値を返す関数で、第二引数はそれを受け取る関数です。

多値と言っても JavaScript ですのでただの配列なんですが、それを関数に渡す際にばらしてやることで、擬似的に多値を実現することが出来るわけです。

実装はこんな感じです:

function values() {
  return list_tail(arguments, 0);
  // Or, return Array.prototype.slice.call(arguments);
}

function call_with_values(producer, consumer) {
  return apply(consumer, producer());
  // Or, return consumer.apply(null, producer());
}

(list_tail, apply 等サポート関数群は最後にあります)

要は Function#apply のラッパーに過ぎないんですが、関数間の配列の受け渡しがより簡潔に書けるようになるという点で JavaScript 的にも有用なんじゃないかと思います。

試しに http://www.scheme.com/tspl3/control.html#./control:h7 から:

(define split
  (lambda (ls)
    (if (or (null? ls) (null? (cdr ls)))
        (values ls '())
        (call-with-values
          (lambda () (split (cddr ls)))
          (lambda (odds evens)
            (values (cons (car ls) odds)
                    (cons (cadr ls) evens)))))))

リストを奇数項と偶数項に分割する関数 split を移植してみます。

function split(ls) {
  return (nullp(ls) || nullp(cdr(ls)))
      ? values(ls, nil())
      : call_with_values(
          function(){ return split(cddr(ls)) },
          function(odds, evens){
            return values(cons(car(ls),  odds),
                          cons(cadr(ls), evens));
          }
        );
}

// テスト
call_with_values(
  function(){ return split(list(1,2,3,4,5,6)) },
  function(a,b){ alert(a); alert(b) }
);
// -> 1,3,5
//    2,4,6

まったくの直訳なんですが、上手く行っているようです。

サポート関数群:

var dot,undot;
new function() {
  var _ = {toString: function(){return "."}};

  dot = function(x) {
    return listp(x) ? x : list(_, x);
  };
  undot = function(ls) {
    return eqp(car(ls), _) ? cadr(ls) : ls;
  };
};

function nil() {
  return [];
}

function cons(x,ls) {
  (ls = ls.unshift ? [].concat(ls) : dot(ls)).unshift(x);
  return ls;
}

function car(ls) {
  return ls[0];
}
function cdr(ls) {
  (ls = [].concat(ls)).shift();
  return undot(ls);
}
function caar(ls) {
  return car(car(ls));
}
function cdar(ls) {
  return cdr(car(ls));
}
function cadr(ls) {
  return car(cdr(ls));
}
function cddr(ls) {
  return cdr(cdr(ls));
}
function caddr(ls) {
  return car(cddr(ls));
}

function list() {
  return Array.prototype.slice.call(arguments);
}

function append(a,b) {
  return (a||nil()).concat(b);
}

function list_tail(ls, k) {
  ls = list.apply(null, ls).slice(k||0);
  return undot(ls);
}

function not(p) {
  return !p;
}

function eqp(a,b) {
  return a==b;
}

function nullp(ls) {
  return ls == null || ls == undefined ||
        (ls instanceof Array) && ls.length == 0;
}
function pairp(ls) {
  return (ls instanceof Array) && ls.length > 0;
}
function listp(ls) {
  return (ls instanceof Array) && (ls.length == 0 || listp(cdr(ls)));
}

function for_each(f, ls) {
  var more = list_tail(arguments, 2);
  return nullp(more) ? for_each1(f, ls)
                     : for_each2(f, cons(ls, more))
}
function for_each1(f, ls) {
  if (not(nullp(ls))) {
    f(car(ls));
    for_each1(f, cdr(ls));
  }
}
function for_each2(f, ls) {
  if (not(any1(nullp, ls))) {
    apply(f, map1(car, ls));
    for_each2(f, map1(cdr, ls));
  }
}

function map(f, ls) {
  var more = list_tail(arguments,2);
  return nullp(more) ? map1(f, ls)
                     : map2(f, cons(ls, more));
}

function map1(f, ls) {
  return nullp(ls) ? nil()
       : cons(f(car(ls)), map1(f, cdr(ls)));
}

function map2(f, ls) {
  return any1(nullp, ls) ? nil()
       : cons(apply(f, map1(car, ls)),
              map2(f, map1(cdr, ls)));
}

function any(pred, ls) {
  var more = list_tail(arguments,2);
  return nullp(more) ? any1(pred, ls)
                     : any2(pred, cons(ls, more));
}

function any1(pred, ls) {
  return nullp(ls) ? false
       : pred(car(ls)) || any1(pred, cdr(ls));
}

function any2(pred, ls) {
  return any1(nullp, ls) ? false
       : apply(pred, map1(car, ls)) || any2(pred, map1(cdr, ls));
}

function apply(f, ls) {
  if (not(pairp(ls)))
    ls = accumulate(function(a, b) {
                      return a.callee ? append(list_tail(a,0), b) // arguments->list
                           : pairp(a) ? append(a, b)
                           : cons(a, b);
                    },
                    nil(),
                    list_tail(arguments, 1));

  function wrap(f) {
    return f.apply ? f
         : function() {
             function r(ls, n) {
               return nullp(ls) ? nil()
                    : cons("arguments[" + n + "]", r(cdr(ls), n+1));
             }
             return eval("(f(" + r(list_tail(arguments,0), 0).join(",") + "))");
           };
  }
  return wrap(f).apply(null, ls);
}

function accumulate(op, initial, ls) {
  var more = list_tail(arguments,3);
  return pairp(more)
    ? accumulate_n(op, initial, cons(ls, more))
    : accumulate_1(op, initial, ls);
}
function accumulate_1(op, initial, ls) {
  return nullp(ls) ? initial
       : op(car(ls), accumulate_1(op, initial, cdr(ls)));
}
function accumulate_n(op, initial, ls) {
  return any(nullp, ls) ? nil()
       : cons(accumulate_1(op, initial, map(car, ls)),
              accumulate_n(op, initial, map(cdr, ls)));
}