An Object in Lisp. Part 3

Adding constructors to object

The object needs to be able to implement default constructors. This required making changes to ‘defobj’ and ‘make-make-property’.

Specifically:

(defobj init
  (:init (d1 d2))
  (:methods
    ((:get-data () (values d1 d2))))
(defmacro defobj (name &rest class-data)
  (let ((members (when-select :members class-data))
        (methods (when-select :methods class-data))
        (constructors (when-select :init class-data)))
    `(progn
       (make-make-property ,name ,constructors ,members ,methods)
       (make-properties ,methods)))
(defmacro make-make-property (obj-name constructors 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 obj-name) (&rest args)
       (destructuring-bind ,constructors args
         (let ,members
           (list ,@property-list)))))

Using ‘defobj’ we extract out the code for the constructor. A change was made to ‘make-make-property by adding another parameter, ‘constructors. We now make a change to our code-generation to include args. then we use a destructuring-bind to bind the ‘constructors to ‘args. This will then wrap members and the list into a let. That is it.

Universal Identification

Because of later uses of objects, I need to have a way to create a specific identifier for each instance of a specific object. This isn’t a very good implementation of a universal identification generator. If anybody has a much better implementation, let me know. The implementation of a UID requires three new functions:

(defun unique-string-name (name-string)
  (format nil "~(~{~2,'0X~}~)"
          (coerce (sb-md5:md5sum-string
                   (sb-ext:native-namestring name-string))
                  'list)))

(defun uid (random-fn name-string)
  (unique-string-name
   (format nil "~a~a" name-string (funcall random-fn 1000000000))))

(defun object-id (obj)
  (funcall (getf obj :object-id)))

‘unique-string-name’ is a function taken from sb-cover. It takes a string and generates a funky string.

‘uid’ actually generates the uid. I pass in ‘random-fn, because I wanted to unit test this functions. The function will create a string from ‘name-string (object’s name) and randomly generate a number up to 1,000,000,000.

‘object-id’ is implemented as a function outside of the ‘defobj’ macro. All ‘defobj’ generated objects will implement an object-id in it’s list. This is done in ‘make-make-property’:

(defmacro make-make-property (obj-name constructors members methods)
  (let ((property-list (loop for property in methods
                             append
                             (let ((name (first property))
                                   (args (second property))
                                   (expressions (cddr property)))
                               `(,name (lambda ,args ,@expressions))))))
    `(defun ,(make-name obj-name) (&rest args)
       (destructuring-bind ,constructors args
         (let ((object-id (uid #'random ,(symbol-name obj-name))))
           (let ,members
             (list ,@property-list ,@(list :object-id `(lambda () object-id))))))))

All that was done was we close over the previous let with a new let that contains a variable object-id. The next part is when we create the list the contains the closures, we add the object-id closure.

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: