Message Handling

User-defined Handlers

(send 1 + 2)
(describe-class INTEGER)

(defmessage-handler NUMBER + (?arg)
    (+ ?self ?arg))

(defmessage-handler LEXEME + (?arg)
    (sym-cat ?self ?arg))

(send sun + day)

Primary Handler

(defmessage-handler USER what-am-i primary ()
    (printout t "I am a/an " (class ?self) "." crlf))

(send [c2] what-am-i)

Messages Chaining

(defmessage-handler VECTOR * primary (?scalar)
    (send ?self put-x (* ?self:x ?scalar))
    (send ?self put-y (* ?self:y ?scalar))
    (return ?self) )

(defmessage-handler VECTOR = primary (?v)
    (send ?self put-x (send ?v get-x))
    (send ?self put-y (send ?v get-y))
    (return ?self) )

(send (send [v1] = [I]) * 3)

Around Handler

(defmessage-handler VENUS-FLY-TRAP
    put-mobility-rate around ($?any)
    (printout t "Hey! I'm not allowed to move!"
            crlf))

Before Handler

(defmessage-handler USER init before ()
    (printout t "*** Starting to make instance "
                (instance-name ?self) " ***" crlf))

After Handler

(defmessage-handler USER init after ()
    (printout t "*** Finished making instance "
                (instance-name ?self) " ***" crlf))

Example: vector.clp

Multiple Inheritance

(defclass ANIMAL (is-a USER)        ; user-defined class
    (role abstract)                 ; no instance can be made
    (slot mobility-rate))

(defclass PLANT (is-a USER)
    (role abstract)
    (slot CO2-comsumption-rate))

(defclass VENUS-FLY-TRAP (is-a PLANT ANIMAL)    ; Multiple Inheritance
    (role concrete))

Example: life.clp

Inheritance by Specialization

(defclass POINT (is-a USER)
    (role concrete)
    (multislot point1))

(defclass LINE (is-a POINT)
    (role concrete)
    (multislot point2))

(defclass TRIANGLE (is-a LINE)
    (role concrete)
    (multislot point3))

Inheritance by Generlization(Composition)

(defclass POINT (is-a USER)
    (role concrete)
    (multislot position
         (create-accessor read-write)
         (propagation no-inherit)))

(defclass LINE (is-a POINT)
    (slot point1
         (create-accessor read-write)
         (default-dynamic (make-instance (gensym*) of POINT))
         (propagation no-inherit))
    (slot point2
         (create-accessor read-write)
         (default-dynamic (make-instance (gensym*) of POINT))
         (propagation no-inherit)))

(defmessage-handler LINE find-point (?point)
    (send (send ?self (sym-cat "get-point" ?point)) get-position)
    )

(defmessage-handler LINE print-points ()
    (printout t "point1 " (send ?self find-point 1) crlf
                "point2 " (send ?self find-point 2) crlf)
    )

Example: triangle.clp

Dynamic Get and Put

(defmessage-handler PERSON print-age primary ()
    (printout t "Age = " ?self:age crlf))

(defmessage-handler PERSON print-age primary ()
    (printout t "Age = " (dynamic-get age) crlf))

Example:

(defclass A (is-a USER)
    (slot foo (create-accessor read)))
(defclass B (is-a A)
    (role concrete)
    (slot foo))
(make-instance b of B)
(send [b] get-foo)     ; the direct slot access will fail, because the slot foo redefined in class B.
                                ; See:defmessage-handler Actions

(defmessage-handler A get-foo ()
    (dynamic-get foo))
(defclass B (is-a A)
    (role concrete)
    (slot foo (visibility public)))

Message Dispatch

An around handler starts before any before handlers. A before handler is executed before any primary handlers, which are followed by the after handlers. 
(defmessage-handler PERSON
    lie-about-age around (?change)
    (bind ?old-age ?self:age)
    (if (next-handlerp) then
                (call-next-handler))
    (bind ?new-age ?self:age)
    (if (<> ?old-age ?new-age) then
        (printout t
            "He's really " ?old-age "." crlf)))

Example: age.clp

Reference:


Go to COOL Summary

Previous Class and Inheritance   Up TOC   Next Design Examples