An Object in Lisp. Part 2 Addendum

Addendum

The code for an object:

(defobj counter-obj
  (:members
    ((counter 0)))
  (:methods
    ((:increment-counter ()
       (incf counter))
     (:get-counter ()
       counter)
     (:set-counter (x)
       (setf counter x))))

is different than the previous implementation. The previous implementation could not implement parameters to the methods. One other thing was the redundancy of having everything wrapped in lambdas, so you implement them with name, parameters, and code-block.

I like to break my macros up into individual bits of responsibility. It makes for easier debugging. I also use the REPL a lot. Here are the macros:

(defmacro make-make-property (name members methods)
  (let ((property-list (loop for property in methods
                             append
                             (let ((name (first property))
                                   (args (second property))
                                   (commands (cddr property)))
                               `(,name (lambda ,args ,@commands))))))
    `(defun ,(make-name name) ()
       (let ,members
         (list ,@property-list)))))

(defmacro make-property (name&args)
  (let ((name (first name&args))
        (args (second name&args)))
    `(defun ,(new-symbol (symbol-name name))
       (obj ,@(when args args))
       (funcall (getf obj ,name) ,@(when args args))
       )))

(defmacro make-properties (methods)
  `(progn
     ,@(loop for name&args in (extract-name&args methods)
             collect `(make-property ,name&args))))

(defmacro defobj (name &rest class-data)
  (let ((members (when-select :members class-data))
        (methods (when-select :methods class-data)))
    `(progn
       (make-make-property ,name ,members ,methods)
       (make-properties ,methods))))

Going through the macros bottom to top, ‘defobj’ takes a name and everything as a &rest parameter.  We extract each section of code; members and methods, then supply them to each individual sub-macro.

The code this will generate is:

(PROGN
 (MAKE-MAKE-PROPERTY COUNTER-OBJ ((COUNTER 0))
                     ((:INCREMENT-COUNTER NIL (INCF COUNTER))
                      (:GET-COUNTER NIL COUNTER)
                      (:SET-COUNTER (X) (SETF COUNTER X))))
 (MAKE-PROPERTIES
  ((:INCREMENT-COUNTER NIL (INCF COUNTER)) (:GET-COUNTER NIL COUNTER)
   (:SET-COUNTER (X) (SETF COUNTER X))))

‘make-make-property’ will make the function that creates our closure with our p-list. The macro first unwraps methods and reconstruct the p-list items (name, lambda., and code-block). It will then code-generate the defun, and the closure:

(DEFUN MAKE-COUNTER-OBJ ()
  (LET ((COUNTER 0))
    (LIST :INCREMENT-COUNTER (LAMBDA () (INCF COUNTER)) :GET-COUNTER
          (LAMBDA () COUNTER) :SET-COUNTER (LAMBDA (X) (SETF COUNTER X)))))

‘make-properties’ then creates the access functions to the p-list with a loop. It utilizes a sub-macro to build each access function:

(PROGN
 (MAKE-PROPERTY (:INCREMENT-COUNTER NIL))
 (MAKE-PROPERTY (:GET-COUNTER NIL))
 (MAKE-PROPERTY (:SET-COUNTER (X))))

Nothing very interesting here, except for getting just name and parameters from the methods list. The loop is taken from PCL (unit test section).

‘make-property’ is very interesting.  first we separate out the name and args from the input to the sub-macro. We then generate the function with the code generation for accessing the p-list. Originally I had two functions being generated, depending on an ‘if’ args. It seemed too much duplication so I went ahead and added the ‘when’ functions. Here is the macros output:

(DEFUN INCREMENT-COUNTER (OBJ)
  (FUNCALL (GETF OBJ :INCREMENT-COUNTER))

Here is the output from a ‘make-property’ that has a paramter:

(DEFUN SET-COUNTER (OBJ X)
  (FUNCALL (GETF OBJ :SET-COUNTER) X))

Happy Gobbling,

Joe G.