Suppose I have the following two tables
(clsql:def-view-class class-a ()
((field-one :type integer
:db-kind :key
:db-constraints :auto-increment)
(field-two :type string
:initarg :two
:db-constraints :not-null)))
(clsql:def-view-class class-b ()
((b-one :type integer
:initarg :b-one
:db-kind :key)))
(clsql:create-view-from-class 'class-a)
(clsql:create-view-from-class 'class-b)
Now I want entries of class-a that do not have a corresponding entry in class-b. ("Corresponding" meaning that class-a.field-one maps to class-b.b-one.) Suppose that, class-a has the following two entries:
(clsql:update-records-from-instance (make-instance 'class-a :two "hello"))
(clsql:update-records-from-instance (make-instance 'class-a :two "world"))
So, the query to issue would be:
(clsql:select 'class-a :from [class-a] ; class-b is added "magically"
:where [not [in [class-a field-one]
[select [class-b b-one] :from [class-b]
:where [= [class-a field-one]
[class-b b-one]]]]])
However, this adds class-b as well. (With a purposeful error, I get the query executed as:)
SELECT CLASS_A.FIELD_ONE,CLASS_A.FIELD_TWO FROM CLASS_A,CLASS_B
WHERE (NOT ((CLASS_A.FIELD_ONE
IN (SELECT CLASS_B.B_ONE FROM CLASS_B
WHERE (CLASS_A.FIELD_ONE = CLASS_B.B_ONE)))))
On the other hand,
(clsql:select [*] :from [class-a] ; see the [*]
:where [not [in [class-a field-one]
[select [class-b b-one] :from [class-b]
:where [= [class-a field-one]
[class-b b-one]]]]])
is translated to the expected:
SELECT * FROM CLASS_A
WHERE (NOT ((CLASS_A.FIELD_ONE
IN (SELECT CLASS_B.B_ONE FROM CLASS_B
WHERE (CLASS_A.FIELD_ONE = CLASS_B.B_ONE)))))
Is this a bug or is there some reasoning behind this translation?
As of version 6.7.0, redefining the function clsql-sys::%tables-for-query makes it work "as expected", without breaking anything in the webapp I am working on:
(in-package :clsql-sys)
(defun %tables-for-query (classes from where inner-joins)
(declare (ignore where inner-joins))
(union (mapcar #'select-table-sql-expr classes)
(listify from)))
But I haven't run the test-cases clsql-tests.
Related
I am working through the MP3 database example in Peter Seibel's Practical Common Lisp. Seibel demonstrates how macros can be used to shorten the code for the where function; so now, I am trying to use a macro to shorten the code for the update function. (The original version of the update function is included for reference.) When I run my code, the following error originates from the second-to-last line --
*** - CAR: TERMS is not a list
What am I doing wrong? Here is my code.
(defvar *db* nil)
(defun add-record (cd)
(push cd *db*))
(defun dump-db ()
(dolist (cd *db*)
(format t "~{~a:~10t~a~%~}~%" cd)))
(defun make-cd (title artist rating ripped)
(list :title title :artist artist :rating rating :ripped ripped))
(defun prompt-read (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun prompt-for-cd ()
(make-cd
(prompt-read "Title")
(prompt-read "Artist")
(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)
(y-or-n-p "Ripped [y/n]: ")))
(defun add-cds ()
(loop (add-record (prompt-for-cd) )
(if (not (y-or-n-p "Another? [y/n]: ")) (return) )))
(defun save-db (filename)
(with-open-file (out filename
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(print *db* out))))
(defun load-db (filename)
(with-open-file (in filename)
(with-standard-io-syntax
(setf *db* (read in) ))))
(defun select (selector-fn)
(remove-if-not selector-fn *db*))
(defun make-comparison-expr (field value)
`(equal (getf cd ,field) ,value))
(defun make-comparison-list (func fields)
(loop while fields
collecting (funcall func (pop fields) (pop fields))))
(defmacro where (&rest clauses)
`#'(lambda (cd) (and ,#(make-comparison-list 'make-comparison-expr clauses))))
(defun make-update-expr (field value)
`(setf (getf row ,field) ,value))
(defmacro make-update-list (fields)
(make-comparison-list 'make-update-expr fields))
(defun update (selector-fn &rest terms)
(print (type-of terms))
(setf *db*
(mapcar
#'(lambda (row)
(when (funcall selector-fn row)
(make-update-list terms))
row)
*db*)))
;(defun update (selector-fn &key title artist rating (ripped nil ripped-p))
; (setf *db*
; (mapcar
; #'(lambda (row)
; (when (funcall selector-fn row)
; (if title (setf (getf row :title) title) )
; (if artist (setf (getf row :artist) artist) )
; (if rating (setf (getf row :rating) rating) )
; (if ripped-p (setf (getf row :ripped) ripped) ))
; row)
; *db*)))
(defun delete-rows (selector-fn)
(setf *db* (remove-if selector-fn *db*)))
;(loop (print (eval (read))))
(add-record (make-cd "Be" "Common" 9 nil))
(add-record (make-cd "Like Water for Chocolate" "Common" 9 nil))
(add-record (make-cd "Be" "Beatles" 9 nil))
(dump-db)
(update (where :artist "Common" :title "Be") :rating 8)
(dump-db)
-----Edit-----
I figured it out. The solution was to make update a macro and to make make-update-list a function. This way, make-update-list could evaluate fields at run-time and update can still abstract away some tedious if statements. Here is the updated update and make-update-list below:
(defun make-update-list (fields)
(make-comparison-list 'make-update-expr fields))
(defmacro update (selector-fn &rest terms)
`(setf *db*
(mapcar
#'(lambda (row)
(when (funcall ,selector-fn row)
,#(make-update-list terms))
row)
*db*)))
Macroexpansion of that make-update-list is done in a separate phase (called "macroexpansion phase") - which occurs around the time a piece of code is compiled or loaded; in this case we're talking about compilation / loading of update. The macro gets expanded with fields bound to the symbol terms, which (the symbol itself) is used as a value in make-comparison-list; I suppose that was not what you expected.
Note, if you go and compile the file line-by-line (C-c C-c in Emacs + SLIME), it'll tell you right during compilation of update that the macro expansion fails because "the value TERMS is not of type LIST".
Generally, think of macros as functions that take in their arguments unevaluated - i.e. a form (make-update-list foo) will get expanded with the macro parameter's fields value bound to foo. What you're trying to achieve here - code generation based on run-time values - is a bit more difficult to do.
You are trying to take the car of a symbol!
> (car 'terms)
*** - CAR: TERMS is not a list
Think of macros as a function that, when used, replaces the code with the result of the macro function everywhere it's used. At this time variables are just symbols and have no meaning besides that.
When you do (make-update-list terms) it will call the macro function with the argument fields being the symbol you passed, which is terms. Since it's a symbol it cannot be iterated like you are trying. You may iterate it at runtime when it surely is a list, but as a macro it isn't a list until you are passing it a list like (make-update-list (title artist rating ripped)).
If it is dynamic in runtime then your macro needs to expand to code that does most of its magic at runtime. Thus a macro is just a source rewriting service and should not have anything to do with what variable might be at runtime since then it has already done its thing.
When accessing class slots, instead of writing
(defmethod get-name ((somebody person) (slot-value somebody 'name))
is it possible to use the dot notation aka C++, namely
(defmethod get-name ((somebody person) somebody.name) ?
Otherwise, when there are many slot operations in a method, (slot-value... creates a lot of boilerplate code.
I have figured out the answer today and I am just posting it as a Q&A, but if there are better solutions or there are problems I should expect with my solution, feel free to add new answers or comments.
The library access provides a dot notation reader macro for accessing slots (and hash-tables and other things). After enabling the reader macro by calling (access:enable-dot-syntax) you'll able to use #D. to access a slot name with the dot syntax popular in other languages.
(defclass person ()
((name :initarg :name :reader name)))
CL-USER> (access:enable-dot-syntax)
; No values
CL-USER> (defvar *foo* (make-instance 'person :name "John Smith"))
*FOO*
CL-USER> #D*foo*
#<PERSON #x302001F1E5CD>
CL-USER> #D*foo*.name
"John Smith"
There is also a with-dot macro if you don't want to use a reader macro
CL-USER> (access:with-dot () *foo*.name)
"John Smith"
You should not write accessors by hand, nor use slot-value (outside of object lifecycle functions, where the accessors may not have been created yet). Use the class slot options instead:
(defclass foo ()
((name :reader foo-name
:initarg :name)
(bar :accessor foo-bar
:initarg :bar)))
Now you can use the named accessors:
(defun example (some-foo new-bar)
(let ((n (foo-name some-foo))
(old-bar (foo-bar some-foo)))
(setf (foo-bar some-foo) new-bar)
(values n old-bar)))
Often, you want your classes to be "immutable", you'd use :reader instead of :accessor then, which only creates the reader, not the setf expansion.
The easiest solutions seems to be a reader macro that overloads . so that (slot-value somebody 'name) can be written as .somebody.name My strategy is to read somebody.name as a string (we need to define a non-terminating macro character so that the reader does not stop mid-string), and then process the string to construct the appropriate (slot-value...
I will need two helper functions:
(defun get-symbol (str)
"Make an uppercase symbol"
(intern (string-upcase str)))
(defun split-string (str sep &optional (start 0))
"Split a string into lists given a character separator"
(let ((end (position sep str :start start)))
(cons (subseq str start end) (if end (split-string str sep (1+ end))))))
And then I can define my reader macro:
(defun dot-reader (stream char)
(declare (ignore char))
(labels ((make-query (list)
(let ((car (car list))
(cdr (cdr list)))
(if cdr `(slot-value ,(make-query cdr) (quote ,(get-symbol car)))
(get-symbol car)))))
(make-query (nreverse (split-string (symbol-name (read stream)) #\.)))))
Finally, I need to register this reader macro:
(set-macro-character #\. #'dot-reader t)
Now it is possible to write:
(defmethod get-name ((somebody person) .somebody.name)
or, if name is itself a class,
(defmethod get-name ((somebody person) .somebody.name.first-name)
One restriction is that s-expressions will not work between the dots, say
.(get-my-class).name
won't work.
I have the following class:
(defclass category ()
((cat-channel-name
:accessor cat-channel-name :initarg :cat-channel-name :initform "" :type string
:documentation "Name of the channel of this category")
(cat-min
:accessor cat-min :initarg :min :initform 0 :type number
:documentation "Mininum value of category")
(cat-max
:accessor cat-max :initarg :max :initform 1 :type number
:documentation "Maximum value of category"))
(:documentation "A category"))
Now, I would like to use this class as a key for a hash-table. The addresses of instances can be easily compared with eq. The problem is however, there might be multiple identical instances of this category class and I would like the hash-table to recognize this as a key as well.
So, I was trying to overwrite the :test argument of the make-hash-table function like this:
(make-hash-table :test #'(lambda (a b) (and (equal (cat-channel-name a) (cat-channel-name b))
(eq (cat-min a) (cat-min b))
(eq (cat-max a) (cat-max b)))
Unfortunately, this is not allowed. :test needs to be a designator for one of the functions eq, eql, equal, or equalp.
One way to solve this would be to turn the class category into a struct, but I need it to be a class. Is there any way I can solve this?
Many Common Lisp implementations provide extensions to the ANSI Common Lisp standard to support different test and hash functions (and a lot more).
CL-CUSTOM-HASH-TABLE is a compatibility layer.
You can use a more extensible hash table library, as explained in coredump's answer, but you could also use the approach that Common Lisp takes toward symbols: you can intern them. In this case, you just need an appropriate interning function that takes enough of a category to produce a canonical instance, and a hash table to store them. E.g., with a simplified category class:
(defclass category ()
((name :accessor cat-name :initarg :name)
(number :accessor cat-number :initarg :number)))
(defparameter *categories*
(make-hash-table :test 'equalp))
(defun intern-category (name number)
(let ((key (list name number)))
(multiple-value-bind (category presentp)
(gethash key *categories*)
(if presentp category
(setf (gethash key *categories*)
(make-instance 'category
:name name
:number number))))))
Then, you can call intern-category with the same arguments and get the same object back, which you can safely use as a hash table key:
(eq (intern-category "foo" 45)
(intern-category "foo" 45))
;=> T
Don't compare numbers with eq, use eql or =. From eq (emphasis mine):
Objects that appear the same when printed are not necessarily eq to each other. [...]
An implementation is permitted to make "copies" of characters and numbers at any time. The effect is that Common Lisp makes no guarantee that eq is true even when both its arguments are "the same thing" if that thing is a character or number.
You can use the genhash library. First, you define a new hash function (see also sxhash) and a test function for your type and you associate it with a test designator:
(genhash:register-test-designator
'category=
(lambda (category) <hashing>)
(lambda (a b)
(and (equal ... ...)
(= ... ...)
(= ... ...))))
Then, you can define a new table:
(genhash:make-generic-hashtable :test 'category=)
What I'm trying to do:
I want the functionality of simple-error in another error. I want this for these reasons:
to be able to handle it in a separate clause of handler-case.
to avoid specifying the message string over and over again...
to have debugger invoked when the error occurs.
I'm sort of puzzled this doesn't happen naturally by default, never paid enough attention to this issue, but this is apparently how it functions... What I am able to do is to signal an error, which I can later handle with handler-case or handler-bind, but this is bad, because I don't always remember whether the function throws or not, and when it does throw, but I forget to handle it, the function just returns early, as if nothing happened. But if I resume to using simple-error, then my code starts looking like:
...
(signal "Container ~S has no key ~S~&" :container foo :key bar)
...
(signal "Container ~S has no key ~S~&" :container foo :key baz)
...
And so on, all over the place :/ Of course I can dedicate a variable for saving the message text and maybe have a macro to make it shorter, but this doesn't help really, because it only hides the actual clutter instead of solving the problem.
What I could do so far:
(define-condition missing-key (condition)
((key :initarg :key
:accessor key-of)
(container :initarg :container
:accessor container-of))
(:documentation
"An error rised when a KEY is not in the CONTAINER"
:report
#'(lambda (condition stream)
(unless *print-escape*
(format stream "~&Container ~S has no key ~S"
(container-of condition)
(key-of condition))))))
(handler-bind
((missing-key
#'(lambda (condition)
(invoke-debugger condition))))
(signal 'missing-key :key 'foo :container 'bar))
What happens, however is that reporting function never gets called... when the error is signalled, instead it prints a generic message Condition MISSING-KEY was signalled.
EDIT:
Thanks to sds answer, this is what I have now:
(define-condition missing-key (error)
((key :initarg :key
:accessor key-of)
(container :initarg :container
:accessor container-of))
(:documentation
"An error rised when a KEY is not in the CONTAINER")
(:report
(lambda (condition stream)
(format stream "Container ~S has no key ~S"
(container-of condition)
(key-of condition)))))
(defmacro signal-missing-key (container key)
`(let ((*break-on-signals*
(cond
((null *break-on-signals*) 'missing-key)
((consp *break-on-signals*)
(list 'or 'missing-key (cdr *break-on-signals*)))
(t (list 'or *break-on-signals* 'missing-key)))))
(signal 'missing-key :key ,container :container ,key)))
I could probably make it more generic by passing more arguments down to signal, but this does what I wanted to do initially, so, unless there is a better way to do the same thing, I'll probably just use this.
You can use error or cerror with your own condition types, if you want the debugger to be invoked unless the conditions are handled otherwise. This also works for conditions that are not descendants of simple-error.
If you want this behavior for signal, too, you can set the variable *break-on-signals* to the according type. For example, you could set it to t in order to invoke the debugger for every unhandled condition.
Your code works as you intended with the following modifications: remove #' before lambda, remove ~& from format (error reporting does that and more), close the :documentation clause and open the :report clause:
(define-condition missing-key (condition)
((key :initarg :key
:accessor key-of)
(container :initarg :container
:accessor container-of))
(:documentation
"An error rised when a KEY is not in the CONTAINER")
(:report
(lambda (condition stream)
(unless *print-escape*
(format stream "Container ~S has no key ~S"
(container-of condition)
(key-of condition))))))
MISSING-KEY
(signal 'missing-key :key 'foo :container 'bar)
==> NIL
(handler-bind
((missing-key
#'(lambda (condition)
(invoke-debugger condition))))
(signal 'missing-key :key 'foo :container 'bar))
*** - Container BAR has no key FOO
The following restarts are available:
ABORT :R1 Abort main loop
Break 1 [46]>
i.e., signal prints nothing but handler invokes the debugger.
Make your condition a subclass of ERROR rather than CONDITION. Not all conditions are errors that require intervention via debugger, and the condition class hierarchy is designed to distinguish between them.
I'm writing a dungeon crawler game in CL, and I'm having trouble with the case form.
Two things:
Common Lisp complains Duplicate keyform QUOTE in CASE statement
(make-instance 'cl-rogue:tile tile-type 'wall) should print as "#", but the object prints as " " no matter which tile-type I use.
The code:
(in-package :cl-user)
(defpackage :cl-rogue
(:use :common-lisp)
(:export
:*rows*
:*cols*
:*levels*
:tile
:tile-type
:tile-contents
:tile-hidden
:tile-locked
:tile-closed
:main))
(in-package :cl-rogue)
(defparameter *cols* 80)
(defparameter *rows* 24)
(defparameter *levels* 26)
The class:
(defclass tile ()
((tile-type
:initarg :tile-type
:accessor tile-type
:initform 'floor
:documentation "Type of tile")
(tile-contents
:initarg :tile-contents
:accessor tile-contents
:initform '()
:documentation "Any items the tile holds")
(tile-hidden
:initarg :tile-hidden
:accessor tile-hidden
:initform nil
:documentation "Whether the tile is hidden or shown")
(tile-locked
:initarg :tile-locked
:accessor tile-locked
:initform nil
:documentation "Whether the tile is locked")
(tile-closed
:initarg :tile-closed
:accessor tile-closed
:initform nil
:documentation "Whether the tile is open or closed")))
The print method:
(defmethod print-object ((object tile) stream)
(with-slots (tile-type tile-contents tile-hidden tile-locked tile-closed) object
(if tile-hidden
(format stream " ")
(let ((an-item (car tile-contents)))
(if an-item
(format stream "~a" an-item)
(format stream (case tile-type
('wall "#")
('upstair "<")
('downstair ">")
('door (if tile-closed "+" "\\"))
(otherwise " "))))))))
You don't need to quote the symbols in CASE.
Actually you shouldn't quote symbols in CASE clauses.
See:
CL-USER 31 > (case 'quote
('not-quote 'oops-really-quote)
('quote 'it-is-a-quote))
OOPS-REALLY-QUOTE
Above is the unintended consequence of using 'not-quote instead of the correct unquoted not-quote.
The following is correct:
CL-USER 32 > (case 'quote
(not-quote 'oops-really-quote)
(quote 'it-is-a-quote))
IT-IS-A-QUOTE
The syntax of CASE in Common Lisp
case keyform
{normal-clause}*
[otherwise-clause]
=> result*
normal-clause::= (keys form*)
otherwise-clause::= ({otherwise | t} form*)
clause::= normal-clause | otherwise-clause
keys ::= object | (object*)
As you can see the keys are either a single object or a list of objects. The objects are not evaluated.
Symbols in CASE clauses are not evaluated.
(case tile-type
(wall ...)
(door ...))
WALL and DOOR are purely symbols and not evaluated as variables.
The Lisp reader reads 'fooas (quote foo).
You wrote:
(case tile-type
('wall ...)
('door ...))
Which is the equivalent of:
(case tile-type
((quote wall) ...)
((quote door) ...))
But you can't quote a symbol in CASE. You have to provide the symbols as literal constants.
If you write:
(let ((bar 'foo)
(baz 'foo))
(case bar
(baz :we-have-a-foo-through-baz)
(foo :we-really-have-a-foo)))
This returns :WE-REALLY-HAVE-A-FOO. Because CASE uses constant data, not variables.
CASE accepts a list of items. Since you have QUOTE as a symbol in more than clause, the compiler showed a warning.
As I said, there is no quoting possible, since the items are not evaluated.
As for CASE accepting a list of items in the clauses, it looks like this:
(case tile-type
((door wall) ...)
((floor window painting) ...))
For the WALL symbol, you need to make sure that it is in the right package when you create the object.
Better use a keyword symbol, such as :wall. Then you don't need to export it and there is no confusion about in which package the symbol is.
About the formatting of the code:
You had a bullet list and right after it a code section. This is not rendered as you expect. I have added the text 'The code:' before the code. Then the rendering works as expected.