diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-24 16:53:48 +0200 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-24 16:53:48 +0200 |
commit | 28f59fbe2973dbf81f1cfda7127b9a0357878e63 (patch) | |
tree | 08a7ece5c7b6c811f1f840a06a582a38cab40848 /example.lisp | |
parent | eec49f5b95266253a1f82497d828236fc43a3dfd (diff) |
Support protocol inheritance.
darcs-hash:26e54df381e3bbe213472f6c7b4f2fb11bdd16af
Diffstat (limited to 'example.lisp')
-rw-r--r-- | example.lisp | 36 |
1 files changed, 22 insertions, 14 deletions
diff --git a/example.lisp b/example.lisp index e2e48d5..39f33b4 100644 --- a/example.lisp +++ b/example.lisp @@ -31,22 +31,30 @@ (defgeneric multiply (x stream)) (defgeneric invert (x)) + (defclass a () ()) -;; Note the style warnings signalled by the following. -(implement-protocols a (additive multiplicative serialisable) - (defmethod add ((x a) (y a))) - (defmethod negate ((x a))) - (defmethod multiply ((x a) y))) +;; The following should signal five style warnings about missing methods. +(implement-protocols a (serialisable-field)) + + +(defclass b () ()) + +;; Note the two style warnings signalled by the following. +(implement-protocols b (additive multiplicative serialisable) + (defmethod add ((x b) (y b))) + (defmethod negate ((x b))) + (defmethod multiply ((x b) y))) -(print (conforms-to-p 'a 'additive)) -(print (really-conforms-to-p 'a 'additive)) -(print (conforms-to-p 'a 'multiplicative)) -(print (really-conforms-to-p 'a 'multiplicative)) -(print (conforms-to-p 'a 'printable)) -(print (really-conforms-to-p 'a 'printable)) +(print (conforms-to-p 'b 'additive)) +(print (really-conforms-to-p 'b 'additive)) +(print (conforms-to-p 'b 'multiplicative)) +(print (really-conforms-to-p 'b 'multiplicative)) +(print (conforms-to-p 'b 'printable)) +(print (really-conforms-to-p 'b 'printable)) -(implement-protocols a (printable)) +;; The following works because PRINT-OBJECT is specialised over T. +(implement-protocols b (printable)) -(print (conforms-to-p 'a 'printable)) -(print (really-conforms-to-p 'a 'printable)) +(print (conforms-to-p 'b 'printable)) +(print (really-conforms-to-p 'b 'printable)) |