`(Hello ,world)

ツッコミ、添削大歓迎です。いろいろ教えてください。

2008-05-01

The 90 Minute Scheme to C compiler

08:38

higepon氏が紹介していたUr-Schemeをつらつら見てたら、The 90 Minute Scheme to C compilerを見て作ったとかなんとか書いてある。

じゃあそいつを試してみようと、ソースを落としてみた。Gaucheに食わせると、いきなり頭の

(define-type ast
  extender: define-type-of-ast
  subx) ; the asts of the sub-expressions

で、define-type がないとかで怒られる。しかたないのでコメントに書いてあるように、Gambit-C を使うようにして、テストのソースを食わせてみる。

test1.scm

(define square
  (lambda (x)
    (* x x)))

(+ (square 5) 1)

コンパイルしてみる:

$ ./90-min-scc.scm test1.scm
-------------------------- AST:
(begin (set! square (lambda (x.1) (%* x.1 x.1))) (%+ (square 5) 1))
-------------------------- AST AFTER CPS-CONVERSION:
(let ((r.5 (lambda (k.6 x.1) (k.6 (%* x.1 x.1)))))
  (let ((r.3 (set! square r.5)))
    (square (lambda (r.4) (let ((r.2 (%+ r.4 1))) (%halt r.2))) 5)))
-------------------------- AST AFTER CLOSURE-CONVERSION:
(lambda ()
  (let ((r.5 (%closure
              (lambda (self.7 k.6 x.1)
                ((%closure-ref k.6 0) k.6 (%* x.1 x.1))))))
    (let ((r.3 (set! square r.5)))
      ((%closure-ref square 0)
       square
       (%closure (lambda (self.8 r.4) (let ((r.2 (%+ r.4 1))) (%halt r.2))))
       5))))
-------------------------- C CODE:
case 0: /* (lambda () (let ((r.5 (%closure (lambda (self.7 k.6 x.1) ... */

 BEGIN_CLOSURE(1,0); END_CLOSURE(1,0);
 PUSH(LOCAL(0/*r.5*/)); GLOBAL(0/*square*/) = TOS();
 PUSH(GLOBAL(0/*square*/));
 BEGIN_CLOSURE(2,0); END_CLOSURE(2,0);
 PUSH(INT2OBJ(5));
 BEGIN_JUMP(3); PUSH(LOCAL(2)); PUSH(LOCAL(3)); PUSH(LOCAL(4)); END_JUMP(3);

case 2: /* (lambda (self.8 r.4) (let ((r.2 (%+ r.4 1))) (%halt r.2))) */

 PUSH(LOCAL(1/*r.4*/)); PUSH(INT2OBJ(1)); ADD();
 PUSH(LOCAL(2/*r.2*/)); HALT();

case 1: /* (lambda (self.7 k.6 x.1) ((%closure-ref k.6 0) k.6 (%* x.... */

 PUSH(LOCAL(1/*k.6*/));
 PUSH(LOCAL(2/*x.1*/)); PUSH(LOCAL(2/*x.1*/)); MUL();
 BEGIN_JUMP(2); PUSH(LOCAL(3)); PUSH(LOCAL(4)); END_JUMP(2);

コンパイル出力結果:

#define NB_GLOBALS 1
#define MAX_STACK 100

#include <stdio.h>
#include <stdlib.h>

#define HEAP_SIZE 1000000

typedef int obj;

obj global[NB_GLOBALS];
obj stack[MAX_STACK];
obj heap[HEAP_SIZE];

#define INT2OBJ(n) ((n) << 1)
#define OBJ2INT(o) ((o) >> 1)

#define PTR2OBJ(p) ((obj)(p) + 1)
#define OBJ2PTR(o) ((obj*)((o) - 1))

#define FALSEOBJ INT2OBJ(0)
#define TRUEOBJ INT2OBJ(1)

#define GLOBAL(i) global[i]
#define LOCAL(i) stack[i]
#define CLOSURE_REF(self,i) OBJ2PTR(self)[i]

#define TOS() sp[-1]
#define PUSH(x) *sp++ = x
#define POP() *--sp

#define EQ() { obj y = POP(); TOS() = INT2OBJ(TOS() == y); }
#define LT() { obj y = POP(); TOS() = INT2OBJ(TOS() < y); }
#define ADD() { obj y = POP(); TOS() = TOS() + y; }
#define SUB() { obj y = POP(); TOS() = TOS() - y; }
#define MUL() { obj y = POP(); TOS() = OBJ2INT(TOS()) * y; }
#define DISPLAY() printf ("%d", OBJ2INT(TOS()))
#define HALT() break

#define BEGIN_CLOSURE(label,nbfree) if (hp-(nbfree+1) < heap) hp = gc (sp);
#define INICLO(i) *--hp = POP()
#define END_CLOSURE(label,nbfree) *--hp = label; PUSH(PTR2OBJ(hp));

#define BEGIN_JUMP(nbargs) sp = stack;
#define END_JUMP(nbargs) pc = OBJ2PTR(LOCAL(0))[0]; goto jump;

obj *gc (obj *sp) { exit (1); } /* no GC! */

obj execute (void)
{
  int pc = 0;
  obj *sp = stack;
  obj *hp = &heap[HEAP_SIZE];

  jump: switch (pc) {

case 0: /* (lambda () (let ((r.5 (%closure (lambda (self.7 k.6 x.1) ... */

 BEGIN_CLOSURE(1,0); END_CLOSURE(1,0);
 PUSH(LOCAL(0/*r.5*/)); GLOBAL(0/*square*/) = TOS();
 PUSH(GLOBAL(0/*square*/));
 BEGIN_CLOSURE(2,0); END_CLOSURE(2,0);
 PUSH(INT2OBJ(5));
 BEGIN_JUMP(3); PUSH(LOCAL(2)); PUSH(LOCAL(3)); PUSH(LOCAL(4)); END_JUMP(3);

case 2: /* (lambda (self.8 r.4) (let ((r.2 (%+ r.4 1))) (%halt r.2))) */

 PUSH(LOCAL(1/*r.4*/)); PUSH(INT2OBJ(1)); ADD();
 PUSH(LOCAL(2/*r.2*/)); HALT();

case 1: /* (lambda (self.7 k.6 x.1) ((%closure-ref k.6 0) k.6 (%* x.... */

 PUSH(LOCAL(1/*k.6*/));
 PUSH(LOCAL(2/*x.1*/)); PUSH(LOCAL(2/*x.1*/)); MUL();
 BEGIN_JUMP(2); PUSH(LOCAL(3)); PUSH(LOCAL(4)); END_JUMP(2);

  }
  return POP();
}

int main () { printf ("result = %d\n", OBJ2INT(execute ())); return 0; }

実際のコードに対応する部分は、switch 文の中だけ。うーん、Cにコンパイルといっても、これだとVM形式とそんなに変わらない気がするなぁ。

後で論文やビデオを見る。

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20080501