関数をラッピングするだけというマクロの書法 — #:g1

Posted 2012-11-10 09:05:00 GMT

最近kernelのようなfexprを持つLisp方言で遊んでみていますが、fexprでマクロのようなものを書くにしても、ぎりぎりまで普通の関数で書き、それをfexprでラップするのが簡単なようです。例えば、dolistを書くとすると、まず、exprでdolist相当の物を書き、

($define! xdolist 
  ($lambda (lst body-fn result-fn)
    (for-each body-fn lst)
    ($if (null? result-fn)
         ()
         (result-fn))))

(xdolist (list 1 2 3 4) ($lambda (e) (display e) (newline)) ($lambda () #f)) ;>> 1 ;>> 2 ;>> 3 ;>> 4 ;=> #f

それをfexprでラップします
($define! $dolist 
 ($vau ((var lst . result) . body) env 
  (eval (list xdolist 
              lst
              (list* $lambda (list var) body)
                     (list $lambda ()
                     (list* $let (list (list var #f)) result)))
        env)))

($dolist (e (list 1 2 3 4) e) (display e) (newline)) ;>> 1 ;>> 2 ;>> 3 ;>> 4 ;=> #f

これと同じような感じで、マクロを書くとすると、
(declaim (inline xdolist))
(defun xdolist (list fn result-fn)
  (block nil
    (mapc fn list)
    (and result-fn (funcall result-fn))))

(defmacro *dolist ((var list &optional result) &body body) `(xdolist ,list (lambda (,var) ,@body) (and ,result (lambda (&aux (,var nil)) (declare (ignorable ,var)) ,result))))

のような感じになるかと思います。 遅そうですが、補助関数をインライン化しておけばマクロと変わらないので、やりようによっては、tagbodyに展開される標準のdolistと同じようにできるようです。
(defun foo (u &aux (ans 0))
  (declare (optimize (speed 3) (safety 0) (debug 0))
           (fixnum ans))
  (*dolist (e u ans) (declare (ignore e)) (incf ans)))

; disassembly for FOO (assembled 43 bytes) XOR ECX, ECX ; no-arg-parsing entry point JMP L1 NOP NOP L0: ADD RCX, 2 MOV RDX, [RDX+1] L1: CMP RDX, 537919511 JNE L0 MOV RDX, RCX MOV RSP, RBP CLC POP RBP RET

(defun bar (u &aux (ans 0))
  (declare (optimize (speed 3) (safety 0) (debug 0))
           (fixnum ans))
  (dolist (e u ans) (declare (ignore e)) (incf ans)))

; disassembly for BAR (assembled 43 bytes) XOR ECX, ECX ; no-arg-parsing entry point JMP L1 NOP NOP L0: MOV RDX, [RDX+1] ADD RCX, 2 L1: CMP RDX, 537919511 JNE L0 MOV RDX, RCX MOV RSP, RBP CLC POP RBP RET

SBCL場合は、mapcがコンパイラの変形によりtagbodyに展開されるので、色々あって同じアセンブリコードにになりました。(というかそのためにインライン化を使って調整したんですが)
andを書くとすると
(defun xand (&rest clauses)
  (prog ((cs clauses))
     L  (when (endp (cdr cs))
          (return (funcall (car cs))))
        (funcall (car cs))
        (pop cs)
        (go L)))

(defmacro *and (&rest args) `(xand ,@(mapcar (lambda (a) `(lambda () ,a)) args)))

(*and t (values nil 8)) ;=> NIL ; 8

こんな感じになるかと思います。

メリットとデメリット

まとめ

ここまで書いてきてなんですが、簡単にまとめれば、Nikodemus Siivola氏のCALL-WITH-*をマクロでラップするというのを敷衍したものですね。

comments powered by Disqus