LOCAL_ENV_CLOSURES (2)

gauche

本当は (3) なんですが (何
職場で現実トウヒ中にインストラクションの名前とか見てて例えば以下ならどうなるのか、という事に気づいた。

gosh> (letrec ((sum (lambda (l) (if (null? l) 0 (+ (car l) (sum (cdr l)))))) (mul (lambda (l) (if (null? l) 1 (* (car l) (mul (cdr l))))))) (- (sum '(1 2 3 4 5)) (mul '(1 2 3))))
9
gosh>

成程、CLOSURES の所以はこれですか。
とゆーコトにて disasm してみました。

gosh> (disasm (lambda () (letrec ((sum (lambda (l) (if (null? l) 0 (+ (car l) (sum (cdr l)))))) (mul (lambda (l) (if (null? l) 1 (* (car l) (mul (cdr l))))))) (- (sum '(1 2 3 4 5)) (mul '(1 2 3))))))
main_code (name=#f, code=0x8144e00, size=16, const=3, stack=16):
args: #f
     0 LOCAL-ENV-CLOSURES(2) (#<lambda 0>#<lambda 1>); (letrec ((sum (lambda (l) (if (null? l)  ...
     2 PRE-CALL(1) 8
     4 CONST-PUSH (1 2 3 4 5)
     6 LREF1                    ; sum
     7 LOCAL-ENV-CALL(1)        ; (sum '(1 2 3 4 5))
     8 PUSH-PRE-CALL(1) 14
    10 CONST-PUSH (1 2 3)
    12 LREF0                    ; mul
    13 LOCAL-ENV-CALL(1)        ; (mul '(1 2 3))
    14 NUMSUB2                  ; (- (sum '(1 2 3 4 5)) (mul '(1 2 3)))
    15 RET 
internal_closure_1 (name=mul, code=0x8144e40, size=15, const=0 stack=11):
args: #f
     0 LREF0                    ; l
     1 BNNULL 5                 ; (null? l)
     3 CONSTI(1) 
     4 RET 
     5 LREF0                    ; l
     6 CAR-PUSH                 ; (car l)
     7 PRE-CALL(1) 13
     9 LREF0                    ; l
    10 CDR-PUSH                 ; (cdr l)
    11 LREF10                   ; mul
    12 LOCAL-ENV-CALL(1)        ; (mul (cdr l))
    13 NUMMUL2                  ; (* (car l) (mul (cdr l)))
    14 RET 
internal_closure_0 (name=sum, code=0x8144e80, size=15, const=0 stack=11):
args: #f
     0 LREF0                    ; l
     1 BNNULL 5                 ; (null? l)
     3 CONSTI(0) 
     4 RET 
     5 LREF0                    ; l
     6 CAR-PUSH                 ; (car l)
     7 PRE-CALL(1) 13
     9 LREF0                    ; l
    10 CDR-PUSH                 ; (cdr l)
    11 LREF11                   ; sum
    12 LOCAL-ENV-CALL(1)        ; (sum (cdr l))
    13 NUMADD2                  ; (+ (car l) (sum (cdr l)))
    14 RET 
#<undef>
gosh>

ここまで長いと emacs の run-gauche とかでないと微妙。
最初 LOCAL_ENV_CLOSURES の以下のあたり

                SP += nlocals;
                FINISH_ENV(SCM_FALSE, ENV);
                e = get_env(vm);
                z = (ScmObj*)e - nlocals;
                SCM_FOR_EACH(cp, cp) {
                    if (SCM_COMPILED_CODE_P(SCM_CAR(cp))) {
                        *z++ = clo = Scm_MakeClosure(SCM_CAR(cp), e);
                    } else {
                        *z++ = SCM_CAR(cp);
                    }
                }
                VAL0 = clo;

意味をはかりかねていたんですが、複数あるかもしれんのでスタックに領域確保しといてリストから取り出して順に積んでるのか。なのでケツにある側 (ENV に近い側) が LREF0 なんですね。
本体のみ再度引用。

     0 LOCAL-ENV-CLOSURES(2) (#<lambda 0>#<lambda 1>); (letrec ((sum (lambda (l) (if (null? l)  ...
     2 PRE-CALL(1) 8
     4 CONST-PUSH (1 2 3 4 5)
     6 LREF1                    ; sum
     7 LOCAL-ENV-CALL(1)        ; (sum '(1 2 3 4 5))
     8 PUSH-PRE-CALL(1) 14
    10 CONST-PUSH (1 2 3)
    12 LREF0                    ; mul
    13 LOCAL-ENV-CALL(1)        ; (mul '(1 2 3))
    14 NUMSUB2                  ; (- (sum '(1 2 3 4 5)) (mul '(1 2 3)))
    15 RET

LOCAL-ENV-CLOSURES の仕組みが分かれば

  • 0 でリストになっている手続きオブジェクトをスタックというか環境フレームに順に置いて
  • 2 で手続きの戻り (8) を継続フレームに積んどいて
  • 4 で引数 push して
  • 6 でスタックから手続きオブジェクト (sum) を val0 に取り出して
  • 7 で呼び出し (終わったら 8 に戻る)
  • 8 で val0 をスタックに push しつつ手続きの戻り (14) を継続フレームに積んで
  • 10 で引数 push して
  • 12 でスタックから手続きオブジェクト (mul) を val0 に取り出して
  • 13 で呼び出し (終わったら 14 に戻る)
  • 以下略

むむむ。成程。LOCAL-ENV-CALL とか LOCAL-ENV-TAIL-CALL とかの確認は別途で。今から Pragmatic Thinking and Learning 読みます。