Mercurial > core / lisp/std/macs/collecting.lisp
changeset 357: |
7c1383c08493 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Tue, 21 May 2024 22:20:29 -0400 |
permissions: |
-rw-r--r-- |
description: |
port xsubseq, proc-parse. work on http and clap |
1 ;;; std/macs/collecting.lisp --- Collecting Macros 3 ;; ported from CL-UTILITIES 8 ;; This should only be called inside of COLLECTING macros, but we 9 ;; define it here to provide an informative error message and to make 10 ;; it easier for SLIME (et al.) to get documentation for the COLLECT 11 ;; function when it's used in the COLLECTING macro. 12 (defun collect (thing) 13 "Collect THING in the context established by the COLLECTING macro" 14 (error "Can't collect ~S outside the context of the COLLECTING macro" 17 (defmacro collecting (&body body) 18 "Collect things into a list forwards. Within the body of this macro, 19 the COLLECT function will collect its argument into the list returned 21 (with-gensyms (collector tail) 22 `(let (,collector ,tail) 23 (labels ((collect (thing) 26 (setf ,tail (list thing))) 28 (setf ,tail (list thing)))))) 32 (defmacro with-collectors ((&rest collectors) &body body) 33 "Collect some things into lists forwards. The names in COLLECTORS 34 are defined as local functions which each collect into a separate 35 list. Returns as many values as there are collectors, in the order 37 (%with-collectors-check-collectors collectors) 38 (let ((gensyms-alist (%with-collectors-gensyms-alist collectors))) 39 `(let ,(loop for collector in collectors 40 for tail = (cdr (assoc collector gensyms-alist)) 41 nconc (list collector tail)) 42 (labels ,(loop for collector in collectors 43 for tail = (cdr (assoc collector gensyms-alist)) 44 collect `(,collector (thing) 47 (setf ,tail (list thing))) 49 (setf ,tail (list thing)))))) 51 (values ,@collectors)))) 53 (defun %with-collectors-check-collectors (collectors) 54 "Check that all of the COLLECTORS are symbols. If not, raise an error." 55 (let ((bad-collector (find-if-not #'symbolp collectors))) 59 :expected-type 'symbol)))) 61 (defun %with-collectors-gensyms-alist (collectors) 62 "Return an alist mapping the symbols in COLLECTORS to gensyms" 63 (mapcar #'cons collectors 64 (mapcar (compose #'gensym 66 (format nil "~A-TAIL-" x)))