examples/test.lisp

   1 ;;;; test.lisp ---
   2 ;;;;
   3 ;;;; Copyright (C) 2014 Jan Moringen
   4 ;;;;
   5 ;;;; Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
   6
   7 (cl:in-package #:cl-user)
   8
   9 (defgeneric test-match/1 (thing &key &allow-other-keys)
  10   (:generic-function-class pattern-specializer:pattern-generic-function))
  11
  12 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n "bla"))))
  13   (list (list :cons-n-string-bla n)
  14         (when (next-method-p)
  15           (call-next-method))))
  16
  17 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n "bli"))))
  18   (list (list :cons-n-string-bli n)
  19         (when (next-method-p)
  20           (call-next-method))))
  21
  22 (defmethod test-match/1 :around ((thing (pattern-specializer:pattern (cons 1 "bli"))))
  23   (list :around-cons-1-string-bli
  24         (when (next-method-p)
  25           (call-next-method))))
  26
  27 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons 1 "bli"))))
  28   :cons-1-string-bli)
  29
  30 (defmethod test-match/1 ((thing (pattern-specializer:pattern (cons n m))))
  31   (list :cons-n-m n m))
  32
  33 (test-match/1 (cons 5 "bla"))
  34 (test-match/1 (cons 1 "bli"))
  35 (test-match/1 (cons 1 "blu"))
  36
  37 (defgeneric test-match/2 (thing1 thing2 &key foo)
  38   (:generic-function-class pattern-specializer:pattern-generic-function))
  39
  40 (defmethod test-match/2 ((thing1 (pattern-specializer:pattern (cons 1 "bla")))
  41                          (thing2 (pattern-specializer:pattern (cons 2 "bla")))
  42                          &key foo)
  43   :cons-1-string-bla-cons-2-string-bla)
  44
  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"))
  48
  49
  50
  51 (defgeneric test-match/3 (thing1 thing2 thing3
  52                           &rest bla)
  53   (:generic-function-class pattern-specializer:pattern-generic-function))
  54
  55 (defmethod test-match/3 ((thing1 (pattern-specializer:pattern (cons 1 my-var)))
  56                          (thing2 t)
  57                          (thing3 (pattern-specializer:pattern (cons 3 "bla")))
  58                          &rest bla)
  59   (list thing1 thing2 :cons-3-string-bla my-var bla))
  60
  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"))