Python from Wise Guy's Viewpoint

[Pascal Costanza]

Marshall Spight wrote:
> <prunesquallor at comcast.net> wrote in message news:ismdcj0d.fsf at comcast.net...
> 
>>Are they happy with something like this?
>>
>>(defun black-hole (x)
>>  #'black-hole)
>>
>>(for non lispers, the funny #' is a namespace operator.
>> The black-hole function gobbles an argument and returns
>> the black-hole function.)
> 
> 
> Ha!
> 
> Although this doesn't get me any closer to my goal of
> simple, useful, correct program that cannot be proven
> typesafe. 

OK, here we go! :)



(defvar *default-company* 'costanza-inc)

(defclass employed ()
   ((original-class :initarg :original-class)
    (company :accessor company :initarg :company)
    (salary :accessor salary :initarg :salary)))

(defun hire (someone salary &key (company *default-company*))
   (let* ((original-class (class-name (class-of someone)))
          (employed-class
           (intern (format nil "~A-~A" 'employed original-class))))
     (eval `(defclass ,employed-class (employed ,original-class) ()))
     (change-class someone employed-class
                   :original-class original-class
                   :company company
                   :salary salary)))

(defun fire (someone)
   (when (member
          (find-class 'employed)
          (class-precedence-list (class-of someone)))
     (change-class someone (slot-value someone 'original-class))))


(defun test-employed ()
   (let ((person (make-symbol "PERSON")))
     (eval `(defclass ,person ()
              ((name :accessor name :initarg :name))))
     (let ((joe (make-instance person :name "joe")))
       (format t "-> hire joe~%")
       (hire joe 60000)
       (format t "name: ~A~%" (name joe))
       (format t "current class: ~A~%" (class-name (class-of joe)))
       (format t "original class: ~A~%" (slot-value joe 'original-class))
       (format t "company: ~A~%" (company joe))
       (format t "salary: ~A~%" (salary joe))
       (format t "-> fire joe~%")
       (fire joe)
       (if (member (find-class 'employed)
                   (class-precedence-list (class-of joe)))
           (format t "joe is still employed.~%")
         (format t "joe is not employed anymore.~%")))))



And here is a sample session:

CL-USER 1 > (test-employed)
-> hire joe
name: joe
current class: EMPLOYED-PERSON
original class: PERSON
company: COSTANZA-INC
salary: 60000
-> fire joe
joe is not employed anymore.
NIL



Some minor comments:

- This is all standard ANSI Common Lisp, except for 
CLASS-PRECEDENCE-LIST which is part of the semi-standard MOP.

- This codes runs without any changes and without any additional 
libraries on both LispWorks 4.3 and Macintosh Common Lisp 5.0, and 
probably also on many other Common Lisp implementations. (This fulfils 
the requirement that this is indeed a relatively short example.)

- I have used EVAL to define classes at runtime, because although the 
MOP defines ENSURE-CLASS for that purpose the latter is not defined in 
Macintosh Common Lisp. The use of EVAL is not the reason for this code 
not being acceptable for a static type checker.

- The important thing here is that the EMLOYED mixin works on any class, 
even one that is added later on to a running program. So even if you 
want to hire martians some time in the future you can still do this.

- As an interesting sidenote, both Common Lisp compilers I have used 
emit a warning that there is no definition for the function NAME that is 
called in TEST-EMPLOYED. I don't care - the code is elegant, relatively 
straightforward to understand, useful and correct. And I can safely 
ignore the warning - it works as expected.



Pascal


P.S., to Joe Marshall: I hope you don't mind that I hire and fire you 
within a split second. ;-)