CL-USER> (start-up (the engine *bp-ze*))

car-mods and common-lisp

Common Lisp で Code Walker を実装するなら その②

前回の続き。状態を持つmacroletを書くにはどうすればいいのか!? これが答えだ!

回答: Compile-time で restart-bind

サンプルコード (walk-tree.lisp) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
(use-package :alexandria)
(cl-syntax:use-syntax :annot)

(define-condition undefined-clause (simple-condition)
  ((form :initarg :form :accessor form)
   (environment :initarg :environment :accessor environment))
  (:report (lambda (c s)
       (format s "~a~% is not a bound macro in ~a"
           (form c)
           (environment c)))))

(defmacro my-clause (&whole form &body body &environment env)
  @ignore body
  (restart-case (error 'undefined-clause :form form :environment env)
    (use-value (c)
      :interactive (lambda () (read))
      c)))


(let (previous-hooks)
  (defmacro my-macro-start ()
    (push *macroexpand-hook* previous-hooks)
    (let ((i 0) (prev (car previous-hooks)))
      (flet ((hook (expander form env)
         (handler-bind
         ((undefined-clause
           (lambda (c)
             (incf i)
             (use-value
          `(format
            t "~%~ath expansion of my-clause~%~
                             ~a" ,i ',(form c))))))
       (funcall prev expander form env))))
  (setf *macroexpand-hook* #'hook)
  `(progn))))

  (defmacro my-macro-end ()
    (setf *macroexpand-hook* (pop previous-hooks))
    `(progn)))

(defmacro my-macro (&body body)
  `(progn
     (my-macro-start)
     ,@body
     (my-macro-end)))

(my-macro
  (print :hi)
  (my-clause
    (print :ok)
    (print :fine))
  (macrolet ((my-clause (&body body)
      `(progn
         ,@(loop for form in body
          collect '(print :expanded-by-macrolet)))))
    (my-clause
      (print :this-is-ignored)
      (print (+ 1 2 3))
      (print :this-is-ignored)))
  (print :im-hungry-where-is-supper!)
  (my-clause
    (print :not-ok)
    (print :bad))
  (print :bye))

;; --> macroexpand-1 result

(PROGN
 (MY-MACRO-START) ;; macroexpanding this clause causes a side-effect
 (PRINT :HI)
 (MY-CLAUSE
   (PRINT :OK)
   (PRINT :FINE))
 (MACROLET ((MY-CLAUSE (&BODY BODY)
              `(PROGN
                ,@(LOOP FOR FORM IN BODY
                        COLLECT '(PRINT :EXPANDED-BY-MACROLET)))))
   (MY-CLAUSE
     (PRINT :THIS-IS-IGNORED)
     (PRINT (+ 1 2 3))
     (PRINT :THIS-IS-IGNORED)))
 (PRINT :IM-HUNGRY-WHERE-IS-SUPPER!)
 (MY-CLAUSE
   (PRINT :NOT-OK)
   (PRINT :BAD))
 (PRINT :BYE)
 (MY-MACRO-END))

;; --> full expansion result 
;; (expected, since C-c C-m doesn't handle local macro)

(PROGN
 (PROGN)
 (PRINT :HI)
 (FORMAT T "~%~ath expansion of my-clause~%~
                              ~a"
         1
         '(MY-CLAUSE
            (PRINT :OK)
            (PRINT :FINE)))
 (PROGN
   (PRINT :EXPANDED-BY-MACROLET)
   (PRINT :EXPANDED-BY-MACROLET)
   (PRINT :EXPANDED-BY-MACROLET))
 (PRINT :IM-HUNGRY-WHERE-IS-SUPPER!)
 (FORMAT T "~%~ath expansion of my-clause~%~
                              ~a"
         2
         '(MY-CLAUSE
            (PRINT :NOT-OK)
            (PRINT :BAD)))
 (PRINT :BYE)
 (PROGN))

;; --> print result
;; 
;; :HI 
;; 1th expansion of my-clause
;; (MY-CLAUSE
;;   (PRINT OK)
;;   (PRINT FINE))
;; :EXPANDED-BY-MACROLET 
;; :EXPANDED-BY-MACROLET 
;; :EXPANDED-BY-MACROLET 
;; :IM-HUNGRY-WHERE-IS-SUPPER! 
;; 2th expansion of my-clause
;; (MY-CLAUSE
;;   (PRINT NOT-OK)
;;   (PRINT BAD))
;; :BYE 
;; NIL
;; CL-USER> 

ね、面白いでしょ?ANSI Hyperspecにある *macroexpand-hook* をうまく使っ てみました。 my-macro-start が変な感じになっているのは、ここで書いた 構造が入れ子になってる可能性があるので、スタックフレームをエミュレート しているんです。 ん、え、スタック?

Schemerな人は言いたいことがすぐにわかることでしょう。ANSIの設計の何が悪 いって、 defmacro継続を引数に取ってくれない ことなんですよ。だ から、外側のマクロを展開した時に、内側のマクロ展開を行うときのレキシカ ル環境を操作できない。それだから中途半端な code-walker しか 簡単には 実装できないわけです。

うーん、えーと、もう2,3個思いついたはずなんですけど、思いつかなかった ので、一つです。なにか他に案がある人はtwitterかgithub経由で教えてくだ さい(^^)