[alexandria-devel] Anonymous modify macros through `CALLF'

[Tobias C. Rittweiler]

Hi,

Alexandria seems to contain a lot of modify macro definitions. Which is
no wonder, as those are quite practical: They're concise, and
simultaneously guarantee that their arguments are only evaluated once.

Inspired from CL.el in Emacs, I grew quite fond of CALLF which is a
generalized modify macro, or if you look from the right angle, an
anonymous modify macro facility.

Instead of having to globally define modify macros each time you want
one for a certain function, you simply use CALLF instead:

 (callf #'append place l1 l2 l3 ...) == (appendf place l1 l2 l3)

 (callf #'coerce place 'foo) == (coercef place 'foo)

 and so on.


CALLF is actually just an abbreviation for the even more general macro
CALLF-N:

  (callf-n n function &rest args)

which takes the Nth argument to be the place. I.e.

  (callf #'f place x y z) == (callf-n 1 #'f place x y z)

This is important if you want to use things like REMOVE or DELETE where
the place is the second argument. I.e. something almost equivalent to
Erik Naggum's DROP could be defined like:

  (defmacro drop (object place &rest keys &key key test test-not)
    "Drop a particular OBJECT from list in PLACE.  
     (Intended as counterpart to PUSH.)"
    (declare (ignore key test test-not))
    `(callf2 #'delete ,object ,place :count 1 , at keys))

where CALLF2 is equivalent to (CALLF-N 2); CALLF and CALLF2 are
abbreviations for the most common cases, so they're specially provided.

As you can see, these macro also aid macro programming because they
relieve you from having to mess with GET-SETF-EXPANSION &c.

I place the implementation below into the public domain to be included
into the Alexandria library.

 Notice that the implementation uses another utility BREAKUP which
(together with its sibling BREAKUP-IF) should also be included into
Alexandria.

  -T.


(defun breakup (n list)
  "Breaks LIST into two pieces at position N where the (NTH n) element
will become the first element of the second piece. Both pieces are 
returned in a list.

If N < 0, treat N as if 0.

If N >= (length LIST), return NIL as second piece.

Examples:

   (breakup 0 '(0 1 2 3 4)) => (NIL (0 1 2 3 4))
   (breakup 2 '(0 1 2 3 4)) => ((0 1) (2 3 4))
   (breakup 9 '(0 1 2 3 4)) => ((0 1 2 3 4) NIL)
"
  (let ((front nil))
    (dotimes (i n)
      (when (null list)	(return))
      (push (car list) front)
      (setf list (cdr list)))
    (list (nreverse front) list)))

(defun breakup-if (predicate list)
  "Breaks LIST into two pieces at the first element of which 
PREDICATE returns T.

Examples:

   (breakup-if #'oddp  '(2 4 6 7 8 10)) => ((2 4 6) (7 8 19))
   (breakup-if #'evenp '(2 4 6 7 8 10)) => (NIL (2 4 6 7 8 10))
"
  (loop with tail = nil
	for (x . rest) on list
	if (not (funcall predicate x))
	  collect x into front
	else
          do (setq tail (cons x rest))
	     (loop-finish)
	finally (return (list front tail))))


(defmacro callf-n (n function &rest args &environment env)
  "CALLF-N represents an anonymous modify macro facility.
 
The Nth argument (starting from 1) of ARGS is considered to be a `place'.
This place is set to `(FUNCTION arg1 ... arg{N-1} place arg{N+1} ...)'.

Examples:

  (appendf place l1 l2 ...) == (callf-n 1 #'append place l1 l2 ...)

  (progn 
    (defvar *foo* (list 1 2 (list 3 4 4 4 5) 6 7))
    (callf-n 2 #'remove 4 (third *foo*))
    *foo*)                                        ==> (1 2 (3 5) 6 7)
"
  (destructuring-bind ((&rest frontargs) (place &rest tailargs)) (breakup (1- n) args)
    (multiple-value-bind (gvars vals gstorevars setter getter)
	(get-setf-expansion place env)
      (when (second gstorevars)
	(error "CALLF does not support setting multiple values via the (VALUES ...) place."))
      (let ((gstorevar (first gstorevars)))
	`(let ,(mapcar #'list gvars vals)
	   (let ((,gstorevar (funcall ,function , at frontargs ,getter , at tailargs)))
	     ,setter)
	   )))))

(defmacro callf (function &rest args)
  "Abbreviation for (CALLF-N 1 FUNCTION args..)."
  `(callf-n 1 ,function , at args))

(defmacro callf2 (function &rest args)
  "Abbreviation for (CALLF-N 2 FUNCTION args..)."
  `(callf-n 2 ,function , at args))

-- 
Diese Nachricht wurde auf Viren und andere gefaerliche Inhalte untersucht
und ist - aktuelle Virenscanner vorausgesetzt - sauber.
Freebits E-Mail Virus Scanner