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.
Related
I have a struct with :name and :value that I'd like to use as arguments to a macro. But I'm not sure how to tell lisp that.
I can write out the call like
(sxql:yield (sxql:set= :name "a" :value 1))
"SET name = ?, value = ?"
("a" 1)
But I'd like to use an already existing structure
(defstruct my-struct name value)
(setq x (make-my-struct :name "a" :value 1))
; #S(MY-STRUCT :NAME "a" :VALUE 1)
using answers from Common LISP: convert (unknown) struct object to plist?
I've made
(defun struct-plist (x)
"make struct X into a property list. ugly kludge"
(let* ((slots (sb-mop:class-slots (class-of x)))
(names (mapcar 'sb-mop:slot-definition-name slots)))
(alexandria:flatten
(mapcar (lambda (n) (list (intern (string n) "KEYWORD")
(slot-value x n)))
names))))
(setq p (struct-plist x)) ; (:NAME "a" :VALUE 1)
My naive attempts are
(sxql:set= p) ; error in FORMAT: No more argument SET ~{~A = ~A~^, ~}
(funcall 'sxql:set= p) ; SXQL:SET= is a macro, not a function.
(macroexpand (sxql:set= p)) ; error in FORMAT ...
I imagine this is an easy/fundamental lisp programming question. But I'm not sure how to ask it (or search for answers). I'm also hoping there is an better struct<->plist story than what I've stumbled across so far.
EDIT: In case this is really an xy-problem. I've used flydata:defmodel to create the struct and I want to insert to a database using the same model.
This is definitely an xy problem: unfortunately I don't understand y (flydata?) well enough to answer the y part.
Here's why what you are trying to do can't work however. Consider this code in a file being compiled:
(defstruct mine name value)
...
(sxql:set= <anything derived from mine>)
Compiling this file must satisfy two constraints:
It does not fully create the structure type mine (see defstruct);
It must macroexpand sxql:set=.
What these constraints mean is that sxql:set= can't know about the structure at the time it is expanded. So any trick which relies on information about the structure must make that information available at compile time.
As I said, I don't understand the y part well enough to understand what you are trying to do, but a hacky approach to this is:
write a wrapper for defstruct which stashes information at compile time (strictly: at macro-expansion time);
write a wrapper for sxql:set= which uses that information to expand into something which makes sense.
Here is a mindless wrapper for defstruct. Note that this is mindless: it can only understand the most simple defstruct forms, and even then it may be wrong. It exists only as an example.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *structure-information* '()))
(defmacro define-mindless-structure (name &body slots)
(assert (and (symbolp name)
(every #'symbolp slots))
(name slots)
"I am too mindless")
(let ((found (or (assoc name *structure-information*)
(car (push (list name) *structure-information*)))))
(setf (cdr found) (mapcar (lambda (slot)
(list slot (intern (symbol-name slot)
(find-package "KEYWORD"))
(intern (concatenate 'string
(symbol-name name)
"-"
(symbol-name slot)))))
slots)))
`(defstruct ,name ,#slots))
So now
(define-mindless-structure mine
name value)
Will expand into (defstruct mine name value) and, at macroexpansion time will stash some information about this structure in *structure-information*.
Now I stop really understanding what you need to do because I don't know what sxql:set= is meant to do, but it might be something like this:
(defmacro mindless-set= ((s o))
(let ((info (assoc s *structure-information*))
(ov (make-symbol "O")))
(unless info
(error "no information for ~A" s))
`(let ((,ov ,o))
(sxql:set= ,#(loop for (slot initarg accessor) in (cdr info)
;; the compiler will whine about slot annoyingly
collect initarg
collect `(,accessor ,ov))))))
So with this macro, assuming a suitable define-mindless-structure for mine form has been seen by the time the macro is expanded, then
(mindless-set= (mine it))
Will expand into
(let ((#:o it))
(set= :name (mine-name #:o) :value (mine-value #:o)))
But, as I said, I am not sure what the expansion you actually want is.
Finally, before even thinking about using anything like the above, it would be worth looking around to see if there are portability libraries which provide compile/macroexpansion-time functionality like this: there very well may be such, as I don't keep up with things.
I am using the defclass macro from Practical Common Lisp, which takes as argument a list of symbols.
I would like to change the macro in order to let it accept a quoted list of symbols. This has the benefit of having thenm defined as constants that can be used in other convenience functions, e.g. here. I confused myself in trying to get this done.
My use case is following:
(defconstant state-slots '(unit motion mode moc-offset woc-pos woc-inc feed spindle))
;; would like to use the quoted list here:
(defclass-by-slots gc-state (unit ; :mm(=G21) :inch(=G20)
motor ; nil :on
motion ; :jog(=G0) :lin(=G1) :cw(=G2) :ccw(=G3)
mode ; :abs(=G90) :inc(=G91)
moc-offset ; woc-zero(xyz, mm) from moc-zero
woc-pos ; woc-pos(xyz, mm) from woc-zero
woc-inc
feed
spindle))
;; can use quoted slot list when using a convenience function, e.g:
(defun format-by-slots (o slots &optional str-type)
(let* ((f (lambda (s$) (eval (format-slot o s$))))
(str-type (string-upcase str-type))
(r (concatenate
'string
(format nil "~A (~A)" o (class-of o))
(reduce (lambda (s1 s2) (concatenate 'string s1 s2))
(loop for s in slots
when (funcall f s) collect it)
:from-end t :initial-value (format nil "~%")))))
(if str-type
(ppcre:regex-replace-all
(format nil "^#<~A \\{(\\d|[A-F])+\\}> " str-type)
r
(format nil "#<~A {...}> " str-type))
r)))
I am using this for several classes defined by different slots.
The nuisance is that I cannot have defined the slots uniformly for the type definition and the convenience functions which is source of annoying errors.
Solution based on [Rainer Joswig's answer] (https://stackoverflow.com/a/61154538/2336738):
(defmacro def-my-class (name supers slots-symbol)
"The value of a symbol of slots-symbol is used as the
list of slots."
`(defclass ,name ,supers
,(if (and (symbolp slots-symbol)
(symbol-value slots-symbol)
(listp (symbol-value slots-symbol)))
(mapcar #'slot->defclass-slot (symbol-value slots-symbol))
(error "~a is not a symbol which names a list of slot names" slots-symbol))))
Symbol values at compile time
If you want to use the value of a symbol at compile time, then you need to make sure that it is defined. Two usual ways to do that:
define the symbol in a file and load it before compiling another file where it is used
use EVAL-WHEN to execute a symbol definition (defvar, defparameter,defconstant` ...) at compile time
Read-time evaluation
One possibility to use a symbol value during compilation is to use read-time evaluation. You would need to make sure that the constant value of +state-slots+ is defined during compilation:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +state-slots+
'(unit motion mode moc-offset woc-pos woc-inc feed spindle)))
(defclass foo ()
#.+state-slots+)
Custom Macro
If the value of +state-slots+ is defined at compile time, then we can also use it in a macro:
(defmacro def-my-class (name supers slots-symbol)
"The value of a symbol of slots-symbol is used as the
list of slots."
`(defclass ,name ,supers
,(if (and (symbolp slots-symbol)
(symbol-value slots-symbol)
(listp (symbol-value slots-symbol)))
(symbol-value slots-symbol)
(error "~a is not a symbol which names a list of slot names"))))
(def-my-class foo () +state-slots+)
When working in a top level REPL, I sometimes forget what definitions I've entered into the running lisp system.
I use Clozure CL and it provides the option of saving the application as an image, which I do and can continue where I left off, but at this point it becomes impossible to review all the code, unless I had separately typed and saved the code to xyz file already.
Is there a way to get/extract/view the definitions that I entered, so I can save them as a source file?
The following will extract all the function definitions entered in a package:
(defun get-all-symbols (&optional package)
(let ((lst nil)
(package (find-package package)) )
(do-all-symbols (s lst)
(when (fboundp s)
(unless (and package (not (eql (symbol-package s) package)))
(push (cons s (function-lambda-expression s)) lst) )))))
Try something like:
(get-all-symbols *package*)
Common Lisp (in general) does not provide any standard way to “recover” the source code of a definition once it has been compiled. Normally, it's found in whatever file or buffer you're working-from.
(As Leo's answer points out, there is Function-Lambda-Expression, which can give you some function definitions. It won't help with, say, constants or classes, and it won't always work — as CLHS says, “Any implementation may legitimately return nil as the lambda-expression of any function.” http://clhs.lisp.se/Body/f_fn_lam.htm — his solution is certainly useful in the most common case(s), but it is not “as general” as this one.)
You could use a set of “wrapper” macros which store the forms you pass to them in a global hash-table, and then recover the source from that. Writing that sounded like an interesting little challenge, so the below is my attempt to do something like that.
My Silly Wrappers Solution
Note that the “source” forms stashed in this way won't preserve reader macros, comments, or the like, and will probably choke on some things like defmethod in subtly horrible ways. That's because I blindly store the definitions keyed off the defining form — eg, defun — and the second word, only. It's not smart enough to notice if you rebound a function as a macro or generic function (all three conflicting definitions would be saved), it doesn't read method combinations or lambda lists to save various methods, or any of that. There are lots of other things you might do — eg, (SetF (FDefinition 'FOO) …) — that could bypass these and go unnoticed, so it's far from “foolproof.” Caveat Lector.
The macros here try to inherit the documentation and lambda lists from the underlying forms, so they should work pretty nicely with most IDE's. They do well enough, in Slime.
One way to work with these would be to directly call them; eg, in your REPL you could directly
My-Package> (use-package :wrap-defining-form)
My-Package> (defun$ my-fn (x) (+ x (sqrt x)))
A more dangerous/interesting way is provided in the package Wrap-Defining-Form.Shadowing, in which the macros shadow the real Common-Lisp package definitions …
CL-User> (in-package :CL-USER$)
CL-User$> (defun blah (n) (loop repeat n do (format t "~&Blah …")))
When you're ready to “save” things, run (dump-definitions).
I wrote and tested this in SBCL, but tried to take care that it should work on many/most other implementations. In particular, I used one non-ANSI function: SB-Introspect:Function-Lambda-List. The function here Wrap-Defining-Form::Find-Function-Lambda-List will search all packages for your implementation's version of that function. If it can't find one, all is not lost; but you won't get hints from your IDE about the lambda-list of the wrapped function. (Clozure's seems to work — kinda — for functions, but not macros. That can probably be improved.)
CL-USER> (describe 'defun$)
WRAP-DEFINING-FORM:DEFUN$
[symbol]
DEFUN$ names a macro:
Lambda-list: (NAME LAMBDA-LIST &BODY BODY)
Documentation:
Wrap `DEFUN' and save the original form.
DEFUN: Define a function at top level.
Source file: /home/brpocock/Private/wrap-defining-form.lisp
; No value
Without Function-Lambda-List, the wrapper looks like
Lambda-list: (&REST UNKNOWN-LAMBDA-LIST)
… which is not very helpful.
wrap-defining-form.lisp
EDIT: Debugged in Clozure. Posted to https://github.com/brpocock/wrap-defining-forms also.
;;;; Wrap--Defining-Forms
;;; -*- Lisp -*-
(defpackage wrap-defining-forms
(:use :common-lisp)
(:documentation "Wrap defining forms so that they (try to) save the
source code of the definition being passed.")
(:export #:wrap-defining-form #:dump-definitions
#:defclass$
#:defconstant$
#:defgeneric$
#:define-compiler-macro$
#:define-condition$
#:define-method-combination$
#:define-modify-macro$
#:define-setf-expander$
#:define-symbol-macro$
#:defmacro$
#:defmethod$
#:defpackage$
#:defparameter$
#:defsetf$
#:defstruct$
#:deftype$
#:defun$
#:defvar$))
(defpackage wrap-defining-forms.shadowing
(:documentation "Wrapped forms like DEFUN$ are exported here with the
names of the forms that they wrap, like DEFUN, for
shadowing imports.")
(:export #:defclass
#:defconstant
#:defgeneric
#:define-compiler-macro
#:define-condition
#:define-method-combination
#:define-modify-macro
#:define-setf-expander
#:define-symbol-macro
#:defmacro
#:defmethod
#:defpackage
#:defparameter
#:defsetf
#:defstruct
#:deftype
#:defun
#:defvar)
(:use))
;; Clozure appears to be “smart” and adds Common-Lisp even though we
;; didn't ask for it (and explicily don't want it)
#+ccl (unuse-package '(:ccl :common-lisp)
:wrap-defining-forms.shadowing)
(defpackage :common-lisp-user/save-defs
(:nicknames :cl-user$)
(:use :common-lisp :common-lisp-user)
(:import-from :wrap-defining-forms #:dump-definitions)
(:shadowing-import-from :wrap-defining-forms.shadowing
#:defclass
#:defconstant
#:defgeneric
#:define-compiler-macro
#:define-condition
#:define-method-combination
#:define-modify-macro
#:define-setf-expander
#:define-symbol-macro
#:defmacro
#:defmethod
#:defpackage
#:defparameter
#:defsetf
#:defstruct
#:deftype
#:defun
#:defvar))
;; Clone any other functions you may have packed into CL-User.
(with-package-iterator (next-symbol :common-lisp-user :internal)
(loop for symbol = (next-symbol)
while symbol
for sibling = (intern (symbol-name symbol) (find-package :cl-user$))
when (and (fboundp symbol)
(not (fboundp sibling)))
do (setf (fdefinition sibling) (fdefinition symbol))))
(in-package "WRAP-DEFINING-FORMS")
(defvar *definitions* (make-hash-table)
"Copies of forms defined by the wrappers created by
`WRAP-DEFINING-FORM' which can be stashed with `DUMP-DEFINITIONS'")
#+ccl
(defun ccl-mock-lambda-list (function)
(if (macro-function function)
(list '&rest 'macro-lambda-list)
(multiple-value-bind (required optional restp
keywords)
(ccl:function-args (fdefinition function))
(concatenate ' list
(loop repeat required
collect (gensym "ARG-"))
(when (and optional (plusp optional))
(cons '&optional
(loop repeat optional
collect (gensym "OPT-"))))
(when restp
(list '&rest 'rest))
(when (and keywords (plusp keywords))
(list '&key '&allow-other-keys))))))
(defun find-function-lambda-list ()
"Find the implementation's version of `FUNCTION-LAMBDA-LIST' if there
is one. That way, Slime and friends can still give the proper
lambda-list for the wrapped form. If it can't be found, this will
return a stub with just a &rest-var."
(or
#+sbcl #'sb-introspect:function-lambda-list
#+ccl #'ccl-mock-lambda-list
#-(or ccl sbcl)
(dolist (package (list-all-packages))
(let ((sym (find-symbol "FUNCTION-LAMBDA-LIST" package)))
(when (fboundp sym)
(return-from find-function-lambda-list sym))))
(lambda (function)
(declare (ignore function))
(list '&rest 'unknown-lambda-list))))
(defmacro wrap-defining-form (cl-form)
"Assuming that CL-FORM is a symbol for a macro or function which
defines something interesting (eg, “Defun”), this will create a macro
with the same name with a trailing “$” that will save the source tree
before passing on the form to CL-FORM.
EG: (wrap-defining-form defun) provides a “defun$” which has the
additional side effect of storing the source form in *DEFINITIONS*.
Definitions saved can be recovered by `DUMP-DEFINITIONS'.
This is not industrial-strength; in particular, I expect it to cope
poorly with DEFMETHOD."
(check-type cl-form symbol)
(let ((wrapper (intern (concatenate 'string (symbol-name cl-form) "$")))
(wrapper.shadow (intern (symbol-name cl-form) :wrap-defining-forms.shadowing))
(wrapped-lambda-list (funcall (find-function-lambda-list) 'defun)))
(setf (gethash cl-form *definitions*) (make-hash-table))
`(prog1
(defmacro ,wrapper (&whole whole ,#wrapped-lambda-list)
(declare (ignore ,#(remove-if (lambda (form) (member form lambda-list-keywords))
wrapped-lambda-list)))
,(concatenate 'string "Wrap `" (symbol-name cl-form) "' and save the original form." #(#\newline #\newline)
(symbol-name cl-form) ": " (or (documentation cl-form 'function)
"(see CLHS; no documentation here)"))
(let ((defined (cons ',cl-form (cdr whole))))
(setf (gethash (second whole) (gethash ',cl-form *definitions*))
defined)
defined))
(defmacro ,wrapper.shadow (&whole whole ,#wrapped-lambda-list)
(declare (ignore ,#(remove-if (lambda (form) (member form lambda-list-keywords))
wrapped-lambda-list)))
,(concatenate 'string "Wrap `COMMON-LISP:" (symbol-name cl-form) "' and save the original form."
#(#\newline #\newline)
(symbol-name cl-form) ": " (or (documentation cl-form 'function)
"(see CLHS; no documentation here)"))
(let ((defined (cons ',cl-form (cdr whole))))
(setf (gethash (second whole) (gethash ',cl-form *definitions*))
defined)
defined)))))
(wrap-defining-form defclass)
(wrap-defining-form defconstant)
(wrap-defining-form defgeneric)
(wrap-defining-form define-compiler-macro)
(wrap-defining-form define-condition)
(wrap-defining-form define-method-combination)
(wrap-defining-form define-modify-macro)
(wrap-defining-form define-setf-expander)
(wrap-defining-form define-symbol-macro)
(wrap-defining-form defmacro)
(wrap-defining-form defmethod)
(wrap-defining-form defpackage)
(wrap-defining-form defparameter)
(wrap-defining-form defsetf)
(wrap-defining-form defstruct)
(wrap-defining-form deftype)
(wrap-defining-form defun)
(wrap-defining-form defvar)
(defun dump-definitions (&optional pathname)
"Write out the definitions saved by `WRAP-DEFINING-FORM'-built
wrappers to PATHNAME (or *STANDARD-OUTPUT*)."
(let (output
(*print-case* :capitalize)
;; If writing to file, set margin at 79, but try to keep things under 72.
(*print-right-margin* (if pathname 79 *print-right-margin*))
(*print-miser-width* (if pathname 72 *print-miser-width*)))
(unwind-protect
(progn (setq output (if pathname
(open pathname :direction :output
:if-exists :rename
:if-does-not-exist :create)
*standard-output*))
(multiple-value-bind (sec min hr d m y) (decode-universal-time (get-universal-time))
(declare (ignore sec))
(format output
"~&~|~%;;; definitions as of ~d-~d-~d # ~d:~2,'0d:
\(In-Package #:~a)
~{~{~2%~:<~W ~#_~:I~W ~:_~W~1I ~_~W~:>~}~^~|~}~%~|~%" ; from CLHS 22.2.2 SIMPLE-PPRINT-DEFUN
y m d hr min
(package-name *package*)
(remove-if #'null
(loop for form being the hash-keys of *definitions*
for defs = (gethash form *definitions*)
collect (loop for definition being the hash-values of defs
collect definition))))))
(when output (ignore-errors (close output))))))
Sample Usage
CL-USER> (load "wrap-defining-form.lisp")
T
CL-USER> (use-package :wrap-defining-form)
T
CL-USER> (defun$ trash-word (word)
(let ((s (string word)))
(sort (remove-if-not #'alpha-char-p s) #'char<)))
WARNING: redefining COMMON-LISP-USER::TRASH-WORD in DEFUN
TRASH-WORD
CL-USER> (trash-word 'Blatherscythe)
"ABCEEHHLRSTTY"
CL-USER> (describe 'trash-word)
COMMON-LISP-USER::TRASH-WORD
[symbol]
TRASH-WORD names a compiled function:
Lambda-list: (WORD)
Derived type: (FUNCTION (T) (VALUES SEQUENCE &OPTIONAL))
Source form:
(SB-INT:NAMED-LAMBDA TRASH-WORD
(WORD)
(BLOCK TRASH-WORD
(LET ((S (STRING WORD)))
(SORT (REMOVE-IF-NOT #'ALPHA-CHAR-P S) #'CHAR<))))
; No value
CL-USER> (macroexpand-1 '(defun$ trash-word (word)
(let ((s (string word)))
(sort (remove-if-not #'alpha-char-p s) #'char<))))
(DEFUN TRASH-WORD (WORD)
(LET ((S (STRING WORD)))
(SORT (REMOVE-IF-NOT #'ALPHA-CHAR-P S) #'CHAR<)))
T
CL-USER> (dump-definitions)
;;; definitions as of 2016-12-1 # 15:23:
(In-Package #:COMMON-LISP-USER)
(Defun Trash-Word (Word)
(Let ((S (String Word)))
(Sort (Remove-If-Not #'Alpha-Char-P S) #'Char<)))
NIL
CL-USER> (in-package :Common-Lisp-User/Save-Defs)
#<PACKAGE "COMMON-LISP-USER/SAVE-DEFS">
CL-USER$> (defun 2+ (n) (+ 2 n))
2+
CL-USER$> (describe '2+)
COMMON-LISP-USER/SAVE-DEFS::2+
[symbol]
2+ names a compiled function:
Lambda-list: (N)
Derived type: (FUNCTION (T) (VALUES NUMBER &OPTIONAL))
Source form:
(SB-INT:NAMED-LAMBDA 2+
(N)
(BLOCK 2+ (+ 2 N)))
; No value
CL-USER$> (macroexpand-1 '(defun 2+ (n) (+ 2 n)))
(COMMON-LISP:DEFUN 2+ (N) (+ 2 N))
T
CL-USER$> (documentation 'defun 'function)
"Wrap `COMMON-LISP:DEFUN' and save the original form.
DEFUN: Define a function at top level."
CL-USER$> (dump-definitions)
;;; definitions as of 2016-12-1 # 15:32:
(In-Package #:COMMON-LISP-USER/SAVE-DEFS)
(Common-Lisp:Defun 2+ (N) (+ 2 N))
(Common-Lisp:Defun Trash-Word (Word)
(Let ((S (String Word)))
(Sort (Remove-If-Not #'Alpha-Char-P S) #'Char<)))
NIL
File Backup
Dump-Definitions also will write to a file. (It sets :If-Exists :Rename, so you could have one-level-UNDO protection as well.)
CL-USER$> (dump-definitions "saved.lisp")
NIL
Here is an interactive session with CCL:
? (declaim (optimize (debug 3)))
NIL
The above is not strictly required here, but it doesn't hurt to develop with high debugging levels.
? (defun foo (x) (+ 3 x))
FOO
? (inspect 'foo)
[0] FOO
[1] Type: SYMBOL
[2] Class: #<BUILT-IN-CLASS SYMBOL>
Function
[3] INTERNAL in package: #<Package "COMMON-LISP-USER">
[4] Print name: "FOO"
[5] Value: #<Unbound>
[6] Function: #<Compiled-function FOO #x3020004B3F7F>
[7] Arglist: (X)
[8] Plist: NIL
Inspect> 6
[0] #<Compiled-function FOO #x3020004B3F7F>
[1] Name: FOO
[2] Arglist (analysis): (X)
[3] Bits: 8388864
[4] Plist: (CCL::PC-SOURCE-MAP #(17 70 15 22) CCL::FUNCTION-SYMBOL-MAP
(#(X) . #(63 17 70)) CCL::%FUNCTION-SOURCE-NOTE ...)
[5] Source Location: #<SOURCE-NOTE Interactive "(defun foo (x) (+ 3 x))">
Inspect 1> 5
[0] #<SOURCE-NOTE Interactive "(defun foo (x) (+ 3 x))">
[1] Type: SOURCE-NOTE
[2] Class: #<STRUCTURE-CLASS SOURCE-NOTE>
[3] SOURCE: #(40 100 101 102 117 ...)
[4] FILENAME: NIL
[5] FILE-RANGE: 23
You can see that even from within the REPL, and without running Slime which might also store information about the Emacs environment, you can have access to the source code of FOO. This can be used if you know which function you want to recover. For a recording of your interactive session, follow jkiiski's advice about DRIBBLE.
Perhaps you can easily implement something like this yourself:
(defun my-repl (&optional (file-path "cl-history.lisp"))
"Saves commands to a file"
(loop
(with-open-file (stream file-path
:direction :output
:if-does-not-exist :create
:if-exists :append)
(print '>)
(let ((input (read)))
(format stream "~A~%" input)
(print (eval input))))))
To exit the inner loop you should type (quit).
Alternatively you can use com.informatimago.common-lisp.interactive.interactive:repl
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'm attempting to write my first anaphoric macro and am running into a problem. I am using sblc and slime.
When the anaphoric macro is expanded in another package its symbols are prefixed with the package it was defined in (i.e. they become tjb-utilities::value instead of just value. What is going on?
PE> (macroexpand-1 '(act-if-key :pcram (get-node) (print value)))
(IF (HAS-KEY? :PCRAM (GET-NODE))
(LET ((TJB-UTILITIES::KEY :PCRAM)
(TJB-UTILITIES::VALUE (GETHASH :PCRAM (GET-NODE))))
(PRINT VALUE)))
This is the macro definition:
(defmacro act-if-key (key hashtable &body body)
`(if (has-key? ,key ,hashtable)
(let ((key ,key) (value (gethash ,key ,hashtable)))
,#body)))
It does work correclty if I prefix the value:
(act-if-key :pcram (get-node) (print tjb-utilities::value))
; in: ACT-IF-KEY :PCRAM
; (LET ((TJB-UTILITIES::KEY :PCRAM)
; (TJB-UTILITIES::VALUE
; (GETHASH :PCRAM (PHILOSOPHY-EXPERIENCE::GET-NODE))))
; (PRINT TJB-UTILITIES::VALUE))
;
; caught STYLE-WARNING:
; The variable TJB-UTILITIES::KEY is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
"hello"
"hello"
The packages are defined as follows:
(defpackage #:tjb-utilities
(:nicknames :tjb)
(:use #:cl)
(:export "HAS-KEY?" "KEY-VALUE-PAIRS" "ACT-IF-KEY" "TJB-MAKE-HASH-TABLE"))
(defpackage #:my-package
(:nicknames :pe)
(:use #:cl #:clsql #:tjb-utilities))
Update: Changing the key in the lambda list to key_in has no effect
(defmacro act-if-key (key_in hashtable &body body)
`(if (has-key? ,key_in ,hashtable)
(let ((key ,key_in) (value (gethash ,key_in,hashtable)))
,#body)))
You could just export 'key and 'value symbols. That's how Anaphora does it:
(defpackage :anaphora
7 (:use :cl)
8 (:export
9 #:it
10 #:alet
11 #:slet
12 #:aif
13 #:aand
14 #:sor
15 #:awhen
16 #:aprog1
17 #:acase
18 #:aecase
...etc.
Note the 'it export.
The point of an anaphoric macro is to intentionally capture certain symbols in the body of the macro that have not been explicitly defined by the caller of the macro (I understand that this is an extreme stance on the definition). So, it is a requirement for anyone using an anaphoric macro to know what symbols are being introduced into the environment (body) of that macro. Which means that they should not be surprised when those symbol names are added to the environment. So I see no problem with exporting the anaphora.
CL-USER> (in-package #:tjb)
#<PACKAGE "TJB-UTILITIES">
TJB> (defmacro act-if-key (key hashtable &body body)
(let ((value (intern "VALUE")))
`(if (has-key? ,key ,hashtable)
(let ((key ,key) (,value (gethash ,key ,hashtable)))
,#body))))
ACT-IF-KEY
TJB> (macroexpand-1 '(tjb:act-if-key :pcram (get-node) (print value)))
(IF (HAS-KEY? :PCRAM (GET-NODE))
(LET ((KEY :PCRAM) (VALUE (GETHASH :PCRAM (GET-NODE))))
(PRINT VALUE)))
T
TJB> (in-package #:cl-user)
#<PACKAGE "COMMON-LISP-USER">
CL-USER> (macroexpand-1 '(tjb:act-if-key :pcram (get-node) (print value)))
(IF (TJB-UTILITIES::HAS-KEY? :PCRAM (GET-NODE))
(LET ((TJB-UTILITIES::KEY :PCRAM) (VALUE (GETHASH :PCRAM (GET-NODE))))
(PRINT VALUE)))
T
CL-USER>
Not sure if I copied all that you needed, and I'm a tad blur on how did you intend to use the "key", so I did it only for the value in the way it will be created in the package, where the macro is used. You'd figure it for yourself whether you need the same for the key or not.
The above bind the symbol value in the current package to whatever gethash will return. In your original version you have key supplied by the user of the macro, so I decided you didn't want a symbol key inside the macro, just it's value.
But wait a bit, perhaps there will be a better answer, maybe you can just make-symbol it instead of interning and then bind it somehow. I'm not sure.