I was pleased to discover that DESTRUCTURING-CASE made it into Alexandria meanwhile. Very nice! This allows me to share the little gem that I'm attaching with this posting. It's a handy macro to make writing macros like DEFPACKAGE, DEFGENERIC of DEFREADTABLE easy like a breeze.
Happy to be giving back again! :-)
T diff --git a/macros.lisp b/macros.lisp index 4450435..0d4b9e9 100644 --- a/macros.lisp +++ b/macros.lisp @@ -303,4 +303,76 @@ Example: (setf (documentation name 'function) (documentation 'destructuring-case 'function)))
+;;; DESTRUCTURE-CLAUSES
+(defmacro destructure-clauses (clauses patterns &body body) + "Utility macro to conveniently destructure DEFPACKAGE like clauses. + + clauses ::= clause* + clause ::= (keyword . list) ; e.g. (:FOO 1 :K 2) + + patterns ::= pattern* + pattern ::= (keyword . ordinary-lambda-list) ; e.g. (:FOO N &KEY K) + +The CAR of each clause in CLAUSES will be tried to be matched against +the CAR of each pattern in PATTERNS. If a match is found, the CDR of +the matched pattern is interpreted as an ordinary lambda list and its +parameters are bound to the values provided by the CDR of the clause. + +When all CLAUSES are processed, BODY will be executed with all the +parameters of the matched patterns bound appropriately. Notice that +parameters must hence be named distinctively in each pattern. + +Example: + + (defmacro defpackage (name &body clauses) + (destructure-clauses clauses + ((:use &rest uses) + (:nicknames &rest nicknames) + (:export &rest exports) + ...) + (expand-defpackage name uses nicknames exports ...)) + +Implementation note: + + That a pattern consists of ordinary lambda list and not of + destructuring lambda lists is a /shortcoming/ of the current + implementation. Patches are welcome. +" + (multiple-value-bind (pattern-table vars n-vars) + (loop for pattern in patterns + for vars = (ordinary-lambda-list-parameters (cdr pattern)) + for n-vars = (mapcar #'make-gensym vars) + collect (cons pattern (list vars n-vars)) into pattern-mappings + append vars into all-vars + append n-vars into all-n-vars + finally + (return (values (alist-hash-table pattern-mappings) + all-vars + all-n-vars))) + (with-unique-names (clause) + `(let ,n-vars + (dolist (,clause ,clauses) + (destructuring-ecase ,clause + ,@(loop for p in patterns + for (pattern-vars pattern-n-vars) = (gethash p pattern-table) + collect `(,p ,@(loop for var in pattern-vars + for n-var in pattern-n-vars + collect `(setq ,n-var ,var)))))) + (let ,(mapcar #'list vars n-vars) + ,@body))))) + +(defun ordinary-lambda-list-parameters (ordinary-lambda-list) + "Return a list of all parameter names in ORDINARY-LAMBDA-LIST." + (flet ((optional-parameter-name (spec) + (car spec)) + (key-parameter-name (spec) + (second (first spec)))) + (multiple-value-bind (reqs opts rest keys aok auxs) + (parse-ordinary-lambda-list ordinary-lambda-list) + (assert (null aok) () "&ALLOW-OTHER-KEYS not supported.") + (assert (null auxs) () "&AUX not supported.") + (append reqs + (mapcar #'optional-parameter-name opts) + (ensure-list rest) + (mapcar #'key-parameter-name keys))))) \ No newline at end of file diff --git a/package.lisp b/package.lisp index babeb95..a025cc7 100644 --- a/package.lisp +++ b/package.lisp @@ -240,4 +240,5 @@ #:destructuring-case #:destructuring-ccase #:destructuring-ecase + #:destructure-clauses )) diff --git a/tests.lisp b/tests.lisp index e218113..51ea8ca 100644 --- a/tests.lisp +++ b/tests.lisp @@ -1856,3 +1856,47 @@ (when err (incf n)))))) 13) + +(deftest destructure-clauses.1 + (let ((+clauses+ '((:required-1 :R1) + (:required-n :R2 :R3 :R4) + (:optional-0) + (:optional-1 :O2) + (:key-0) + (:key-1 :KEY2 :K2) + (:key-n :KEY3 :K3 :KEY4 :K4) + (:required+optional-0 :R5) + (:required+optional-1 :R6 :O4) + (:required+key :R7 :R8 :KEY5 :K5)))) + (destructure-clauses +clauses+ + ((:required-1 req1) + (:required-n req2 req3 req4) + (:optional-0 &optional (opt1 :O1)) + (:optional-1 &optional opt2) + (:key-0 &key (key1 :K1)) + (:key-1 &key key2) + (:key-n &key key3 key4) + (:required+optional-0 req5 &optional (opt3 :O3)) + (:required+optional-1 req6 &optional opt4) + (:required+key req7 req8 &key key5)) + (values + (list req1) + (list req2 req3 req4) + (list opt1) + (list opt2) + (list key1) + (list key2) + (list key3 key4) + (list req5 opt3) + (list req6 opt4) + (list req7 req8 key5)))) + (:R1) + (:R2 :R3 :R4) + (:O1) + (:O2) + (:K1) + (:K2) + (:K3 :K4) + (:R5 :O3) + (:R6 :O4) + (:R7 :R8 :K5)) \ No newline at end of file
On 25 April 2012 16:47, Tobias C Rittweiler tcr@freebits.de wrote:
I was pleased to discover that DESTRUCTURING-CASE made it into Alexandria meanwhile. Very nice! This allows me to share the little gem that I'm attaching with this posting. It's a handy macro to make writing macros like DEFPACKAGE, DEFGENERIC of DEFREADTABLE easy like a breeze.
Nice!
Unless I misread this, duplicate clauses cause the earlier one to be discarded? Signaling an error instead might be better, though a fairly common pattern might also be served by special casing clauses of the form
(:keyword &append stuff)
or something like that, which would cause duplicate clauses to have their contents merged.
Or maybe that should be factored into a separate function MERGE-ALIST, for preprocessing the clauses?
function MERGE-ALIST keys alist &optional (merge #'append)
...or something along those lines?
Cheers,
-- Nikodemus
On Thu, 2012-04-26 at 11:41 +0300, Nikodemus Siivola wrote:
On 25 April 2012 16:47, Tobias C Rittweiler tcr@freebits.de wrote:
I was pleased to discover that DESTRUCTURING-CASE made it into Alexandria meanwhile. Very nice! This allows me to share the little gem that I'm attaching with this posting. It's a handy macro to make writing macros like DEFPACKAGE, DEFGENERIC of DEFREADTABLE easy like a breeze.
Nice!
Unless I misread this, duplicate clauses cause the earlier one to be discarded? Signaling an error instead might be better, though a fairly common pattern might also be served by special casing clauses of the form
(:keyword &append stuff)
or something like that, which would cause duplicate clauses to have their contents merged.
Exactly: CL:DEFPACKAGE allows repeated :export clauses and requires them to be merged(appended)
In article 1335431200.3991.0.camel@cathai, Stelian Ionescu sionescu@cddr.org wrote:
On Thu, 2012-04-26 at 11:41 +0300, Nikodemus Siivola wrote:
On 25 April 2012 16:47, Tobias C Rittweiler tcr@freebits.de wrote:
I was pleased to discover that DESTRUCTURING-CASE made it into Alexandria meanwhile. Very nice! This allows me to share the little gem that I'm attaching with this posting. It's a handy macro to make writing macros like DEFPACKAGE, DEFGENERIC of DEFREADTABLE easy like a breeze.
Nice!
Unless I misread this, duplicate clauses cause the earlier one to be discarded? Signaling an error instead might be better, though a fairly common pattern might also be served by special casing clauses of the form
(:keyword &append stuff)
or something like that, which would cause duplicate clauses to have their contents merged.
Exactly: CL:DEFPACKAGE allows repeated :export clauses and requires them to be merged(appended)
Ah, true. I forgot about that. That answers my question in the other mail.
T
In article CADow0CpTq8ns8xx065Uk7P92-w98b6njBkzK4f9qUffh3iaqpw@mail.gmail.com, Nikodemus Siivola nikodemus@random-state.net wrote:
On 25 April 2012 16:47, Tobias C Rittweiler tcr@freebits.de wrote:
I was pleased to discover that DESTRUCTURING-CASE made it into Alexandria meanwhile. Very nice! This allows me to share the little gem that I'm attaching with this posting. It's a handy macro to make writing macros like DEFPACKAGE, DEFGENERIC of DEFREADTABLE easy like a breeze.
Nice!
Unless I misread this, duplicate clauses cause the earlier one to be discarded? Signaling an error instead might be better,
Yes, that is true. I also regularly use the following macro in macro definitions:
;;; This is a macro for sake of nicer indentation of the format control. (defmacro assert-no-duplicates (list (&key test key) &body (format-control . format-args)) "If LIST contains duplicates, an error is signaled. FORMAT-CONTROL,
and FORMAT-ARGS are passed to ERROR along an enumeration of the
duplicated items." `(%assert-no-duplicates ,list ,test ,key ,format-control (list ,@format-args)))
(defun %assert-no-duplicates (list test key format-control format-args) (let* ((test (if test (ensure-function test) #'eql)) (no-dups (remove-duplicates list :test test :key key))) (unless (= (length list) (length no-dups)) (error "~@<~? ~:_Duplicates are:~:_ ~:I~{~S~^, ~:_~}~:>" format-control format-args (dolist (x no-dups list) (setq list (remove (if key (funcall key x) x) list :count 1 :test test :key key)))))))
E.g.
(defmacro defpackage (name &body clauses) (assert-no-duplicates clauses (:key #'car) "Found duplicates in the clauses passed to ~S." `(defpackage ,name)) (destructure-clauses clauses ((:uses &rest uses) ...) (expand-defpackage uses ...)))
Do you want me to provide that as a patch, too?
though a fairly common pattern might also be served by special casing clauses of the form
(:keyword &append stuff)
or something like that, which would cause duplicate clauses to have their contents merged.
I don't know. It invents unprecedented syntax for a not really common case. And the manual way doesn't seem that bad:
(destructure-clauses clauses ((:foo &rest xs1) (:bar &rest xs2) ...) (let ((xs (append xs1 xs2))) ...))
Or maybe that should be factored into a separate function MERGE-ALIST, for preprocessing the clauses?
function MERGE-ALIST keys alist &optional (merge #'append)
...or something along those lines?
That one seems useful on its own. How comes you think the merging of clause parameters is anything but a rare occasion anyhow?
T
T
alexandria-devel@common-lisp.net
-
Nikodemus Siivola -
Stelian Ionescu -
Tobias C Rittweiler