SBCLのsource-transformの結果を簡単に表示させたい — #:g1

Posted 2012-02-26 20:02:00 GMT

SBCLでは、通常の関数も最適化の変形がされてからコンパイルされますが、その最適化のための変形は、SB-C:DEFINE-SOURCE-TRANSFORM で定義できたりします。
このsource-transformが施される関数をmacroexpandのようにslimeで簡単に見れたら良いなと思い作ってみました。特に何かに必要な訳ではないのですが…。
CL側ではこんな感じ

(defun source-transform (form &optional (env (sb-kernel:make-null-lexenv)))
  (if (and (consp form)
           (symbolp (car form))
           (not (special-operator-p (car form))) )
      (let ((sb-c::*lexenv* env))
        (or (and (fboundp (car form))
                 (multiple-value-bind (fun win)
                                      (sb-int:info :function :source-transform (car form))
                   (and win (funcall fun form))))
            (values form T) ))
      (values form T) ))
slime側ではこんな感じ
;; el: slime
(defun slime-source-transform ()
  (interactive)
  (slime-eval-macroexpand 'g000001::source-transform-string))

(define-key slime-mode-map [(control ?c) (meta ?t)] 'slime-source-transform)

動作

普通に関数の実行
(mapcar (^x x) '(1 2 3 4))
;=>  (1 2 3 4)
source-transformした結果と、展開の実行結果
(LET ((G1936
       (SB-KERNEL:%COERCE-CALLABLE-TO-FUN
        (^X
          X))))
  (LET ((G1938 (LIST NIL)))
    (SB-INT:DO-ANONYMOUS ((G1937 G1938) (G1935 '(1 2 3 4) (CDR G1935)))
                         ((OR (ENDP G1935))
                          (SB-EXT:TRULY-THE LIST (CDR G1938)))
                         (RPLACD G1937
                                 (SETQ G1937
                                         (LIST
                                          (SB-C::%FUNCALL G1936
                                                          (CAR G1935))))))))
;=>  (1 2 3 4)
さらにmacroexpand-allしたものと、展開の実行結果
(LET ((G1936 (SB-KERNEL:%COERCE-CALLABLE-TO-FUN (LAMBDA (X) X))))
  (LET ((G1938 (LIST NIL)))
    (BLOCK G1942
      (LET ((G1937 G1938) (G1935 '(1 2 3 4)))
        (TAGBODY
          (GO G1944)
         G1943
          (TAGBODY
            (RPLACD G1937
                    (SETQ G1937 (LIST (SB-C::%FUNCALL G1936 (CAR G1935))))))
          (LET* ()
            (MULTIPLE-VALUE-BIND (NEW1945)
                (CDR G1935)
              (PROGN (SETQ G1935 NEW1945) NIL)))
         G1944
          (IF (THE T (ENDP G1935))
              NIL
              (PROGN (GO G1943)))
          (RETURN-FROM G1942 (PROGN
                               (SB-EXT:TRULY-THE LIST (CDR G1938)))))))))
;=>  (1 2 3 4)
別に役に立ちませんが、眺めてると面白いです。ちなみにコンパイルした結果は上記3つとも全部同じになります。

comments powered by Disqus