3 ;;;; Copyright (C) 2014 Jan Moringen
5 ;;;; Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
7 (cl:in-package #:cl-user)
9 (defgeneric test-match/1 (thing &key &allow-other-keys)
10 (:generic-function-class pattern-specializer:pattern-generic-function))
12 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n "bla"))))
13 (list (list :cons-n-string-bla n)
17 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n "bli"))))
18 (list (list :cons-n-string-bli n)
22 (defmethod test-match/1 :around ((thing (pattern-specializer:pattern (cons 1 "bli"))))
23 (list :around-cons-1-string-bli
27 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons 1 "bli"))))
30 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n m))))
33 (test-match/1 (cons 5 "bla"))
34 (test-match/1 (cons 1 "bli"))
35 (test-match/1 (cons 1 "blu"))
37 (defgeneric test-match/2 (thing1 thing2 &key foo)
38 (:generic-function-class pattern-specializer:pattern-generic-function))
40 (defmethod test-match/2 ((thing1 (pattern-specializer:pattern (cons 1 "bla")))
41 (thing2 (pattern-specializer:pattern (cons 2 "bla")))
43 :cons-1-string-bla-cons-2-string-bla)
45 (test-match/2 (cons 1 "bla") (cons 2 "bla"))
46 (test-match/2 (cons 1 "bli") (cons 2 "bla"))
47 (test-match/2 (cons 1 "blu") (cons 2 "bla"))
51 (defgeneric test-match/3 (thing1 thing2 thing3
53 (:generic-function-class pattern-specializer:pattern-generic-function))
55 (defmethod test-match/3 ((thing1 (pattern-specializer:pattern (cons 1 my-var)))
57 (thing3 (pattern-specializer:pattern (cons 3 "bla")))
59 (list thing1 thing2 :cons-3-string-bla my-var bla))
61 (test-match/3 (cons 1 "bla") :bar (cons 3 "bla"))
62 (test-match/3 (cons 1 "blu") :bar (cons 3 "bla"))
63 (test-match/3 (cons 1 "bli") (cons 2 "bla"))