From 28f59fbe2973dbf81f1cfda7127b9a0357878e63 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Mon, 24 Sep 2007 16:53:48 +0200 Subject: Support protocol inheritance. darcs-hash:26e54df381e3bbe213472f6c7b4f2fb11bdd16af --- example.lisp | 36 ++++++++++++++++++++++-------------- 1 file changed, 22 insertions(+), 14 deletions(-) (limited to 'example.lisp') 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)) -- cgit v1.2.3