X-Git-Url: http://christophe.rhodes.io/gitweb/?p=specializable.git;a=blobdiff_plain;f=examples%2Ftest.lisp;fp=examples%2Ftest.lisp;h=36847ceca7b82b18f54d78abd75e4c740acbf506;hp=0000000000000000000000000000000000000000;hb=149a7b3d9c1eceaeddad8404137383545ac044e8;hpb=9dd8f1378407cae8ec7b6b05a8b3c152bc4a5f9b

diff --git a/examples/test.lisp b/examples/test.lisp
new file mode 100644
index 0000000..36847ce
--- /dev/null
+++ b/examples/test.lisp
@@ -0,0 +1,63 @@
+;;;; test.lisp ---
+;;;;
+;;;; Copyright (C) 2014 Jan Moringen
+;;;;
+;;;; Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
+
+(cl:in-package #:cl-user)
+
+(defgeneric test-match/1 (thing &key &allow-other-keys)
+  (:generic-function-class pattern-specializer:pattern-generic-function))
+
+(defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n "bla"))))
+  (list (list :cons-n-string-bla n)
+        (when (next-method-p)
+          (call-next-method))))
+
+(defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n "bli"))))
+  (list (list :cons-n-string-bli n)
+        (when (next-method-p)
+          (call-next-method))))
+
+(defmethod test-match/1 :around ((thing (pattern-specializer:pattern (cons 1 "bli"))))
+  (list :around-cons-1-string-bli
+        (when (next-method-p)
+          (call-next-method))))
+
+(defmethod test-match/1 ((thing (pattern-specializer:pattern (cons 1 "bli"))))
+  :cons-1-string-bli)
+
+(defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n m))))
+  (list :cons-n-m n m))
+
+(test-match/1 (cons 5 "bla"))
+(test-match/1 (cons 1 "bli"))
+(test-match/1 (cons 1 "blu"))
+
+(defgeneric test-match/2 (thing1 thing2 &key foo)
+  (:generic-function-class pattern-specializer:pattern-generic-function))
+
+(defmethod test-match/2 ((thing1 (pattern-specializer:pattern (cons 1 "bla")))
+                         (thing2 (pattern-specializer:pattern (cons 2 "bla")))
+                         &key foo)
+  :cons-1-string-bla-cons-2-string-bla)
+
+(test-match/2 (cons 1 "bla") (cons 2 "bla"))
+(test-match/2 (cons 1 "bli") (cons 2 "bla"))
+(test-match/2 (cons 1 "blu") (cons 2 "bla"))
+
+
+
+(defgeneric test-match/3 (thing1 thing2 thing3
+                          &rest bla)
+  (:generic-function-class pattern-specializer:pattern-generic-function))
+
+(defmethod test-match/3 ((thing1 (pattern-specializer:pattern (cons 1 my-var)))
+                         (thing2 t)
+                         (thing3 (pattern-specializer:pattern (cons 3 "bla")))
+                         &rest bla)
+  (list thing1 thing2 :cons-3-string-bla my-var bla))
+
+(test-match/3 (cons 1 "bla") :bar (cons 3 "bla"))
+(test-match/3 (cons 1 "blu") :bar (cons 3 "bla"))
+(test-match/3 (cons 1 "bli") (cons 2 "bla"))