chiark - git - mdw - sod/blob - examples.lisp

   1 (set-dispatch-macro-character #\# #\{ 'c-fragment-reader)
   2
   3 (defparameter *chimaera-module*
   4   (define-module ("chimaera.sod")
   5
   6     (define-sod-class "Animal" ("SodObject")
   7       :nick 'nml
   8       :link '|SodObject|
   9       (slot "tickles" int)
  10       (instance-initializer "nml" "tickles" :single #{ 0 })
  11       (message "tickle" (fun void))
  12       (method "nml" "tickle" (fun void) #{
  13          me->tickles++;
  14        }
  15        :role :before)
  16       (method "nml" "tickle" (fun void) #{ }))
  17
  18     (define-sod-class "Lion" ("Animal")
  19       :nick 'lion
  20       :link '|Animal|
  21       (message "bite" (fun void))
  22       (method "lion" "bite" (fun void) nil)
  23       (method "nml" "tickle" (fun void) #{
  24          me->_vt->lion.bite(me);
  25          CALL_NEXT_METHOD;
  26        }))
  27
  28     (define-sod-class "Goat" ("Animal")
  29       :nick 'goat
  30       (message "butt" (fun void))
  31       (method "goat" "butt" (fun void) nil)
  32       (method "nml" "tickle" (fun void) #{
  33          me->_vt->goat.bite(me);
  34          CALL_NEXT_METHOD;
  35        }))
  36
  37     (define-sod-class "Serpent" ("Animal")
  38       :nick 'serpent
  39       (message "bite" (fun void))
  40       (method "serpent" "bite" (fun void) nil)
  41       (message "hiss" (fun void))
  42       (method "serpent" "hiss" (fun void) nil)
  43       (method "nml" "tickle" (fun void) #{
  44          if (me->tickles < 3) me->_vt->hiss(me);
  45          else me->_vt->bite(me);
  46          CALL_NEXT_METHOD;
  47        }))
  48
  49     (define-sod-class "Chimaera" ("Lion" "Goat" "Serpent")
  50       :nick 'sir
  51       :link '|Lion|)
  52
  53     (defparameter *chimaera* (find-sod-class "Chimaera"))
  54     (defparameter *emeth* (find "tickle"
  55                                 (sod-class-effective-methods *chimaera*)
  56                                 :key (lambda (method)
  57                                        (sod-message-name
  58                                         (effective-method-message method)))
  59                                 :test #'string=))))
  60