Peter Siebel - Practical Common Lisp

Since selectreturns another table, you need to think a bit about how you want to get at the individual row and column values in a table. If you're sure you'll never want to change the way you represent the data in a table, you can just make the structure of a table part of the API—that tablehas a slot rowsthat's a vector of plists—and use all the normal Common Lisp functions for manipulating vectors and plists to get at the values in the table. But that representation is really an internal detail that you might want to change. Also, you don't necessarily want other code manipulating the data structures directly—for instance, you don't want anyone to use SETF to put an unnormalized column value into a row. So it might be a good idea to define a few abstractions that provide the operations you want to support. Then if you decide to change the internal representation later, you'll need to change only the implementation of these functions and macros. And while Common Lisp doesn't enable you to absolutely prevent folks from getting at "internal" data, by providing an official API you at least make it clear where the boundary is.

Probably the most common thing you'll need to do with the results of a query is to iterate over the individual rows and extract specific column values. So you need to provide a way to do both those things without touching the rowsvector directly or using GETF to get at the column values within a row.

For now these operations are trivial to implement; they're merely wrappers around the code you'd write if you didn't have these abstractions. You can provide two ways to iterate over the rows of a table: a macro do-rows, which provides a basic looping construct, and a function map-rows, which builds a list containing the results of applying a function to each row in the table. [296] The version of LOOP implemented at M.I.T. before Common Lisp was standardized included a mechanism for extending the LOOP grammar to support iteration over new data structures. Some Common Lisp implementations that inherited their LOOP implementation from that code base may still support that facility, which would make do-rows and map-rows less necessary.

(defmacro do-rows ((row table) &body body)

`(loop for ,row across (rows ,table) do ,@body))

(defun map-rows (fn table)

(loop for row across (rows table) collect (funcall fn row)))

To get at individual column values within a row, you should provide a function, column-value, that takes a row and a column name and returns the appropriate value. Again, it's a trivial wrapper around the code you'd write otherwise. But if you change the internal representation of a table later, users of column-valueneedn't be any the wiser.

(defun column-value (row column-name)

(getf row column-name))

While column-valueis a sufficient abstraction for getting at column values, you'll often want to get at the values of multiple columns at once. So you can provide a bit of syntactic sugar, a macro, with-column-values, that binds a set of variables to the values extracted from a row using the corresponding keyword names. Thus, instead of writing this:

(do-rows (row table)

(let ((song (column-value row :song))

(artist (column-value row :artist))

(album (column-value row :album)))

(format t "~a by ~a from ~a~%" song artist album)))

you can simply write the following:

(do-rows (row table)

(with-column-values (song artist album) row

(format t "~a by ~a from ~a~%" song artist album)))

Again, the actual implementation isn't complicated if you use the once-onlymacro from Chapter 8.

(defmacro with-column-values ((&rest vars) row &body body)

(once-only (row)

`(let ,(column-bindings vars row) ,@body)))

(defun column-bindings (vars row)

(loop for v in vars collect `(,v (column-value ,row ,(as-keyword v)))))

(defun as-keyword (symbol)

(intern (symbol-name symbol) :keyword))

Finally, you should provide abstractions for getting at the number of rows in a table and for accessing a specific row by numeric index.

(defun table-size (table)

(length (rows table)))

(defun nth-row (n table)

(aref (rows table) n))

Finally, you'll implement a few other database operations that you'll need in Chapter 29. The first two are analogs of the SQL DELETEstatement. The function delete-rowsis used to delete rows from a table that match particular criteria. Like select, it takes :fromand :wherekeyword arguments. Unlike select, it doesn't return a new table—it actually modifies the table passed as the :fromargument.

(defun delete-rows (&key from where)

(loop

with rows = (rows from)

with store-idx = 0

for read-idx from 0

for row across rows

do (setf (aref rows read-idx) nil)

unless (funcall where row) do

(setf (aref rows store-idx) row)

(incf store-idx)

finally (setf (fill-pointer rows) store-idx)))

In the interest of efficiency, you might want to provide a separate function for deleting all the rows from a table.

(defun delete-all-rows (table)

(setf (rows table) (make-rows *default-table-size*)))

The remaining table operations don't really map to normal relational database operations but will be useful in the MP3 browser application. The first is a function to sort the rows of a table in place.

(defun sort-rows (table &rest column-names)

(setf (rows table) (sort (rows table) (row-comparator column-names (schema table))))

table)

On the flip side, in the MP3 browser application, you'll need a function that shuffles a table's rows in place using the function nshuffle-vectorfrom Chapter 23.

(defun shuffle-table (table)

(nshuffle-vector (rows table))

table)

And finally, again for the purposes of the MP3 browser, you should provide a function that selects n random rows, returning the results as a new table. It also uses nshuffle-vectoralong with a version of random-samplebased on Algorithm S from Donald Knuth's The Art of Computer Programming, Volume 2: Seminumerical Algorithms , Third Edition (Addison-Wesley, 1998) that I discussed in Chapter 20.

(defun random-selection (table n)

(make-instance

'table

:schema (schema table)

:rows (nshuffle-vector (random-sample (rows table) n))))

(defun random-sample (vector n)

"Based on Algorithm S from Knuth. TAOCP, vol. 2. p. 142"

(loop with selected = (make-array n :fill-pointer 0)

for idx from 0

do

(loop

with to-select = (- n (length selected))

for remaining = (- (length vector) idx)