総称関数の:beforeとか

ほぼ初めて実用でこの辺の機能を使おうとしてふと不満に思ったこと。

SagittariusのCLOSはXeroxのTiny CLOSの動作を基本にして作られていて、:beforeとかもその動作を元にしている(たぶんこれは以前にも書いた気がする)。っで、ふとそれだとまずいというか、嬉しくないなぁというパターンが出てきて、ちょっと動作のおさらいをしている。

とりあえずは、以下のコード

(import (rnrs) 
        (rename (clos user)
                (define-class %define-class)
                (define-method %define-method))
        (srfi :0))

(define-generic foo)
(define (print . args) (for-each display args) (newline))
(cond-expand
 (mosh
  (define-syntax define-class
    (syntax-rules ()
      ((_ name parents (slots ...))
       (%define-class name parents slots ...))))
  (define-syntax define-method
    (syntax-rules (:before :after :around)
      ((_ name :before (specifiers ...) body ...)
       (%define-method name 'before (specifiers ...) body ...))
      ((_ name :after (specifiers ...) body ...)
       (%define-method name 'after (specifiers ...) body ...))
      ((_ name :around (specifiers ...) body ...)
       (%define-method name 'around (specifiers ...) body ...))
      ((_ name (specifiers ...) body ...)
       (%define-method name (specifiers ...) body ...)))))
 (sagittarius
  (define-syntax define-class (identifier-syntax %define-class))
  (define-syntax define-method (identifier-syntax %define-method))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :before ((h <human>)) 
  (print "human before"))
(define-method foo :before ((b <businessman>)) 
  (print "businessman before"))

(define-method foo ((h <human>)) 
  (print "human body"))
(define-method foo ((b <businessman>)) 
  (print "businessman body"))

(foo (make <businessman>))
#|
businessman before
human before
businessman body
|#

まじめに書いてないのでまともに動きはしないのだが、Moshとの互換レイヤが入っている。気になるのは出力結果。動作を合わせてあるので現状は同じ出力を返すのだが、「human before」はcall-next-methodがあった場合にのみに出力されてほしい気がする。というか、そうじゃないと綺麗に書けないコードを書いていて、もにょっている感じ。

本家のCLではどうなっているのかもついでに試してみた(これも以前試したっけ？)

(defclass human () ())
(defclass businessmane (human) ())

(defmethod foo :before ((h human)) (print "before human"))
(defmethod foo :before ((h businessmane)) (print "before businessmane"))

(defmethod foo ((h human)) (print "body human"))
(defmethod foo ((h businessmane)) (print "body businessmane"))

(foo (make-instance 'businessmane))
#|
"before businessmane"
"before human"
"body businessmane"
|#

あぁ、本家もそうなのか。そうなると逸脱するのも微妙だなぁ・・・