las3r (2)

2008.12.5

las3r、Clojure(むしろLisp)がよく分からないまま手探りで弄っています。便利だと思ったのが、アリティによる多重定義と、暗黙のdestructuring-bind(アンパック代入みたいなもん?)。

以下は0〜2個の引数を取るMath.random:

(defn rand
  ([] ((. Math random)))
  ([n] (* n (rand)))
  ([a b]
    (if (< a b)
      (+ a (rand (- b a)))
      (+ b (rand (- a b))))))

(rand -1 1) ;=> -0.689156367443502

要は引数のパターンに応じた振り分けと同時に変数束縛されるようですが、これが再帰関数の場合には特に便利で、例えばリストをペアに区切ったリストにして返す手続きは:

(defn pairs [l]
  (apply
    (fn
      ([x] (list (list x)))
      ([x y] (list (list x y)))
      ([x y & z] (cons (list x y) (pairs z))))
  l))

(pairs '(1 2 3 4 5)) ;=> ((1 2) (3 4) (5))

ところで、las3rでは{:x 200 :y 400 :time 0.5}と書くと内部的にはMapというオブジェクトになってしまうようなので、Tweener.addTweenの第二引数に渡せません。MapからObjectへ変換するそれらしき関数も見つからなかったので、試しにObjectリテラルに近い書き方ができるマクロを書いてみると:

(defmacro obj [& elts]
  (let [o (gensym)]
    `(let [~o (new Object)]
      ;;fnやletのパラメータはdestructuring-bindされる雰囲気。
      ~@(map (fn [[var exp]] `(set! (. ~o ~var) ~exp)) (pairs elts))
    ~o)))

(macroexpand-1 '(obj x 200 y 400 time 0.5))
;=>
;(las3r/let [G__1378 (new Object)]
;  (set! (. G__1378 x) 200)
;  (set! (. G__1378 y) 400)
;  (set! (. G__1378 time) 0.5)
;  G__1378)

(obj x 200 y 400 time 0.5) ;=> [object Object]

これで以下のようにだらだらと書かなくて済みます。

(. Tweener
  (addTween
    movie-clip
    (let o (new Object)
      (set! (. o x) 200)
      (set! (. o y) 400)
      (set! (. o time) 0.5)
      o)))

クリックすると画面上をランダムに移動する四角形はこんな雰囲気:

(import '(flash.display Sprite Graphics)
        '(caurina.transitions Tweener))

(def s ((. *stage* addChild) (new Sprite)))

(doto (. s graphics)
  (beginFill 0x0000ff 1)
  (drawRect 0 0 100 100)
  (endFill))

(. s
  (addEventListener "click"
    (fn []
      (. Tweener (addTween
        s
        (obj x (rand (. *stage* width))
             y (rand (. *stage* height))
             time 0.5))))))

最後に衝撃のfib(25)の時間比較:

  • ABC
    => 88 msec
  • AS3
    => 125 msec
  • las3r
    => 5465 msec
  • SICP4.1.7をASに移植したもの(比較用)
    => 11255 msec

なるほど・・・。
まだきっと伸びしろはありますよね!
速くなるといいなぁ。。

なお、計測の対象は以下の関数:

AS3:

private function fib(n:uint):uint {
  return (n < 2) ? n : fib(n - 1) + fib(n - 2);
}

ABC(hxasmを使用):

var ctx:Context = new Context();
ctx.beginClass("Main");
var tint:Index = ctx.type("int");
var m:* = ctx.beginMethod("fib", [tint], tint);
m.maxStack = 3;
ctx.ops([
  OpCode.OReg(1),
  OpCode.OSmallInt(1),
]);
var j:Function = ctx.jump(JumpStyle.JGt);
ctx.ops([
  OpCode.OReg(1),
  OpCode.ORet,
]);
j();
ctx.ops([
  OpCode.ODecrIReg(1),
  OpCode.OThis,
  OpCode.OReg(1),
  OpCode.OCallProperty(ctx.property("fib"),1),
  OpCode.ODecrIReg(1),
  OpCode.OThis,
  OpCode.OReg(1),
  OpCode.OCallProperty(ctx.property("fib"),1),
  OpCode.OOp(Operation.OpAdd),
  OpCode.ORet,
]);
ctx.finalize();

var o:Output = new Output();
Writer.write(o, ctx);
var swf:ByteArray = o.getBytes();

var loader:Loader = new Loader();
loader.contentLoaderInfo.addEventListener(Event.COMPLETE, function(evt:Event):void {
  var klass:Class = ApplicationDomain.currentDomain.getDefinition('Main') as Class;
  callback(new klass().fib); //この引数がコンパイル済みfib
});
loader.loadBytes(swf, new LoaderContext(false, ApplicationDomain.currentDomain));

las3r:

var rt:RT = new RT(stage, new OutputStream(trace), new OutputStream(trace));
rt.loadStdLib();
rt.evalStr(
  '(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) fib',
  callback //fnを評価するとコンパイル済みfibがcallbackに渡る
);

SICP4.1.7をASに移植したもの:

var fib:Function =
  eval("(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) fib");

/*evalの定義は長いので略*/