(defun scheme-compile (x) (init-scheme-compiler) (comp-lambda '() (list x) nil))という具合になっているので,comp-lambdaの コード部分をassembleするということで 行います.
(defun comp-lambda (args body env) (make-fn :env env :args args :code (assemble (seq (gen 'ARGS (length args)) (comp-begin body (cons args env)) (gen 'RETURN)))))
<cl> (comp-show '(if a b c)) 0: ARGS 0 1: GVAR A 2: FJUMP 5 3: GVAR B 4: JUMP 6 5: GVAR C 6: RETURN NIL <cl> (scheme-compile '(if a b c)) #S(FN :CODE #((ARGS 0) (GVAR A) (FJUMP 5) (GVAR B) (JUMP 6) (GVAR C) (RETURN)) :ENV NIL :NAME NIL :ARGS NIL) <cl> (comp-show '(and a b c)) 0: ARGS 0 1: GVAR A 2: FJUMP 9 3: GVAR B 4: FJUMP 7 5: GVAR C 6: JUMP 8 7: GVAR NIL 8: JUMP 10 9: GVAR NIL 10: RETURN <cl> (scheme-compile '(and a b c)) #S(FN :CODE #((ARGS 0) (GVAR A) (FJUMP 9) (GVAR B) (FJUMP 7) (GVAR C) (JUMP 8) (GVAR NIL) (JUMP 10) (GVAR NIL) (RETURN)) :ENV NIL :NAME NIL :ARGS NIL) <cl> (comp-show '(if (and a b) c)) 0: ARGS 0 1: GVAR A 2: FJUMP 5 3: GVAR B 4: JUMP 6 5: GVAR NIL 6: FJUMP 9 7: GVAR C 8: JUMP 10 9: GVAR NIL 10: RETURN [28]> (scheme-compile '(if (and a b) c)) #S(FN :CODE #((ARGS 0) (GVAR A) (FJUMP 5) (GVAR B) (JUMP 6) (GVAR NIL) (FJUMP 9) (GVAR C) (JUMP 10) (GVAR NIL) (RETURN)) :ENV NIL :NAME NIL :ARGS NIL) <cl> (comp-show '(lambda (a))) 0: ARGS 0 1: FN 0: ARGS 1 1: CONST NIL 2: RETURN 2: RETURN <cl> (scheme-compile '(lambda (a))) #S(FN :CODE #((ARGS 0) (FN #S(FN :CODE #((ARGS 1) (CONST NIL) (RETURN)) :ENV (NIL) :NAME NIL :ARGS (A))) (RETURN)) :ENV NIL :NAME NIL :ARGS NIL) <cl> (comp-show '(lambda (x) (if x b c))) 0: ARGS 0 1: FN 0: ARGS 1 1: LVAR 0 0 ; X 2: FJUMP 5 3: GVAR B 4: JUMP 6 5: GVAR C 6: RETURN 2: RETURN <cl> (scheme-compile '(lambda (x) (if x b c))) #S(FN :CODE #((ARGS 0) (FN #S(FN :CODE #((ARGS 1) (LVAR 0 0 ";" X) (FJUMP 5) (GVAR B) (JUMP 6) (GVAR C) (RETURN)) :ENV (NIL) :NAME NIL :ARGS (X))) (RETURN)) :ENV NIL :NAME NIL :ARGS NIL) <cl> (comp-show '((lambda (x) (if ((lambda (y z) (if x y z)) 3 x)) x) 4)) 0: ARGS 0 1: CONST 4 2: FN 0: ARGS 1 1: CONST 3 2: LVAR 0 0 ; X 3: FN 0: ARGS 2 1: LVAR 1 0 ; X 2: FJUMP 5 3: LVAR 0 0 ; Y 4: JUMP 6 5: LVAR 0 1 ; Z 6: RETURN 4: CALL 2 5: FJUMP 8 6: GVAR NIL 7: JUMP 9 8: GVAR NIL 9: POP 10: LVAR 0 0 ; X 11: RETURN 3: CALL 1 4: RETURN NIL <cl> (scheme-compile '((lambda (x) (if ((lambda (y z) (if x y z)) 3 x)) x) 4)) #S(FN :CODE #((ARGS 0) (CONST 4) (FN #S(FN :CODE #((ARGS 1) (CONST 3) (LVAR 0 0 ";" X) (FN #S(FN :CODE #((ARGS 2) (LVAR 1 0 ";" X) (FJUMP 5) (LVAR 0 0 ";" Y) (JUMP 6) (LVAR 0 1 ";" Z) (RETURN)) :ENV ((X) NIL) :NAME NIL :ARGS (Y Z))) (CALL 2) (FJUMP 8) (GVAR NIL) (JUMP 9) (GVAR NIL) (POP) (LVAR 0 0 ";" X) (RETURN)) :ENV (NIL) :NAME NIL :ARGS (X))) (CALL 1) (RETURN)) :ENV NIL :NAME NIL :ARGS NIL)