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

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