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) #{
  23          puts("Munch!");
  24        })
  25       (method "nml" "tickle" (fun void) #{
  26          me->_vt->lion.bite(me);
  27          CALL_NEXT_METHOD;
  28        }))
  29
  30     (define-sod-class "Goat" ("Animal")
  31       :nick 'goat
  32       (message "butt" (fun void))
  33       (method "goat" "butt" (fun void) #{
  34          puts("Whack!");
  35        })
  36       (method "nml" "tickle" (fun void) #{
  37          me->_vt->goat.bite(me);
  38          CALL_NEXT_METHOD;
  39        }))
  40
  41     (define-sod-class "Serpent" ("Animal")
  42       :nick 'serpent
  43       (message "bite" (fun void))
  44       (method "serpent" "bite" (fun void) #{
  45          puts("Nom!");
  46        })
  47       (message "hiss" (fun void))
  48       (method "serpent" "hiss" (fun void) #{
  49          puts("Ssss!");
  50        })
  51       (method "nml" "tickle" (fun void) #{
  52          if (me->tickles < 3) me->_vt->hiss(me);
  53          else me->_vt->bite(me);
  54          CALL_NEXT_METHOD;
  55        }))
  56
  57     (define-sod-class "Chimaera" ("Lion" "Goat" "Serpent")
  58       :nick 'sir
  59       :link '|Lion|)
  60
  61     (defparameter *chimaera* (find-sod-class "Chimaera"))
  62     (defparameter *emeth* (find "tickle"
  63                                 (sod-class-effective-methods *chimaera*)
  64                                 :key (lambda (method)
  65                                        (sod-message-name
  66                                         (effective-method-message method)))
  67                                 :test #'string=))))