An Object in Lisp. Part 3

November 30, 2008

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.


An Object in Lisp. Part 2 Addendum

November 27, 2008

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.


Working on legacy code Part 2

November 21, 2008

Now that most of the low-hanging fuit has been picked from sb-cover, it is time to try to tackle some logic. The logic is at the start of the function ‘report’.

What it does extract sb-c::*code-coverage-info*. This is a hash table that uses pathnames to files as keys. The values stored is unknown at this time.

The logic that I want to tackle is the ‘maphash’ function. The function takes a function with two inputs (a key and value):

(maphash (lambda (k v)
               (declare (ignore v))
               (let* ((n (format nil "~(~{~2,'0X~}~)"
                                 (coerce (sb-md5:md5sum-string
                                          (sb-ext:native-namestring k))
                                         'list)))
                      (path (make-pathname :name n :type "html")))
                 (when (probe-file k)
                   (with-open-file (stream path
                                           :direction :output
                                           :if-exists :overwrite
                                           :if-does-not-exist :create)
                     (push (list* k n (report-file k stream external-format))
                           paths)))))
             *code-coverage-info*)

The first thing is I want to do is extract it into its own function. This is very dangerous, there are no unit tests.

(defun make-coverage-list (code-coverage-info external-format)
  (let ((paths))
    (maphash (lambda (key value)
               (declare (ignore value))
               (let ((n (create-unique-name key))
                     (path (create-unique-html-path key)))
                 (when (probe-file key)
                   (with-open-file (stream path
                                           :direction :output
                                           :if-exists :overwrite
                                           :if-does-not-exist :create)
                     (setf paths (push (list* key n (report-file key stream external-format)) paths))))))
             code-coverage-info)
    paths)

I’ve been doing Lisp for almost a year now and always forgetting things; Lisp passes-by-value. That is why I return paths.

This still is not where I want to be. I can’t get at the logic in this because I’m opening a file. When writing unit tests you try to remove as much external dependencies as possible. ‘with-open-file’ is a dependency on the file system. Need to extract method again:

(defun make-coverage-list (code-coverage-info external-format)
  (let ((coverage-data))
    (maphash (lambda (key value)
               (declare (ignore value))
               (let ((unique-name (create-unique-name key))
                     (path (create-unique-html-path key)))
                 (when (probe-file key)
                   (setf coverage-data (write-source-html path unique-name key external-format)))))
             code-coverage-info)
    coverage-data))

(defun write-source-html (path name source-path-name external-format)
  (let ((paths))
    (with-open-file (stream path
                            :direction :output
                            :if-exists :overwrite
                            :if-does-not-exist :create)
      (setf paths (push
                   (list* source-path-name name (report-file source-path-name stream external-format)) paths)))
    paths))

Still need some more changes:

(defun make-coverage-list (code-coverage-info external-format fn-truename-exist? fn-source-write)
  (let ((coverage-data))
    (maphash (lambda (key value)
               (declare (ignore value))
               (let ((unique-name (create-unique-name key))
                     (path (create-unique-html-path key)))
                 (when (funcall fn-truename-exist? key)
                   (setf coverage-data (push (funcall fn-source-write path unique-name key external-format) coverage-data)))))
             code-coverage-info)
    coverage-data))

(defun write-source-html (path name source-path-name external-format)
  (let ((paths))
    (with-open-file (stream path :direction :output :if-exists :overwrite :if-does-not-exist :create)
      (setf paths (push
                   (list* source-path-name name (report-file source-path-name stream external-format)) paths)))
    paths))

(defun create-unique-html-path (name-string)
  (make-pathname :name (create-unique-name name-string):type "html"))

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

Here is the unit test for testing ‘make-coverage-list’:

;;; Mocking functions
(let ((is-exist))
  (defun truename-exist? (key)
    (declare (ignore key))
    is-exist)
  (defun exist ()
    (setf is-exist t))
  (defun not-exist ()
    (setf is-exist nil))
  (defun source-writer (path name source-path-name external-format)
    (declare (ignore path external-format))
    (list* source-path-name name "source-code")))

(test-fixture make-coverage-list
    (:setup ((coverage-list '(("whatever-directory\\huh.lisp" "821ea77acb15d31a2ee610daddaa0c8e" . "source-code")))
             (source-file (first (first coverage-list)))))
  (:tests
    (should-make-coverage-list-exist
     (let ((cover-data (make-hash-table)))
       (setf (gethash source-file cover-data) (list "cover-data"))
       (exist)
       (assert-equal coverage-list (make-coverage-list cover-data :default #'truename-exist? #'source-writer))))

    (should-make-coverage-list-no-exist
     (declare (ignore coverage-list))
     (let ((cover-data (make-hash-table)))
       (setf (gethash source-file cover-data) (list "cover-data"))
       (not-exist)
       (assert-equal nil (make-coverage-list cover-data :default #'truename-exist? #'source-writer))
       ))
    ))

And the final client for using ‘make-coverage-list:

(defun report (directory &key ((:form-mode *source-path-mode*) :whole)
                         (external-format :default))
  (let ((paths)
        (*default-pathname-defaults* (pathname-as-directory directory)))
    (ensure-directories-exist *default-pathname-defaults*)
    (setf paths (make-coverage-list *code-coverage-info* external-format #'probe-file #'write-source-html))
    (let ((report-file-pathname (make-pathname :name "cover-index" :type "html")))
      (with-open-file (stream report-file-pathname
                              :direction :output :if-exists :overwrite
                              :if-does-not-exist :create)
        (write-styles stream)
        (unless paths
          (write-no-coverage-data stream)
          (close stream)
          (return-from report))
        (write-header stream)
        (setf paths (sort paths #'string< :key #'car))
        (loop for prev = nil then source-file
              for (source-file report-file-pathname expression branch) in paths
              for is-even? = nil then (not is-even?)
              do (when (or (null prev)
                           (not (equal (pathname-directory (pathname source-file))
                                       (pathname-directory (pathname prev)))))
                   (write-source-file-pathname stream source-file))
              do (write-coverage-data stream source-file is-even? report-file-pathname expression branch))
        (write-end-table stream))
      report-file-pathname)))

You’ll notice that I injected two functions into ‘make-coverage-list’. In the unit tests you can see that I’ve created stubs to emulate the functions.

Here is todays numbers:

Expression Branch
Source file Covered Total % Covered Total %
\_Holder\WorkSpace\gWeb\sb-cover-dev\src\
cover.lisp 308 1085 28.4 10 82 12.2
\_Holder\WorkSpace\gWeb\sb-cover-dev\unit-tests\
sb-cover-dev-tests.lisp 12 12 100.0 0 0

Yesterdays numbers:

Expression Branch
Source file Covered Total % Covered Total %
\_Holder\WorkSpace\gWeb\sb-cover-dev\src\
cover.lisp 201 1047 19.2 2 84 2.4

The numbers can be a bit misleading due to grabbing some low hanging fruit today.


Working on legacy code Part 1

November 20, 2008

The project I’m working on right now is sb-cover. I want to integrate it with lisp-unit-with-fixture.

For me, to understand code, it is best if I create coverage tests to ensure that when I change code, I don’t change the codes behavior.

Looking at the design of the application I noticed that the coverage data model and the view (HTML) is intermingled:

        (format stream "<table class='summary'>")
        (format stream "<tr class='head-row'><td></td><td class='main-head' colspan='3'>Expression</td><td class='main-head' colspan='3'>Branch</td></tr>")
        (format stream "<tr class='head-row'>~{<td width='80px'>~A</td>~}</tr>"
                (list "Source file"
                      "Covered" "Total" "%"
                      "Covered" "Total" "%")

So to start you grab the low-lying fruit and encapsulate it:

(defun write-header (stream)
  (format stream "<table class='summary'>")
  (format stream "<tr class='head-row'><td></td><td class='main-head' colspan='3'>Expression</td><td class='main-head' colspan='3'>Branch</td></tr>")
  (format stream "<tr class='head-row'>~{<td width='80px'>~A</td>~}</tr>"
          (list "Source file"
                "Covered" "Total" "%"
                "Covered" "Total" "%"))

The function ‘write-header’ outputs a string. Let’s pin this down with an unit test:

(test-fixture html-stream-writing
    (:setup
      ((header "<table class='summary'> ;....
  (:tests
    (should-write-html
     (assert-equal header (with-output-to-string (out)
                            (write-header out)))))

And that is how you start to get your code under control.

Expression Branch
Source file Covered Total % Covered Total %
\_Holder\WorkSpace\gWeb\sb-cover-dev\src\
cover.lisp 201 1047 19.2 2 84 2.4

cover-runner in CUSP

November 19, 2008

I’ve started using sb-cover that comes with SBCL 1.0.22.

  • Create a directory in your project named “coverage-tests”.
  • Create a file named “cover-tests.lisp”.
  • Add to file (:publisher is the package name that I’m running the coverage on):
(in-package #:publisher)
(require :coverage-runner)

(coverage-runner:run-cover :publisher
  • Bring up the Lisp Navigator.
  • Right-click over “cover-tests.lisp”.
  • Select ‘Load File’.
  • Right-click over directory “coverage-tests”
  • Select ‘Refresh’. A new directory named “coverage-report” and html files appear.
  • Double-click on “cover-Index.html”
  • Voila`.
Expression Branch
Source file Covered Total % Covered Total %
\_Holder\WorkSpace\gWeb\publisher\src\
handler-list.lisp 44 44 100.0 6 6 100.0
publisher.lisp 45 45 100.0 6 6 100.0
\_Holder\WorkSpace\gWeb\publisher\unit-tests\
handler-list-tests.lisp 14 14 100.0 0 0
publisher-tests.lisp 5 5 100.0 0 0
\_Holder\lisp-libraries\lisp-unit\src\
asserts.lisp 97 210 46.2 1 2 50.0
equality-predicates.lisp 4 21 19.0 0 6 0.0
fixture.lisp 57 57 100.0 2 2 100.0
lisp-unit.lisp 135 235 57.4 7 28 25.0
status.lisp 170 284 59.9 4 8 50.0
stopwatch.lisp 32 37 86.5 0 0
view.lisp 128 176 72.7 1 4 25.0
\_Holder\lisp-libraries\lisp-unit\unit-tests\
fixture-tests.lisp 0 10 0.0 0 0

Object Oriented Programmer in Crisis

November 19, 2008

Code coverage is the glove that fits over unit testing. In order to get an idea of what code coverage follow the link.

I started back into software development with VB6 and then added C#. I love the idea of Test Driven Development (TDD). Reflection in C# seemed to me a HUGE step forward in the tools available to a simple  programmer. NUnit, NCover, Rhino-Mocks, Resharper, and NDepend were my tools of choice.

The paradigm for the use of these tools was to focus from the outside in. What I mean is that you would start at the Integration level and keep adding functionality and refactoring to the lowest type. The problem with this was that I always rolled my integrator/interpreter. I would feed the interperter with a text file:

# Basic Move of Player
Map 3, 3
Player 1, 1
Move n
Move s
move e
move w
Assert 1, 1

# Verify that player stays in north boundaries
map 3, 3
player 1, 1
move n
move n
move n
assert 1, 0

# Verify that player stays in west boundaries
move w
move w
move w
assert 0, 0

# Verify that player stays in south boundaries
move s
move s
move s
assert 0, 2

# Verify that player stays in east boundaries
MOVE e
MOVE e
moVE e
ASSERT 2, 2

See My Tutorial in C#

It is human readable. If you’ve read Pragmatic Programmer you will know what I’m talking about.

The problem with using an interpreter is that I had no way to pin down the text file. Yes I could pin down the interpreter machinery with unit testing, but not the script file. The text file is data not code. Unit testing works on code not data.

In order to pin the script down it would need to be implemented in my source language, but it is very hard to do in C# reflection and all.

It seemed to work pretty good, but I could never shake this feeling that something was missing, until I ran into Greenspun’s Tenth Rule.

The promise of code is data and data is code appealed to me.

So started my travels into Lisp (excpet checking out some AI book when I was in the US Navy).

After reviewing the eco-system for Common Lisp I’ve come to some conclusions.

  1. Automation using a tool stack that will let you use unit testing, code coverage, profiling, and integration testing is just not for beginners.
  2. Not enough tutorials on building applications (Not Including PCL){Great Book!}
  3. More in-depth knowledge of the basics and their implementation in applications. On Lisp is good for beginners. But in the book PG says: “In real programs, the closures and data structures would also be more elaborate than those we see in make-adder or make-dbms.”, what could those elaborations be?
  4. Some code that I’ve seen can be Spaghetti Code or a Big Ball of Mud.
  5. My own code in lisp can be characterized by item 4.

My goal is to work on item 1.

I’ve worked on adding a fixture to lisp-unit. See My Downloads Section. Now I’m starting on adding sb-cover.

Also I’m going to be getting into ASDF. I think their is a lot of potential their for using it to automate item 1.

Happy Lambda


Update to test-fixture

November 18, 2008

An update to test-fixtures was required to handle setup code. Specifically, LET* and variable loading from LET*:

(create-tests :setup-let-and-variable-load
 (:setup  ((true t) (not-false nil))
   (setf not-false true))

 (:tests
   (test-bind-form2 (assert-true not-false))
   (test-bind-form3 (assert-true not-false))))

(create-tests :setup-let-and-use-variables
 (:setup ((lister (make-list 0))
          (lister-with-push (push 'hello lister)))