spwhitton/anaphora

The anaphoric macro collection from Hell

anaphora's Issues

ssetf

Often, I want to refer to the place I'm setting with an anaphora. The code to do this is as follows:

(defmacro ssetf (&rest bindings)
  "Anaphoric setf that binds it to a symbol-macro evaluating to name."
  `(progn
     ,@(loop for (name val &rest _) on bindings by #'cddr
             collect
             `(symbol-macrolet ((it ,name))
                (setf it ,val)))))

alambda macro

In Dug Hoyte's let over lambda, he describes the macro alambda

(defmacro alambda (arglist &body body)
  (alexandria:with-unique-names (wrapper-args)
    `(lambda (&rest ,wrapper-args)
       (labels ((anaphora:self (,@arglist) ,@body))
         (funcall anaphora:self ,wrapper-args)))))

This macro is rather useful. It can really simplify code that recurses a tree. It would only require exporting the :self symbol from anaphora. I'm not sure if you guys are ok with doing that.

Feature request: anaphoric map[car/can] etc, remove-if etc

The usage of "it" is really useful in functions which accepts one-argument lambdas.
Even if it is trivial, I guess it is really convenient to type things like

(amapcar (+ it 1) '(1 2 3))
(2 3 4)

And so on.

Fix tests on clisp

Currently SIF.4 fails when building on Travis.

Feature request: Symbolic do/do*

I've came across a few times when writing do loops that I've wanted a then-form and do-form to be the same, for example:

;; Processing members of a stack until exhaustion
(do ((item (pop stack) (pop stack)))
    ((null item))
  ...)

Writing the same code twice is repetitive, and if I have to change one form, I'll have to change the other. It might be better to instead do:

(sdo ((item (pop stack) this))
    ((null item))
  ...)

Since the symbol doesn't appear within a body of code, and changes over each binding list, I couldn't see an appropriate place for a symbol-macrolet. Here's a first pass at direct substitution instead:

(flet ((transform-varlist (varlist)
         (mapcar (lambda (binding)
                   (if (and (listp binding)
                            (= 3 (length binding))
                            (eq 'it (nth 2 binding)))
                       `(,(first binding) ,(second binding) ,(second binding))
                       binding))
                 varlist)))
  (defmacro sdo (varlist endlist &body body)
    "Like standard DO, but if a step-form is IT, it is replaced with its neighboring init-form."
    `(do ,(transform-varlist varlist) ,endlist ,@body))

  (defmacro sdo* (varlist endlist &body body)
    "Like standard DO*, but if a step-form is IT, it is replaced with its neighboring init-form."
    `(do* ,(transform-varlist varlist) ,endlist ,@body)))

And here's a list of real-world snippets I've found that have the same situation, as a motivation for these macros:

;; From slime-v2.27/swank/mkcl.lisp
(with-open-file (s file :direction :output :if-exists :overwrite)
      (do ((line (read-line stream nil) (read-line stream nil)))
	  ((not line))
	(write-line line s)))

;; From slime-v2.27/xref.lisp
(do ((form (read stream nil :eof) (read stream nil :eof)))
    ((eq form :eof))
  ...)

;; From spatial-trees-20140826-git/r-trees.lisp:
(defun pick-seeds (entries tree)
  (do* ((entry1 (car entries) (car entries))
        (entries (cdr entries) (cdr entries))
        (maxentry1 entry1)
        (maxentry2 (car entries))
        (maxd (d maxentry1 maxentry2 tree)))
       ((null entries) (values maxentry1 maxentry2))
    ...))

;; From fast-http-2019-1007-git/src/parser.lisp:

;; skip until field end
(do ((char (aref +tokens+ (current))
           (aref +tokens+ (current))))
     ((= (current) (char-code #\:)))
  (declare (type character char))
  (when (char= char #\Nul)
    (error 'invalid-header-token))
  (advance))

;; From zpb-exif-release-1.2.5/exif.lisp:
(do ((first-byte (read-byte stream nil) next-byte)
     (next-byte (read-byte stream nil) (read-byte stream nil)))
    ((not (and first-byte next-byte)))
  ...)

;; From cl-pdf-20220220-git/x11-colors.lisp:
(do ((line (read-line i nil :eof)
           (read-line i nil :eof)))
    ((eq line :eof))
  ...)

;; From mcclim-20220331-git/Tools/clim-doc-convert.lisp:
;; Actually, there's quite a few read-char read-char snippets in the code.
;; This is just one example
(do ((c (read-char input) (read-char input)))
    ((char= c #\$))
  (write-char c bag))

(do ((x (slurp-one input) (slurp-one input)))
    ((and (consp x) (eq (car x) :group))
     ;; xxx
     (cadr x))
    (unless (or (null x)
                (and (stringp x)
                     (every #'white-space-p x)))
      (error "Expected group, got ~S." x)) )

Thank you!