What little functions/macros do you use?

Discussion of Common Lisp
Jasper
Posts: 209
Joined: Fri Oct 10, 2008 8:22 am
Location: Eindhoven, The Netherlands
Contact:

What little functions/macros do you use?

Post by Jasper » Tue Mar 23, 2010 3:20 pm

I had (and still have) a little file with little utilities in it, many of these aren't a big deal, but i could imagine them being an annoyance to others. So we should discuss them and try see if we can agree on using the same ones. Part of the objective of Alexandria is presumably this. PDF Draft documentation, autodocumentation. (Confused that it is named ".0.DEV" there..) Incase pdf misses anything. Of course Alexandria isn't the only library that could help standardize how we do stuff.

I personally changed some code to start using $#'if-let, $#'when-let, $#'curry, $#'rcurry of Alexandria instead of my own. (Actually i think i sometimes even found CL functions/macros to suit the utility i originally met with my own macro/function.

Some macros i still use have my own variant for:

setf- change a setf-able by a function; (defmacro setf- (change-function to-set &rest args) `(setf ,to-set (,change-function ,@args))), for instance (setf- max var ...) does the same as (alexandria:maxf var ...) (it is just more general) Of course i usually don't use setting anything, usually end up using it if i am writing a simulation.

with-mod-slots allows you do do two things 1) treat slots as interned into the current package, and 2) have the slots of two objects with same-named slots accessible directly without writing a $#'symbol-macrolet yourself. I also encounter this usually in simulations.

Code: Select all

(defmacro with-mod-slots (mod (&rest slots) object &body body)
  (with-gensyms (obj)
    `(let ((,obj ,object))
       (symbol-macrolet
	   (,@(mapcar (lambda (slot)
			`(,(intern (format nil "~D~D" mod slot))
			   (slot-value ,obj ',slot)))
		      slots))
	 ,@body))))
You could do the same for $#'with-accessors i guess.

And, as i whined before, denest, but not very often at all. I use a more complicated version than the below.(too complicated infact, and i don't make use of it, but i can just cut it out)

Code: Select all

(defmacro denest (&rest forms)
  (if (null (cdr forms))
    (car forms)
    `(,@(car forms) (denest ,@(cdr forms)))))
But i think that if you're using it, it is likely(but not certain) that you need to rethink how you're doing things.

More minorly, constant Just a function of the constant given with an ignored (&rest rest) argument, sqr, and i have some more in the file that i either end up not using much(case-let, mk for make-instance), or i should phase out using. Also got vector stuff i use. (Not this just use lisps vectors and pray that optimizes now.. (The suggested packages there seem to involved there, i just wanted basic vectors, and maybe matrices.)

So what little functions/macros do you use? And which libraries or do you keep them yourself? Have any libraries to suggest to others?

Kohath
Posts: 61
Joined: Mon Jul 07, 2008 8:06 pm
Location: Toowoomba, Queensland, Australia
Contact:

Re: What little functions/macros do you use?

Post by Kohath » Fri Mar 26, 2010 3:44 am

Hey, I use, among a couple of other less interesting utilities, these (apologies if I can't recall the originator):

Code: Select all

(defmacro let^ (bindings &body body)
  (if (evenp (length bindings))
   `(let ,(loop :for (var val) :on bindings :by (function cddr)
           :collect (list var val)) ,@body)
      (cerror "Odd number of let^ bindings.")))
and a similar version analagous to let*. They only really save typing a few parentheses, but I use them a fair bit...

I also like Gary King's ap:

Code: Select all

(defmethod ap ((thing cl:string) &optional package)
  (let ((*package* (or (and package (find-package package))
                       nil)))
    (apropos-list thing package)))

(defmethod ap ((thing symbol) &optional package)
  (ap (symbol-name thing) package))

(defmethod ap ((thing list) &optional package)
  (cond
    ((null thing) nil)
    ((null (rest thing)) (ap (first thing) package))
    (t (let ((current (ap (first thing) package)))
        (dolist (thenext (rest thing))
          (setf current (intersection current (ap thenext))))
        current))))
And aif and awhen, which you can probably google easy enough, and... ... curry and rcurry, but I have trouble using them if they are nested more than two levels :shock: (that's me trying to figure it out), and deb:

Code: Select all

(defmacro deb (symbol &rest forms)
  "A debugging macro - prints the first (unevaluated) argument, and then each form with it's value.
It returns the value of the last form."
 (let ((result (gensym "result")))
   `(let^ (#+clisp *standard-output* #+clisp t
           ,result nil)
      (format *standard-output* "~&~A: ~{~{~A = ~A~}~^, ~}~%" ',symbol
              ,(cons 'list (mapcar #'(lambda (x) `(list ',x (setf ,result ,x))) forms)))
      ,result)))
If you think I should write deb a bit differently, I'd be interested. I also use compose (there's an implementation in Alexandria), and print-list, which is just a bit nicer to read for interactive sessions when working on long lists:

Code: Select all

(defun print-list (list &optional (stream *standard-output*)
                   &key (leading #\Newline))
  "Prints a list in lisp style with an element to each line."
  (princ leading)
  (when (not list)
    (princ "()")
    (return-from print-list nil))
  (if (consp list)
    (progn
      (princ "(" stream)
      (prin1 (car list) stream)
      (when (cdr list)
        (dolist (item (cdr list))
          (princ "
 " stream)
          (prin1 item stream)))
      (princ ")" stream))
      (prin1 list stream))
  nil)
and one which someone wrote because it will let you compile and load it without warnings or errors:

Code: Select all

(defspel defconst (name value &optional doc)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
    (unless (boundp ',name)
      ,(if doc
        `(defconstant ,name ,value ,doc)
        `(defconstant ,name ,value)))))
And here's some that I haven't used much, but might be fun :mrgreen::

Code: Select all

(defun random-remove (list)
  "Returns two values - the new, shorter, list and the removed element.
This is the two-pass version, please use me."
  (check-type list list)
  (when (null list) (return-from random-remove nil))
  (let^* (len (length list)
          i (random len)
          target (nthcdr i list))
    (values (append (subseq list 0 i) (cdr target))
            (car target))))

(defmacro random-pop (list-place)
  (let^ (remains (gensym "REMAINS")
         elt (gensym "ELT"))
    `(multiple-value-bind (,remains ,elt) (random-remove ,list-place)
      (setf ,list-place ,remains)
      ,elt)))
P.S. I assume that when you said this:
Jasper wrote: setf- change a setf-able by a function; (defmacro setf- (change-function to-set &rest args) `(setf ,to-set (,change-function ,@args))), for instance (setf- max var ...) does the same as (alexandria:maxf var ...) (it is just more general) Of course i usually don't use setting anything, usually end up using it if i am writing a simulation.
you actually meant:

Code: Select all

... `(setf ,to-set (,change-function ,to-set ,@args)) ...
I really like that idea, thanks :).

Jasper
Posts: 209
Joined: Fri Oct 10, 2008 8:22 am
Location: Eindhoven, The Netherlands
Contact:

Re: What little functions/macros do you use?

Post by Jasper » Fri Mar 26, 2010 9:37 am

Thanks for your input. let^ is neat!

Haven't ever used(or maybe even looked at before) apropos.. What do you use it for? Finding functions to use as you're coding? (For autodoccing i just iterate do-symbols or do-external-symbols. Btw, i'd do (defmethod ap ((thing null) &optional package) (declare (ignore package))) for the null case.

Was always stopped in using Anaphoras aif and such because of the nondescriptive names and IT, but it is clear enough, probably should start using that too..

For print-list how about

Code: Select all

(defun print-obj (list &key (leading #\Newline))
  "For sequences, a line for each element."
  (princ leading)
  (typecase list ;;A really useful macro, btw
    (null (princ "()"))
    (sequence
     (princ "(") (prin1 (type-of list))
     (map nil #'print list)
     (princ ")"))
    (t    (prin1 list)))
  list)
Seems less messy to me. Although type-of-list is more informative, it's output may not always be the most desirable :), guess you could put a typecase in there (typecase list (list 'list) (vector 'vector) (array 'array) (t (type-of list)))

Don't know what to change about DEB, but doesn't that clisp-specific thing lead to a big surprise when people try to change *standard-output*? Not sure what problem in clisp that is trying to solve, though. If it isn't defaultly bound, you could check for that with boundp.

About random-remove and random-top why (check-type ..) vs (declare (type ..)), i feel that uncomfortable with random-pop being a macro, but no way of getting around setting it that is convenient, i guess. cl:push is also a macro, so..

Kohath
Posts: 61
Joined: Mon Jul 07, 2008 8:06 pm
Location: Toowoomba, Queensland, Australia
Contact:

Re: What little functions/macros do you use?

Post by Kohath » Fri Mar 26, 2010 9:56 pm

I use ap less nowadays, but I've found that it's most useful when you've picked up the basics of a package, but can't remember the function name exactly, or which functions have XYZ in their name. So, it's kind of a help to jog my memory, when I don't want to deal with the CL HyperSpec or other documentation. As an example, try comparing the output of:

Code: Select all

(ap '("PRINT" "HASH"))
with the output of:

Code: Select all

(apropos "PRINT")
(apropos "HASH")
As for print-obj, nice use of map - I should use the sequence functions more. I would, however, like to retain the nice output formatting.

About check-type, I never thought about it like that, but I see your point. I suppose that a declaration can (sometimes?) be ignored by the compiler, but check-type is actual code and is not going to be accidentally thwarted, so it may lead to more stable code. Also, efficiency isn't really an issue as it's a function I only use in interactive sessions.

I will have a look at deb and why I put in the binding for *standard-output*. Hmm. Yup, Clisp works without the extra binding - I must have had a bug when I was writing it, and didn't clean it up properly. :roll:

Regards,
Jonathan

Kohath
Posts: 61
Joined: Mon Jul 07, 2008 8:06 pm
Location: Toowoomba, Queensland, Australia
Contact:

Re: What little functions/macros do you use?

Post by Kohath » Fri Mar 26, 2010 10:16 pm

Ahh, the #'ap example looks a lot better if you have print-hash-table defined. That's one more I have accumulated from somewhere/someone :mrgreen::

Code: Select all

(defun print-hash-table (hash-table)
  (maphash
    #'(lambda (key value)
      (format t "~S ==> ~S~%" key value))
    hash-table))

Kohath
Posts: 61
Joined: Mon Jul 07, 2008 8:06 pm
Location: Toowoomba, Queensland, Australia
Contact:

Oh, I forgot these ones...

Post by Kohath » Fri Mar 26, 2010 10:44 pm

I just looked into my array utilities, which I skipped over earlier when I wrote the other replies. One thing that has annoyed me in the past, is the 0 based indices for arrays, etc., so I wrote my own aref and elt versions:

Code: Select all

(defun 1ref (array &rest indices)
  "Cool 1-based array indexing."
  (apply #'aref array (mapcar #'1- indices)))

(defsetf 1ref (array &rest indices) (newval)
  `(setf (aref ,array ,@(mapcar #'(lambda (i) `(1- ,i)) indices)) ,newval))

(defun 1elt (seq index)
  "Cool 1-based array indexing."
  (elt seq (1- index)))

(defsetf 1elt (seq index) (newval)
  `(setf (elt ,seq (1- ,index)) ,newval))
And, when I do bits of array processing, I like these (see comments for an explanation):

Code: Select all

(defmacro with-easy-arrays (array-names &body body)
  "This macro (along with with-easy-1arrays) attempt to make code
that has a lot of array element accesses look simpler, and thus by
extension (if the array names are helpful) also easier to read.
Wraps body in a macrolet which establishes several temporary
macros that eliminate the need to include aref when retrieving
elements from the given arrays.  Because they're macros, we also
avoid writing aref when setting an element.  For example, when
you would normally write (setf (aref m 7 8) (aref m 3 2)), instead
you'd write (with-easy-arrays (m) (setf (m 7 8) (m 3 2))).  You
can still access each of the whole arrays, what you can't access
would probably be functions with the same names as your matrix
variable names."
  `(macrolet ,(mapcar #'(lambda (array)
                         `(,array (&rest args)
                           `(aref ,',array ,@args)))
                      array-names)
     ,@body))

(defmacro with-easy-1arrays (array-names &body body)
  "Like with-easy-arrays but uses 1ref instead of aref.
This means that all of your arrays are now indexed from
1, not 0 like they are with aref."
  `(macrolet ,(mapcar #'(lambda (array)
                         `(,array (&rest args)
                           `(1ref ,',array ,@args)))
                      array-names)
     ,@body))
I've also got some untyped (I haven't bothered to declare types) implementations of some linear algebra functions, such as gauss-jordan elimination (with and without partial pivoting), some LU decomposition routines, and matrix inversion, which I might ;) post if anyone's interested. I think someone has been doing some matrix stuff in Lisp, just can't remember who.

P.S. I really really like the way Lisp lets you use symbols like 1ref (illegal in C/C++, and probably other similar languages), and even pi/2, etc.

Jasper
Posts: 209
Joined: Fri Oct 10, 2008 8:22 am
Location: Eindhoven, The Netherlands
Contact:

Re: What little functions/macros do you use?

Post by Jasper » Sat Mar 27, 2010 2:22 pm

Perhaps some sort of regexprs would do better than AP though, hmm perhaps make a little 'peeker' lib that prints parts with possibly with regexpressions.

I think the main difference between check-type and declare is that check-type allows you to fill it in when it errors ithink. Contrary what you said you can't accidentally twart it, it will give an error if you enter a wrong type. (On defaults; it may depend on what the safety is relative to the other optimize declarations.) You can easily compare them by using them and entering an incorrect input.

Starting counting at 0 does seem more natural to me, for computers, at least. The first element in an array is a shift of 0 bytes. with-easy-arrays looks useful to me, but maybe simply with-array-aref is a better name for it, dont know. Perhaps it could take the arrays directly as arguments or something, tbh don't really like the idea of macros using variables that have been defined externally. (other then defvar defparameter) Perhaps a compromise:

Code: Select all

(defmacro with-areffer (from &body body)
  (typecase from
    (list
     (destructuring-bind (array-name array) from
       `(let ((,array-name ,array))
	  (macrolet ((,array-name (&rest indices)
		       `(aref ,',array-name ,@indices)))
	    ,@body))))
    (symbol
     `(macrolet ((,from (&rest indices)
		  `(aref ,',from ,@indices)))
	,@body))))

(defmacro with-areffers ((&rest arefs) &body body)
  `(with-aref (,(car arefs))
     ,@(if (null(cdr arefs))
	 body `((with-arefs (,@(cdr arefs)) ,@body)))))
Also with the let^ things, we could apply it to this macro, but doing that for every other macro would be annoying. Or we could do:

Code: Select all

(defmacro ^ (name bindings &body body)
  `(,name ,(loop :for (var val) :on bindings :by (function cddr)
              :collect (list var val)) ,@body))
So that it can be applied to any macro with corresponding structure. (^ let .. ) = (let^ ...) This way we can write the macros with the usual assoc-list structure people are used to and use that to make the ^ version(perhaps the hat better before then?) or just apply ^ in the code.

About vectors&matrices yeah, a standard package with those seems missing. I asked, but all those are rather large packages or are for sparse matrices etcetera, i just wanted numerical vectors, with a few dimensions. I also posted code for vectors there, but it is slow to load; it has to combine them all i think. Currently i use another little package that just uses cl:vectors. It puts the operators on v+, v-, v*, v/ and such. What is handy is that defining it for vectors allows you to define matrices in one swoop, just define those operators on numbers too, and if there is a vector there it will work correctly. Even works for inproducts (which become matrix products multidimensionally, not v*!). Not sure of the performance of that, though. Didn't ever come to need matrices(or operations on them) though.

Kohath
Posts: 61
Joined: Mon Jul 07, 2008 8:06 pm
Location: Toowoomba, Queensland, Australia
Contact:

Re: What little functions/macros do you use?

Post by Kohath » Sat Mar 27, 2010 3:00 pm

Regarding check-type I was actually alluding to situations where optimisations have been applied/declared, like safety 0, or speed 3. Ah, yes, I forgot that check-type presents a restart to fix the value, that's neat. The regexp idea would be cool, but then I'd have to learn how to write and read regexp. :o

Also, I like your idea of defining a ^ macro, but which other macros would you use it for? I think flet and labels, etc. would need a three+ element collection clause or some kind of delimiter to deal with the function bodies.

The way I feel about with-easy-arrays (nice suggestions for names and improvements - I'll take them on board) is that they are just lexical bindings for the symbol in function position. But if it is prone to or lead to problems, confusion, etc., then I'm all ears. ;)

Also, the 1 based indices is a personal preference thing, for me, I think it's my background in mathematics, and the my mental train of thought from "first" to "1st".

Dolda
Posts: 4
Joined: Sun Mar 28, 2010 6:23 pm

Re: What little functions/macros do you use?

Post by Dolda » Sun Mar 28, 2010 7:08 pm

I quite enjoy these ones.

An augmentation of unwind-protect makes it easy to e.g. open sockets or X displays, initialize them, and clean up if unsuccessful:

Code: Select all

(defmacro abnormal-protect (protected &body cleanup)
  (with-gensyms (done)
    `(let ((,done nil))
       (unwind-protect
	    (prog1 ,protected
	      (setf ,done t))
	 (unless ,done ,@cleanup)))))
I think this one comes from Scheme, or possibly some SRFI or something. It makes it easy to bind variables and perform checks on them while binding:

Code: Select all

(defmacro and-let* (clauses &body body)
  (labels ((fix-tail (tail)
	     (if (and (listp tail) (eq (car tail) 'and))
		 (cdr tail)
		 (list tail)))
	   (compile-clauses (clauses)
	     (let ((clause (car clauses))
		   (rest (cdr clauses)))
	       (let ((tail (if rest (compile-clauses rest) `(progn ,@body))))
		 (cond ((and (listp clause) (symbolp (car clause)))
			`(let (,clause)
			   (and ,(car clause)
				,@(fix-tail tail))))
		       ((and (listp clause) (listp (car clause)))
			`(and ,(car clause) ,@(fix-tail tail)))
		       ((symbolp clause)
			`(and ,clause ,@(fix-tail tail)))
		       (t (error "Illegal clause ~S in ~S" clause 'and-let*)))))))
    (compile-clauses clauses)))
And finally, how comes CL doesn't come with a built-in definition of WHILE?

Code: Select all

(defmacro while (condition &body body)
  `(loop (if (not ,condition)
	     (return))
      ,@body))

Jasper
Posts: 209
Joined: Fri Oct 10, 2008 8:22 am
Location: Eindhoven, The Netherlands
Contact:

Re: What little functions/macros do you use?

Post by Jasper » Mon Mar 29, 2010 5:32 am

To be honest, i never really used unwind-protect can't really say much about unwind-protect.

Suggest the following for and-let*, with here when-let from alexandria:

Code: Select all

(defmacro when-let-n (clauses &body body)
  "Do body if all variables in clauses non-nil"
  `(when-let ,(car clauses)
     ,@(if (null (cdr clauses))
          body
         `((when-let-n ,(cdr clauses) ,@body)))))
Dolda wrote:And finally, how comes CL doesn't come with a built-in definition of WHILE?
Probably aversion with code based on side-effects. Probably not entirely ill-considered. There is a reason DO is much more strict about it. Unfortunately WHILE and UNTIL will probably conflict with iterate, although it should be easy to make a macro that defers some of iterates symbols to keywords. (I don't use iterate anymore btw)
Kohath wrote:The regexp idea would be cool, but then I'd have to learn how to write and read regexp.
To be honest, i don't really know them. Just use wildcards '*' and '?', but that would still be handy; (ap '("PRINT" "HASH")) is longer than (ap "PRINT*HASH"), actually pretty marginal(even with stars automatically at the edges), probably should have said it.. Btw, those two aren't exactly the same, the two words need to be in the correct order for the latter.

There really isn't any source of confusion in how you arranged things in with-easy-arrays, just a little pet worry of mine. Sometimes it is just a personal preference, just like you liked 1ref, 1elt, don't think those personal preferences are very productive, by the way. It may be a distraction, especially in dealing with other people's code.

How about this macro

Code: Select all

(defmacro def-setf-fun (name (&rest args) &body body)
  (with-gensyms (to)
    `(progn (defun ,name (,@args) ,@body)
            (defun (setf ,name) (,to ,@args)
              ,@(butlast body)
              (setf ,(car(last body)) ,to)))))

(let ((a 4))
  (def-setf-fun set-a () a))
Something bugged me about it, but now i cannot fathom nor remember what, i think i'll try using it again..

Post Reply