From eec49f5b95266253a1f82497d828236fc43a3dfd Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Mon, 24 Sep 2007 16:02:54 +0200
Subject: Initial version.

darcs-hash:def92c268e831071d651f7c0dc315910359b1d07
---
 example.lisp | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)
 create mode 100644 example.lisp

(limited to 'example.lisp')

diff --git a/example.lisp b/example.lisp
new file mode 100644
index 0000000..e2e48d5
--- /dev/null
+++ b/example.lisp
@@ -0,0 +1,52 @@
+(defpackage #:mulk.protocols-examples
+  (:nicknames #:protocols-examples)
+  (:use #:cl #:protocols))
+
+
+(in-package #:mulk.protocols-examples)
+
+
+(define-protocol printable ()
+  ((print-object * stream)))
+
+(define-protocol serialisable ()
+  ((serialise * stream)))
+
+(define-protocol additive ()
+  ((add * *)
+   (negate *)))
+
+(define-protocol multiplicative ()
+  ((multiply * *)
+   (invert *)))
+
+(define-protocol field (additive multiplicative) ())
+
+(define-protocol serialisable-field (serialisable field) ())
+
+
+(defgeneric serialise (x stream))
+(defgeneric add (x y))
+(defgeneric negate (x))
+(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)))
+
+(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))
+
+(implement-protocols a (printable))
+
+(print (conforms-to-p 'a 'printable))
+(print (really-conforms-to-p 'a 'printable))
-- 
cgit v1.2.3