I'm trying to build a function to access records in a database as such:
(select :title "milk" :rating 7)
However, it's just returning all of the records in the database. I believe this is because I'm passing &rest arguments to a macro and it's interpreting the parameter name "fields" literally. I've tried removing &rest from my macro, but then I get an error about not passing a list. I've tried calling (list fields) in various places to no avail (in the macro, in the function that calls the macro, in the function that the macro calls).
The following code works as expected:
(select-custom (where :title "milk" :rating 7))
And returns only the records which match the arguments.
source code:
(defun select (&rest fields)
(select-custom (where fields)))
(defun select-custom (selector-function)
(remove-if-not selector-function *db*))
(defmacro where (&rest fields)
`#'(lambda (cd) (and ,#(make-comparison-list fields))))
(defun make-comparison-list (fields)
(loop while fields
collecting (make-comparison-exp (pop fields) (pop fields))))
(defun make-comparison-exp (field value)
`(equal (getf cd ,field) ,value))
You could just make select a macro instead
(defmacro select (&rest fields)
`(select-custom (where ,#fields)))
You can check that
(macroexpand-1 '(select :title "milk" :rating 7))
returns
(SELECT-CUSTOM (WHERE :TITLE "milk" :RATING 7))
The best solution would be to create a function version of where. But as a simple kludge, you can use eval
(defun select (&rest fields)
(select-custom (eval `(where ,#fields))))
Related
Looking at Practical Common Lisp, we're looking at a simple automated unit test framework. We're trying to write a macro to be used as such:
(check (= (+ 1 2) 3) (= (- 1 4) 9))
This should expand to something using a previously defined function report-result. The suggested implementation is:
(defmacro check (&body forms)
`(progn
,#(loop for f in forms collect `(report-result ,f ',f))))
However, that expansion seems rather procedural to me. I wanted to replace the loop with a mapcar to expand to something like this:
(mapcar #'(lambda (form) (report-result form 'form)) (list form-1 ... form-n))
However, I'm clearly lacking the macro-writing skills to do so. Can someone come up with one such macro?
In case it's relevant, this is the definition of report-result:
(defun report-result (result form)
(format t "~:[FAIL~;pass~] ... ~a~%" result form))
It's indeed fairly simple: you just place the collect expression into the body of your mapcar:
(defmacro check (&body forms)
`(progn
,#(mapcar #'(lambda (form)
`(report-result ,form ',form))
forms)))
You don't really need to know anything about the "macro-y" stuff that's going on, in order to do the replacement you want, which is simply replacing a loop with some other equivalent expression: it will work just as well in a macro context as it would outside.
If you want to expand to a mapcar you can, but there's no real reason to do so, since the list's size is known at compile time. Here's what that would look like:
(defmacro check (&body forms)
`(let ((results (list ,#(mapcar #'(lambda (form)
`(list ,form ',form))
forms))))
(mapcar #'(lambda (result)
(report-result (car result) (cadr result)))
results)))
Which expands like so
> (macroexpand-1 '(check (+ 1 2) (* 2 3)))
(let ((results (list (list (+ 1 2) '(+ 1 2))
(list (* 2 3) '(* 2 3)))))
(mapcar #'(lambda (result) (report-result (car result) (cadr result)))
results))
Which as you can see is rather awkward: the macro already has the forms like (+ 1 2) available to it, but in order to preserve them to runtime for the mapcar lambda to see, you have to emit the input form twice. And you have to produce the whole list to map over, rather than just producing a list that's "finished" to begin with. Additionally, this produces a list as output, and requires having all the inputs and outputs in memory at once: the original macro with progn produced the inputs and outputs one at a time, and discarded them when finished.
I was toying around with macros and clos, where I created an "object" macro to create instances
(defmacro object (class &rest args)
`(make-instance ',class ,#args))
Now doing this, I also ended up kind of wanting to do something similar for accessor functions created by clos. Example:
(defclass person () ((name :accessor person-name :initarg :name)))
then creating the instance
(setf p1 (object person :name "tom"))
now to get the name from the object obviously I would call person-name, however just as with the object macro, I wanted to create a "gets" macro to do this. So ideally:
(gets person name p1) which then would return the name.
The problem then is the binding of person and name (person-name) and how to do that. Is there anyway to get those two arguments bound together in the macro? sort of like:
(defmacro gets (class var object)
`(,class-,var ,object))
I think I may have misunderstood the original intent. At first I thought you were asking how to generate the accessor names for the class definition, which third part of the answer addresses. After reading through a second time, it actually sounds like you want to generate a new symbol and call it with some argument. That's easy enough too, and is given in the second part of this answer. Both the second and third parts depend on being able to create a symbol with a name that's built from the names of other symbols, and that's what we start with.
"Concatenating" symbols
Each symbol has a name (a string) that you can obtain with symbol-name. You can use concatenate to create a new string from some old strings, and then use intern to get a symbol with the new name.
(intern (concatenate 'string
(symbol-name 'person)
"-"
(symbol-name 'name)))
;=> PERSON-NAME
Reconstructing an accessor name
(defmacro gets (class-name slot-name object)
(let ((accessor-name
(intern (concatenate 'string
(symbol-name class-name)
"-"
(symbol-name slot-name))
(symbol-package class-name))))
`(,accessor-name ,object)))
(macroexpand-1 '(gets person name some-person))
;=> (PERSON-NAME SOME-PERSON)
For a number of reasons, though, this isn't very robust. (i) You don't know whether or not the slot has an accessor of the form <class-name>-<slot-name>. (ii) Even if the slot does have an accessor of the form <class-name>-<slot-name>, you don't know what package it's in. In the code above, I made the reasonable assumption that it's the same as the package of the class name, but that's not at all required. You could have, for instance:
(defclass a:person ()
((b:name :accessor c:person-name)))
and then this approach wouldn't work at all. (iii) This doesn't work with inheritance very well. If you subclass person, say with north-american-person, then you can still call person-name with a north-american-person, but you can't call north-american-person-name with anything. (iv) This seems to be reïnventing slot-value. You can already access the value of a slot using the name of the slot alone with (slot-value object slot-name), and I don't see any reason that your gets macro shouldn't just expand to that. There you wouldn't have to worry about the particular name of the accessor (if it even has one), or the package of the class name, but just the actual name of the slot.
Generating accessor names
You just need to extract the names of the symbols and to generate a new symbol with the desired name.
If you want to automatically generate accessors with defstruct style names, you can do it like this:
(defmacro define-class (name direct-superclasses slots &rest options)
(flet ((%slot (slot)
(destructuring-bind (slot-name &rest options)
(if (listp slot) slot (list slot))
`(,slot-name ,#options :accessor ,(intern (concatenate 'string
(symbol-name name)
"-"
(symbol-name slot-name)))))))
`(defclass ,name ,direct-superclasses
,(mapcar #'%slot slots)
,#options)))
You can check that this produces the kind of code that you'd expect by looking at the macroexpansion:
(pprint (macroexpand-1 '(define-class person ()
((name :type string :initarg :name)
(age :type integer :initarg :age)
home))))
(DEFCLASS PERSON NIL
((NAME :TYPE STRING :INITARG :NAME :ACCESSOR PERSON-NAME)
(AGE :TYPE INTEGER :INITARG :AGE :ACCESSOR PERSON-AGE)
(HOME :ACCESSOR PERSON-HOME)))
And we can see that it works as expected:
(define-class person ()
((name :type string :initarg :name)
(age :type integer :initarg :age)
home))
(person-name (make-instance 'person :name "John"))
;=> "John"
Other comments on your code
(defmacro object (class &rest args)
`(make-instance ',class ,#args))
As Rainer pointed out this isn't very useful. For most cases, it's the same as
(defun object (class &rest args)
(apply 'make-instance class args))
except that you can (funcall #'object …) and (apply #'object …) with the function, but you can't with the macro.
Your gets macro isn't really any more useful than slot-value, which takes an object and the name of a slot. It doesn't require the name of the class, and it will work even if the class doesn't have a reader or accessor.
Don't (naïvely) create symbol names with format
I've been creating symbol names with concatenate and symbol-name. Sometimes you'll see people use format to construct the names, e.g., (format nil "~A-~A" 'person 'name), but that's prone to issues with capitalization settings that can be changed. For instance, in the following, we define a function foo-bar, and note that the format based approach fails, but the concatenate based approach works.
CL-USER> (defun foo-bar ()
(print 'hello))
FOO-BAR
CL-USER> (foo-bar)
HELLO
HELLO
CL-USER> (setf *print-case* :capitalize)
:Capitalize
CL-USER> (funcall (intern (concatenate 'string (symbol-name 'foo) "-" (symbol-name 'bar))))
Hello
Hello
CL-USER> (format nil "~a-~a" 'foo 'bar)
"Foo-Bar"
CL-USER> (intern (format nil "~a-~a" 'foo 'bar))
|Foo-Bar|
Nil
CL-USER> (funcall (intern (format nil "~a-~a" 'foo 'bar)))
; Evaluation aborted on #<Undefined-Function Foo-Bar {1002BF8AF1}>.
The issue here is that we're not preserving the case of the symbol names of the arguments. To preserve the case, we need to explicitly extract the symbol names, rather than letting the print functions map the symbol name to some other string. To illustrate the problem, consider:
CL-USER> (setf (readtable-case *readtable*) :preserve)
PRESERVE
;; The symbol-names of foo and bar are "foo" and "bar", but
;; you're upcasing them, so you end up with the name "FOO-BAR".
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'STRING-UPCASE '(foo bar)))
"FOO-BAR"
;; If you just concatenate their symbol-names, though, you
;; end up with "foo-bar".
CL-USER> (CONCATENATE 'STRING (SYMBOL-NAME 'foo) "-" (SYMBOL-NAME 'bar))
"foo-bar"
;; You can map symbol-name instead of string-upcase, though, and
;; then you'll get the desired result, "foo-bar"
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'SYMBOL-NAME '(foo bar)))
"foo-bar"
This function creates symbols from string designators:
(defun symb (&rest args)
(intern (format nil "~{~a~^-~}" (mapcar #'string args))))
The function uses format, yet passes Joshua's test:
CL-USER> (symb 'foo :bar "BAZ")
FOO-BAR-BAZ
NIL
CL-USER> (defun foo-bar ()
(print 'hello))
FOO-BAR
CL-USER> (foo-bar)
HELLO
HELLO
CL-USER> (setf *print-case* :capitalize)
:Capitalize
CL-USER> (funcall (symb 'foo 'bar))
Hello
Hello
If you want your gets to use accessor methods:
(defmacro gets (class var object)
`(,(intern (format nil "~a-~a" (symbol-name class) (symbol-name var))) ,object))
In general, what you're trying to accomplish is not really useful. make-instance is a well known symbol, easily greppable, part of the standard and optimized by some implementations when the class name is constant. So with your object macro, you're just saving a few characters and a single-quote. Usually, one hides make-instance in specific cases where you don't want to provide a direct way to initialize instances, or more likely, when you want to provide layers of initialization (e.g. phases of initialization, Lisp slots and foreign objects).
PS: I remember vaguely that someone prominent in the standardization of Common Lisp argued in favor of always wrapping/hiding make-instance in a function (e.g. make-<class-name>), but I can't find either a reference or the reasoning.
PPS: Here's a rather old discussion (2004) about it in comp.lang.lisp (and another one from 2002). The main reasons people cite in favor of constructor functions are:
Required arguments; achievable at runtime instead of at compile-time with :initform (error ...) in a slot that requires a provided initial value
Generally, hide implementation details: class instance, structure instance, cons, something else
2.1. Not wanting to export the actual class name
2.2. Being able to return an instance of some other class, usually a subclass
Convenient shorthand for a specific class
I striked always, because it seems proponents to constructor functions for CLOS objects don't necessarily want to hide the protocol that make-instance follows (allocate-instance, initialize-instance → shared-initialize) to implementers or extenders of the API or framework, although they might want to hide it to the consumers of the API or framework.
For something faster, you might want to access slots directly, but that doesn't use accessor methods, and hence doesn't support side-effects, e.g. :before and :after methods:
(defmacro gets (class var object)
(let ((object-var (gensym)))
`(let ((,object-var ,object))
(declare (optimize (speed 3) (safety 0) (debug 0))
(type ,class ,object-var))
(slot-value ,object-var ',var))))
This might be a direct slot access on some implementations.
Finally, you also have with-slots and with-accessors in the standard.
Try playing with something like this:
(let ((a 'a)
(dash '-)
(b 'b))
`(,a,dash,b))
The other possibilities is to use intern, or more user friendly, alexandria's symbolicate.
I would like to initiate dynamically a hash table with defmethod or defun using one of the arguments to create the name. For instance:
(defun foo (arg)
(let ((NAME (read-from-string (format nil "\*~S\*" arg))))
(defparameter NAME (make-hash-table))))
Of course, foo create hash table with the symbol NAME, instead of the value of NAME in let. What can I do to get the value of NAME to create this hash table?
General Remarks
It is almost always wrong to create global variables in functions.
It is also almost always wrong to create new symbols using read-from-string instead of intern.
Use a Macro
What you probably want is
(defmacro def-ht (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
`(defparameter ,var (make-hash-table))))
(def-ht foo)
Use a Function
You might be able to do it in a function too - by inspecting the macroexpansion of a defparameter form and placing the needed stuff in the function:
(defun make-ht-var (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
(setf (symbol-value var) (make-hash-table))
(proclaim (list var 'special))))
(make-ht-var 'foo)
Note that the argument to the function is quoted, but the argument to the macro is not.
You need to use a macro instead of a function. DEFPARAMETER will bind value of MAKE-HASH-TABLE to the symbol NAME because it evaluates at macro-expansion time which occurs earlier than run-time, which is when the function FOO binds the lexical value of NAME.
Look up the CL evaluation model for a deeper understanding.
(defmacro foo (arg)
(let ((name (read-from-string (format nil "*~S*" arg))))
`(defparameter ,name (make-hash-table))))
(foo "my-hash")
=> <hash-table 0x121>
*my-hash*
=> <hash-table 0x121>
I'm reading Peter Norvig's Paradigms of AI. In chapter 6.2, the author uses code like below (not the original code, I picked out the troubling part):
Code Snippet:
(progv '(op arg) '(1+ 1)
(eval '(op arg)))
As the author's original intent, this code should return 2, but in sbcl 1.1.1, the interpreter is apparently not looking up op in the environment, throwing out op: undefined function.
Is this implementation specific? Since the code must have been tested on some other lisp.
p.s Original code
You probably mean
(progv '(op arg) '(1+ 1)
(eval '(funcall op arg)))
Edit(2013-08-21):
PAIP was written in pre-ANSI-Common-Lisp era, so it's possible the code
there contains a few noncompliances wrt the standard. We can make
the examples work with the following revision:
(defun match-if (pattern input bindings)
"Test an arbitrary expression involving variables.
The pattern looks like ((?if code) . rest)."
(and (eval (reduce (lambda (code binding)
(destructuring-bind (var . val) binding
(subst val var code)))
bindings :initial-value (second (first pattern))))
(pat-match (rest pattern) input bindings)))
;; CL-USER> (pat-match '(?x ?op ?y is ?z (?if (eql (?op ?x ?y) ?z))) '(3 + 4 is 7))
;; ((?Z . 7) (?Y . 4) (?OP . +) (?X . 3) (T . T))
;; CL-USER> (pat-match '(?x ?op ?y (?if (?op ?x ?y))) '(3 > 4))
;; NIL
Elements in first positions are not looked up as values, but as functions and there is no concept of dynamic binding in the function namespace.
I'd say after a quick look that the original code was designed to evaluate in a context like
(progv '(x y) '(12 34)
(eval '(> (+ x y) 99)))
i.e. evaluating a formula providing substitution for variables, not for function names.
The other answers so far are right, in that the actual form being evaluated is not the variables being bound by progv (simply (op arg)), but none have mentioned what is being evaluated. In fact, the comments in the code you linked to provide a (very) short explanation (this is the only code in that file that uses progv):
(defun match-if (pattern input bindings)
"Test an arbitrary expression involving variables.
The pattern looks like ((?if code) . rest)."
;; *** fix, rjf 10/1/92 (used to eval binding values)
(and (progv (mapcar #'car bindings)
(mapcar #'cdr bindings)
(eval (second (first pattern))))
(pat-match (rest pattern) input bindings)))
The idea is that a call to match-if gets called like
(match-if '((?if code) . rest) input ((v1 val1) (v2 val2) ...))
and eval is called with (second (first pattern)), which the value of code. However, eval is called within the progv that binds v1, v2, &c., to the corresponding val1, val2, &c., so that if any of those variables appear free in code, then they are bound when code is evaluated.
Problem
The problem that I see here is that, by the code we can't tell if the value is to be saved as the variable's symbol-value or symbol-function. Thus when you put a + as a value to some corresponding variable, say v, then it'll always be saved as the symbol-value of var, not it's symbol-function.
Therefore when you'll try to use it as, say (v 1 2) , it won't work. Because there is no function named v in the functions' namespace(see this).
So, what to do?
A probable solution can be explicit checking for the value that is to be bound to a variable. If the value is a function, then it should be bound to the variable's function value. This checking can be done via fboundp.
So, we can make a macro functioner and a modified version of match-if. functioner checks if the value is a function, and sets it aptly. match-if does the dynamic local bindings, and allows other code in the scope of the bound variables.
(defmacro functioner (var val)
`(if (and (symbolp ',val)
(fboundp ',val))
(setf (symbol-function ',var) #',val)
(setf ,var ,val)))
(defun match-if (pattern input bindings)
(eval `(and (let ,(mapcar #'(lambda (x) (list (car x))) bindings)
(declare (special ,# (mapcar #'car bindings)))
(loop for i in ',bindings
do (eval `(functioner ,(first i) ,(rest i))))
(eval (second (first ',pattern))))
(pat-match (rest ',pattern) ',input ',bindings))))
I want to do a macro in common lisp which is supposed to take in one of its arguments a list made of slots and strings. Here is the prototype :
(defclass time-info ()
((name :initarg name)
(calls :initarg calls)
(second :initarg second)
(consing :initarg consing)
(gc-run-time :initarg gc-run-time)))
(defun print-table (output arg-list time-info-list) ())
The idea is to print a table based on the arg-list which defines its structure. Here is an example of a call to the function:
(print-table *trace-output*
'("|" name "||" calls "|" second "\")
my-time-info-list)
This print a table in ascII on the trace output. The problem, is that I don't know how to explicitely get the elements of the list to use them in the different parts of my macro.
I have no idea how to do this yet, but I'm sure it can be done. Maybe you can help me :)
I would base this on format. The idea is to build a format string
from your arg-list.
I define a helper function for that:
(defun make-format-string-and-args (arg-list)
(let ((symbols ()))
(values (apply #'concatenate 'string
(mapcar (lambda (arg)
(ctypecase arg
(string
(cl-ppcre:regex-replace-all "~" arg "~~"))
(symbol
(push arg symbols)
"~a")))
arg-list))
(nreverse symbols))))
Note that ~ must be doubled in format strings in order to escape them.
The printing macro itself then just produces a mapcar of format:
(defmacro print-table (stream arg-list time-info-list)
(let ((time-info (gensym)))
(multiple-value-bind (format-string arguments)
(make-format-string-and-args arg-list)
`(mapcar (lambda (,time-info)
(format ,stream ,format-string
,#(mapcar (lambda (arg)
(list arg time-info))
arguments)))
,time-info-list)))
You can then call it like this:
(print-table *trace-output*
("|" name "||" calls "|" second "\\")
my-time-info-list)
Please note the following errors in your code:
You need to escape \ in strings.
Second is already a function name exported from the common-lisp
package. You should not clobber that with a generic function.
You need to be more precise with your requirements. Macros and Functions are different things. Arrays and Lists are also different.
We need to iterate over the TIME-INFO-LIST. So that's the first DOLIST.
The table has a description for a line. Each item in the description is either a slot-name or a string. So we iterate over the description. That's the second DOLIST. A string is just printed. A symbol is a slot-name, where we retrieve the slot-value from the current time-info instance.
(defun print-table (stream line-format-description time-info-list)
(dolist (time-info time-info-list)
(terpri stream)
(dolist (slot-or-string line-format-description)
(princ (etypecase slot-or-string
(string slot-or-string)
(symbol (slot-value time-info slot-or-string)))
stream))))
Test:
> (print-table *standard-output*
'("|" name "||" calls "|" second "\\")
(list (make-instance 'time-info
:name "foo"
:calls 100
:second 10)
(make-instance 'time-info
:name "bar"
:calls 20
:second 20)))
|foo||100|10\
|bar||20|20\
First, you probably don't want the quote there, if you're using a macro (you do want it there if you're using a function, however). Second, do you want any padding between your separators and your values? Third, you're probably better off with a function, rather than a macro.
You also seem to be using "array" and "list" interchangeably. They're quite different things in Common Lisp. There are operations that work on generic sequences, but typically you would use one way of iterating over a list and another to iterate over an array.