I would like to set aliases in common lisp(clisp to be exact) for commands that are used a lot, such as "defun" and "lambda" etc, is it possible to do this?
This is actually kind of a duplicate of this question, but I can not comment and the solution does not work for defun or lambda in both sbcl and clisp
Macros:
CL-USER 5 > (setf (macro-function 'dm) (macro-function 'defmethod))
#<Function DEFMETHOD 410009A014>
CL-USER 6 > (dm m1+ ((v vector)) (map 'vector #'1+ v))
#<STANDARD-METHOD M1+ NIL (VECTOR) 4130003913>
CL-USER 7 > (m1+ #(1 2 3 4))
#(2 3 4 5)
The whole point by macros is to provide a source rewriting service.. Thus I want to give you this and you can make that out of it:
(defmacro df (name (&rest arguments) &body body)
`(defun ,name ,arguments ,#body))
(df test (x) (+ x x))
(test 5) ; ==> 10
We have just shortened the name.. Lets make another one:
(defmacro df1 (name &body body)
`(defun ,name (_) ,#body))
(df1 test (+ _ _))
(test 5) ; ==> 10
And so on...
Related
I've got a data structure that consists of two parts:
A hash table mapping symbols to indices
A vector of vectors containing data
For example:
(defparameter *h* (make-hash-table))
(setf (gethash 'a *h*) 0)
(setf (gethash 'b *h*) 1)
(setf (gethash 'c *h*) 2)
(defparameter *v-of-v* #(#(1 2 3 4) ;vector a
#(5 6 7 8) ;vector b
#(9 10 11 12))) ;vector c
I'd like to define a symbol macro to get at vector a without going through the hashmap. At the REPL:
(define-symbol-macro a (aref *v-of-v* 0))
works fine:
* a
#(1 2 3 4)
but there could be potentially many named vectors, and I don't know what the mappings will be ahead of time, so I need to automate this process:
(defun do-all-names ()
(maphash #'(lambda (key index)
(define-symbol-macro key (aref *v-of-v* index)))
*h*))
But that does nothing. And neither does any of the combinations I have tried of making do-all-names a macro, back-quote/comma templates, etc. I am beginning to wonder if this doesn't have something to do with the define-symbol-macro itself. It seems a little used feature, and On Lisp only mentions it twice. Not too many mentions here nor elsewhere either. In this case I'm using SBCL 2.1
Anyone have any ideas?
You need something like above to do it at runtime:
(defun do-all-names ()
(maphash #'(lambda (key index)
(eval `(define-symbol-macro ,key (aref *v-of-v* ,index)))
*h*))
DEFINE-SYMBOL-MACRO is a macro and does not evaluate all its arguments. So you need to generate a new macro form for each argument pair and evaluate it.
The other way to do it, usually at compile time, is to write a macro which generates these forms on the toplevel:
(progn
(define-symbol-macro a (aref *v-of-v* 0))
(define-symbol-macro b (aref *v-of-v* 1))
; ....
)
I'm not too sure on what you mean by "I don't know what the mappings will be ahead of time".
You could do something like:
(macrolet ((define-accessors ()
`(progn
,#(loop for key being the hash-keys of *h*
collect
`(define-symbol-macro ,key (aref *v-of-v* ,(gethash key *h*)))))))
(define-accessors))
If you know you do not require global access, then, you could do:
(defmacro with-named-vector-accessors (&body body) ; is that the name you want?
`(symbol-macrolet (,#(loop for key being the hash-keys of *h*
collect `(,key (aref *v-of-v* ,(gethash key *h*)))))
,#body))
;;; Example Usage:
(with-named-vector-accessors
(list a b c)) ;=> (#(1 2 3 4) #(5 6 7 8) #(9 10 11 12))
Also,
If you know *h* and the indices each symbol maps to at macroexpansion time, the above works.
If you know *h* at macroexpansion but the indices each symbol maps to will change after macroexpansion, you will want to collect (,key (aref *v-of-v* (gethash ,key *h*))).
PS: If you find loop ugly for hash-tables, you could use the iterate library with the syntax:
(iter (for (key value) in-hashtable *h*)
(collect `(,key (aref *v-of-v* ,value))))
I'm trying to write a macro that defines some helpers for struct-of-arrays data structure (based on this snippet). Inside that macro I define another macro that helps with traversing all of the slot values in struct. The thing is I can't make double unquoting work properly. Here's the code:
(defmacro defcomponent (name-and-options &body slots)
(setf name-and-options (ensure-list name-and-options))
(let ((struct (first name-and-options))
(slot-names (iter (for s in slots)
(collecting
(ematch s
((or (and name (symbol)
(<> _ '*)
(<> _ nil))
(list* name _ (plist :type _ :read-only _)))
name))))))
`(progn (defstruct ,name-and-options
;; some task-specific stuff omitted here
)
(defmacro ,(symbolicate 'with- struct) (components &rest body)
`(loop
,#',(iter (for s in slot-names)
(appending `(for ,s across (,(symbolicate struct '- s) components))))
do ,#body)))))
So for instance (defcomponent buzz x y) macroexpands to
(PROGN
(DEFSTRUCT (BUZZ)
X Y) ;; details omitted
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP ,#'(FOR X ACROSS (BUZZ-X COMPONENTS) FOR Y ACROSS (BUZZ-Y COMPONENTS))
DO ,#BODY))
which kinda works, but I want to access components parameter of the internal with-buzz macro, i.e. something like this
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP FOR X ACROSS (BUZZ-X ,COMPONENTS) FOR Y ACROSS (BUZZ-Y ,COMPONENTS)
DO ,#BODY))
How do I possibly acheive that? I've tried a lot of the combinations of , and ,# to no avail.
Sometimes it helps not to work with backquote patterns. Then scope problems can be easier understood with the help of a compiler, which would warn about the usual variable scope problems.
As a slightly simplified exercise, we will write a function, which generates code. The generated code is a macro definition, which itself generates code.
(defun makeit (name slots)
(labels ((symbolicate (pattern &rest things)
(intern (apply #'format nil pattern things)))
(compute-for-clauses (slots)
(loop for s in slots
append (list ''for (list 'quote s)
''across (list 'list
(list 'quote
(symbolicate "~a-~a" name s))
'components)))))
(list 'progn
(list 'defmacro
(symbolicate "WITH-~a" name)
'(components &rest body)
(append '(list* 'loop)
(compute-for-clauses slots)
(list ''do 'body))))))
Example
CL-USER 51 > (pprint (makeit 'buzz '(x y)))
(PROGN
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
(LIST* 'LOOP
'FOR
'X
'ACROSS
(LIST 'BUZZ-X COMPONENTS)
'FOR
'Y
'ACROSS
(LIST 'BUZZ-Y COMPONENTS)
'DO
BODY)))
CL-USER 52 > (eval *)
NIL
CL-USER 53 > (macroexpand-1 '(with-buzz a (+ 12) (+ 30)))
(LOOP FOR X ACROSS (BUZZ-X A) FOR Y ACROSS (BUZZ-Y A) DO (+ 12) (+ 30))
T
All right, I've managed to do it by resorting to manual list construction + eval instead of quasiquoting, but sweet mother of god it looks so hakish.
;; skip
(defmacro ,(symbolicate 'with- struct) (components &rest body)
(append
'(loop)
(eval
`(iter (for s in ',',slot-names)
(appending `(for ,s across (,(symbolicate ',',struct '- ,'s) ,,components)))))
'(do)
body))
I'll gladly accept any other answer solving the problem more idiomatically.
I'm trying to write functions that wrap another function but I'm not sure how to pass parameters correctly while maintaining a sensible lambda-list.
E.g. if I have a function
(defun f (x &key y z) ...)
I want to write something like
(defun g (x &key y z)
(h (f x :y y :z z)))
This isn't satisfactory because I want to call f from g with the exact arguments g was called with, which doesn't happen (e.g. I don't want to supply keyword arguments to f that weren't supplied to g by the caller).
I initially wrote something like:
(defun g (&rest f-args)
(apply #'f f-args))
And that's the effect I want, however the lambda list for g is now very cryptic and I keep having to navigate to f to see what the arguments should be.
I did come up with a solution (and it's mostly satisfactory so I posted it as an answer), but I need to be explicit with every single key argument, and with large lambda-lists (e.g. if I want to wrap drakma:http-request), it will be a pain. I hope that maybe there's a better way.
You could write a macro that defines a function by copying the lambda list from another function. The problem is that there isn't a standard way to get the lambda list, but for SBCL you can use SB-INTROSPECT:FUNCTION-LAMBDA-LIST (although that won't work with (declaim (optimize (debug 0)))). You could try reading Swank source code to see how it gets the lambda lists for various implementations.
(defmacro define-wrapper (name lambda-source &body body)
`(defun ,name ,(sb-introspect:function-lambda-list lambda-source)
,#body))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 (f x :y y :z z)))
(f 2) ;=> 9
(g 2) ;=> 18
That's a bit ugly since the code doesn't show the variable definitions. A bit more complex solution might be to do something like
;; Requires Alexandria.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
`(defun ,name ,lambda-list
,#(sublis `((_ . (,lambda-source ,#(loop for r in required collect r)
,#(loop for (name init suppliedp)
in optional collect name)
,#(loop for ((k-name name) init suppliedp)
in keywords
append (list k-name name)))))
body)))))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 _))
Where the _ in the wrapper is replaced with a call to the function F with the given arguments. You do still have to remember that the argument variables exist and can conflict with ones you define yourself.
That passes all arguments to the function regardless of whether they were given. That might mess up a function that behaves differently depending on whether an argument was supplied or not. You could avoid that by using APPLY, but it's a bit more complex.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(alexandria:with-gensyms (deparsed-arglist-sym
key-sym val-sym suppliedp-sym)
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
(multiple-value-bind (body declarations docstring)
(alexandria:parse-body body :documentation t)
`(defun ,name ,lambda-list
,#(when docstring (list docstring))
,#declarations
(let ((,deparsed-arglist-sym
(nconc (loop for ,val-sym in (list ,#required) collect ,val-sym)
(loop for (,val-sym . ,suppliedp-sym)
in (list ,#(loop for (name init suppliedp)
in optional
collect (list 'cons name
(or suppliedp t))))
when ,suppliedp-sym collect ,val-sym)
(loop for (,key-sym ,val-sym ,suppliedp-sym)
in (list ,#(loop for ((kname name) init suppliedp)
in keywords
collect (list 'list kname name
(or suppliedp t))))
when ,suppliedp-sym append (list ,key-sym ,val-sym)))))
,#(sublis `((_ . (apply #',lambda-source ,deparsed-arglist-sym)))
body))))))))
(define-wrapper bar drakma:http-request
"Return the length of a response to http-request."
;; HTTP-REQUEST has some &aux variables.
(declare (ignore drakma::unparsed-uri
drakma::args))
(length _))
(bar "http://www.google.com") ;=> 11400 (14 bits, #x2C88)
I came up with this:
(defun g (x &rest f-keys &key y z)
(declare (ignorable y z))
(apply #'f x f-keys))
It's great for small lambda-lists but I hope I could do better.
I also can't see default values unless I type them explicitly.
There are always many functions for iterating across list of values like mapcar, every, some.
I need iteration across predicates for single value:
(let ( (val (complex-expr ...)) )
(or (pred1 val) (pred2 val) ... (predN val)))
(let ( (val (complex-expr ...)) )
(and (pred1 val) (pred2 val) ... (predN val)))
Are there any standard functions doing above code with syntax:
(some-p val pred1 pred2 ... predN)
(every-p val pred1 pred2 ... predN)
UPDATE FYI Elisp have this function in it's standard library:
run-hook-with-args-until-success
run-hook-with-args-until-failure
run-hook-with-args
The standard doesn't include anything exactly like what you're asking for, but it does include some and every for computing (or (f x1) (f x2) … (f xn)) and (and (f x1) (f x2) … (f xn)):
CL-USER> (some 'evenp '(1 2 3 4 5))
T
CL-USER> (every 'evenp '(1 2 3 4 5))
NIL
What you're trying to do fits into this paradigm, except that the f you need should take each xi, treat it as a function, and call it with some value. Some and every still work here:
CL-USER> (let ((value 3))
(some (lambda (predicate) (funcall predicate value)) '(evenp symbolp oddp)))
T
CL-USER> (let ((value "hello"))
(some (lambda (predicate) (funcall predicate value)) '(characterp numberp)))
NIL
Of course, you can wrap that up another in function to avoid writing the lambda function every time:
(defun some-p (value predicates)
(some (lambda (predicate)
(funcall predicate value))
predicates))
CL-USER> (some-p "hello" '(characterp numberp))
NIL
CL-USER> (some-p 3 '(characterp numberp))
T
If you really want the function to variadic (like you showed in your question), you can do it with a &rest parameter, but do note that it's not the style most of these kinds of functions use:
(defun some-p (value &rest predicates)
(some (lambda (predicate)
(funcall predicate value))
predicates))
CL-USER> (some-p 3 'characterp 'numberp)
T
CL-USER> (some-p "hello" 'characterp 'numberp)
NIL
It's much more common to take the arguments as a list, though. Two good reasons for this (which are part of the same phenomenon) are that: (i) it's easier to pass the list from another source. E.g., it's easier to do [a] than [b]:
(let ((preds '(p1 p2 ... pn)))
(some-p-list value preds) ; [a]
(apply 'some-p-rest value preds)) ; [b]
Even if you don't mind the apply in [b], as Rainer Joswig noted in comments, there's a constant call-arguments-limit in a Common Lisp implementation that puts a limit on the number of arguments a function can be called with. It's often big, but it can be as small as 50. That means that if preds has 50 elements, then (apply 'some-p-rest value preds) would fail.
There is no standard function, but it is easy to write:
Note that you can also use the LOOP macro for that:
some
CL-USER 10 > (loop with value = 4
for pred in (list #'numberp #'plusp #'oddp)
thereis (funcall pred value))
T
every
CL-USER 11 > (loop with value = 3
for pred in (list #'numberp #'plusp #'oddp)
always (funcall pred value))
T
every-p
CL-USER 16 > (defun every-p (value predicates)
(loop for predicate in predicates
always (funcall predicate value)))
EVERY-P
CL-USER 17 > (every-p 3 (list #'numberp #'plusp #'oddp))
T
By "artificial", I mean one created from a string using intern or make-symbol.
I have a section of my code that declares up to 49 global variables:
(defparameter *CHAR-COUNT-1-1* (make-hash-table))
...
(defparameter *CHAR-COUNT-1-7* (make-hash-table))
...
(defparameter *CHAR-COUNT-7-7* (make-hash-table))
I thought, instead, I could create a function to do all that:
(loop for n from 1 to 7 do
(loop for i from 1 to 7 do
(defparameter (symbol-value (intern (concatenate 'string "*CHAR-COUNT-" (write-to-string n) "-" (write-to-string i) "*")))
(make-hash-table :test 'equalp))))
But get the error(sbcl):
unhandled SIMPLE-ERROR in thread #<SB-THREAD:THREAD "main thread" RUNNING
{1002978EE3}>:
Can't declare a non-symbol as SPECIAL: (SYMBOL-VALUE
(INTERN
(CONCATENATE 'STRING "*CHAR-COUNT-"
(WRITE-TO-STRING N) "-"
(WRITE-TO-STRING I)
"*")))
What is the correct way to do this?
Defparameter is a macro, not a function. That means that it defines a special syntax. The defparameter form needs to have a symbol as its second argument, but you're providing the list:
(symbol-value (intern (concatenate 'string "*CHAR-COUNT-" (write-to-string n) "-" (write-to-string i) "*")))
What you want is a form like
(progn
(defparameter *foo-1-1* (make-hash-table ...))
...
(defparameter *foo-n-n* (make-hash-table ...)))
You seem familiar enough with loop and creating the symbols to create that list; just change
(loop … do (loop … do (defparameter …)))
to
`(progn
,#(loop … nconcing
(loop … collecting
`(defparameter ,(intern …) …))))
and you can get the form you need. Then it's just a matter of putting it all into a macro
(defmacro … (…)
`(progn
,#(loop … nconcing
(loop … collecting
`(defparameter ,(intern …) …)))))
and calling the macro.
One of "use a macro that returns a PROGN with DEFPARAMETER stanzas" or "use PROCLAIM, it is a function, not a macro".
The correct way is to use a proper data structure instead of encoding dimensions in symbol names. Do you really want to calculate and encode symbol names any time you want to access the correct table?
(defparameter *char-counts* (make-array '(7 7)))
(dotimes (i 49) ; or (reduce #'* (array-dimensions *char-counts*))
(setf (row-major-aref *char-counts* i) (make-hash-table)))
Now you can access the array of tables just with the indices (x and y in this example):
(gethash (aref *char-counts* x y) :foo)