Hi all,
I have some troubles defining the parameters of my 'types-match-bind'.
The problem is that keywords parameters are handle at the end, so i can't
have a "body" after them. I was first searching for a solution using the
macro destructuring facility, but i'm afraid it's not possible. some ideas ?
(defmacro compilation-unit (&rest args)
(types-match-bind :vars (package import-declarations
type-declarations)
:expr args
:pattern ((package 0-1) (import-declaration 0-*)
(type-declaration 0-*))
`(make-compilation-unit
:package ,package
:import-declarations (list ,@import-declarations)
:type-declarations (list ,@type-declarations) )))
;;; my last bad attempt !
(defmacro types-match-bind ((&key vars expr pattern) . body )
;; code will lie here when the parameters parsing will be ok.
(list vars expr pattern body) ; just to check the parameters.
)
__________________________________________
Christophe Turle.
(format nil ···@~S.~S" 'cturle 'free 'fr)
"ctu" <······@nospam.com> writes:
> Hi all,
>
> I have some troubles defining the parameters of my 'types-match-bind'.
> The problem is that keywords parameters are handle at the end, so i can't
> have a "body" after them. I was first searching for a solution using the
> macro destructuring facility, but i'm afraid it's not possible. some ideas ?
>
> (defmacro compilation-unit (&rest args)
> (types-match-bind :vars (package import-declarations
> type-declarations)
> :expr args
> :pattern ((package 0-1) (import-declaration 0-*)
> (type-declaration 0-*))
> `(make-compilation-unit
> :package ,package
> :import-declarations (list ,@import-declarations)
> :type-declarations (list ,@type-declarations) )))
>
>
> ;;; my last bad attempt !
> (defmacro types-match-bind ((&key vars expr pattern) . body )
> ;; code will lie here when the parameters parsing will be ok.
> (list vars expr pattern body) ; just to check the parameters.
> )
Almost. Remove the dot and use &body!
(defmacro types-match-bind ((&key vars expr pattern) &body body )
;; code will lie here when the parameters parsing will be ok.
(list vars expr pattern body)) ; just to check the parameters.
But do you really need the keywords? Ie. are all of vars, expr and
pattern optional?
(defmacro types-match-bind ((vars expr pattern) &body body)
;; code will lie here when the parameters parsing will be ok.
(list vars expr pattern body))
CL-USER> (macroexpand-1 '(types-match-bind (my-var (+ an expr ession)
"reg/*/exp")
(print my-var)(terpri)))
==> (MY-VAR (+ AN EXPR ESSION) "reg/*/exp" ((PRINT MY-VAR) (TERPRI)))
--
__Pascal Bourguignon__ http://www.informatimago.com/
Our enemies are innovative and resourceful, and so are we. They never
stop thinking about new ways to harm our country and our people, and
neither do we.
Pascal Bourguignon wrote:
> "ctu" <······@nospam.com> writes:
> >
> > ;;; my last bad attempt !
> > (defmacro types-match-bind ((&key vars expr pattern) . body )
> > ;; code will lie here when the parameters parsing will be ok.
> > (list vars expr pattern body) ; just to check the parameters.
> > )
>
> Almost. Remove the dot and use &body!
>
I've always wondered what the . does in a declaration. I've always
gathered that it is a synonym for &body, but I guess not?
Jeff
"Jeff" <···@nospam.insightbb.com> writes:
> Pascal Bourguignon wrote:
>
> > "ctu" <······@nospam.com> writes:
>
> > >
> > > ;;; my last bad attempt !
> > > (defmacro types-match-bind ((&key vars expr pattern) . body )
> > > ;; code will lie here when the parameters parsing will be ok.
> > > (list vars expr pattern body) ; just to check the parameters.
> > > )
> >
> > Almost. Remove the dot and use &body!
> >
>
> I've always wondered what the . does in a declaration. I've always
> gathered that it is a synonym for &body, but I guess not?
Errr, yes, it's equivalent.
I don't know what's bad with ctu's last attempt:
CL-USER> (defmacro types-match-bind ((&key vars expr pattern) . body )
;; code will lie here when the parameters parsing will be ok.
(list vars expr pattern body) ; just to check the parameters.
)
TYPES-MATCH-BIND
CL-USER> (macroexpand-1 '(types-match-bind (:vars :v :expr :e :pattern :p) :b1 :b2))
(:V :E :P (:B1 :B2))
T
--
__Pascal Bourguignon__ http://www.informatimago.com/
Our enemies are innovative and resourceful, and so are we. They never
stop thinking about new ways to harm our country and our people, and
neither do we.
Pascal Bourguignon wrote:
> "Jeff" <···@nospam.insightbb.com> writes:
>
>
>>Pascal Bourguignon wrote:
>>
>>
>>>"ctu" <······@nospam.com> writes:
>>
>>>>;;; my last bad attempt !
>>>>(defmacro types-match-bind ((&key vars expr pattern) . body )
>>>> ;; code will lie here when the parameters parsing will be ok.
>>>> (list vars expr pattern body) ; just to check the parameters.
>>>>)
>>>
>>>Almost. Remove the dot and use &body!
>>>
>>
>>I've always wondered what the . does in a declaration. I've always
>>gathered that it is a synonym for &body, but I guess not?
>
>
> Errr, yes, it's equivalent.
>
> I don't know what's bad with ctu's last attempt:
>
> CL-USER> (defmacro types-match-bind ((&key vars expr pattern) . body )
> ;; code will lie here when the parameters parsing will be ok.
> (list vars expr pattern body) ; just to check the parameters.
> )
> TYPES-MATCH-BIND
> CL-USER> (macroexpand-1 '(types-match-bind (:vars :v :expr :e :pattern :p) :b1 :b2))
> (:V :E :P (:B1 :B2))
> T
>
it was not exactly what i was looking for, it was without the parenthesis around the keywords :
(macroexpand-1 '(types-match-bind :vars :v
:expr :e
:pattern :p
(foo)
(bar) ))
>(defmacro compilation-unit (&rest args)
> (types-match-bind :vars (package import-declarations type-declarations)
> :expr args
> :pattern ((package 0-1) (import-declaration 0-*) (type-declaration 0-*))
> `(make-compilation-unit
> :package ,package
> :import-declarations (list ,@import-declarations)
> :type-declarations (list ,@type-declarations) )))
ctu.
Christophe Turle <······@nospam.fr> writes:
> it was not exactly what i was looking for, it was without the
> parenthesis around the keywords :
>
> (macroexpand-1 '(types-match-bind :vars :v
> :expr :e
> :pattern :p
> (foo)
> (bar) ))
not that i actually think it's a good idea to use this for normal
macros/functions, (it breaks a fundamental characteristic of parameter
parsing) but if you're building a dsl it's great.
(attribute-bind (&attribute vars expr pattern &body body)
'(:vars v :expr e :pattern p (foo) (bar))
(values vars expr pattern body))
==>
v
e
p
((foo) (bar))
you'd use it in a macro like so:
(defmacro whatever (&rest args)
(attribute-bind (...) args
...))
the code:
------------------------------------------------------------------------
(defmacro attribute-bind (attribute-spec list &body body)
"Evaluate BODY with the values in LIST bound according to ATTRIBUTE-SPEC.
ATTRIBUTE-SPEC has the following form:
( required-args* [ &attribute attributes* ]
[ &allow-other-attributes others ]
[ &body body ] )
the symbols in REQUIRED-ARGS will be positionaly bound to the
values in LIST. After the required args have been consumed any
keyword value pairs will be consumed and bound to the
corresponding attributes (binding form is just like &key in
regular lambda lists, but only keyword symbols are allowed).
if &allow-other-attributes is present than OTHERS will be bound
to a list containing all the attributes in LIST which don't
have a corresponding &attribute variable.
if &body is present then BODY will be bound to anything
remaining in LIST after attribute parsing is complete."
(destructuring-bind (locals attrs flags allow-other-attributes body-var)
(parse-attribute-spec attribute-spec)
(let ((list-sym (gensym))
(element-sym (gensym)))
`(let ,(remove-if #'null (append locals
attrs
flags
(list allow-other-attributes)
(list body-var)
(list (list list-sym list))))
,(when body-var
`(declare (ignorable ,body-var)))
,@(loop
for local in locals
collect `(setf ,local (pop ,list-sym)))
(iterate
(while (and (consp ,list-sym)
(keywordp (car ,list-sym))))
(let ((,element-sym (pop ,list-sym)))
(case ,element-sym
,@(loop
for attr in attrs
;; NB: ATTR is (symbol-to-bind-to default-value),
;; we want to match against the keyword whose
;; string name is (symbol-name symbol-to-bind-to),
;; hence the intern.
collect `(,(intern (string (car attr)) :keyword)
(setf ,(car attr) (pop ,list-sym))))
,@(loop
for flag in flags
collect `(,(intern (string flag) :keyword) (setf ,flag t)))
(t
,(if allow-other-attributes
`(progn
(push ,element-sym ,allow-other-attributes)
(push (pop ,list-sym) ,allow-other-attributes))
`(error "Unrecognized attribute ~S in ~S" ,element-sym ,list-sym))))))
,(when (null body-var)
`(when ,list-sym
(warn "Ignoring extra elements in body: ~S" ,list-sym)))
,(when body-var
`(setf ,body-var ,list-sym))
,(when allow-other-attributes
`(setf ,allow-other-attributes (nreverse ,allow-other-attributes)))
,@(if (and (consp body)
(consp (car body))
(eql 'declare (car (car body))))
`((locally ,@body))
body)))))
(defun parse-attribute-spec (attribute-spec)
"Parse an attribute spec into required args, attribute args,
other args and the body arg."
(let* ((required '())
(attrs '())
(flags '())
(body-var nil)
(allow-other-attributes nil)
(put (lambda (item)
(push item required))))
(dolist (attr attribute-spec)
;; the #'string= tom-follery (god i love that word) is so that
;; the & symbols can be read in from any package. we're kinda
;; faking keywords...
(if (symbolp attr)
(cond
((string= attr '&attribute)
(setf put (lambda (item)
(if (listp item)
(case (length item)
(1 (push (list (first item) nil) attrs))
(2 (push item attrs))
(t (error "Bad &attribute spec: ~S" item)))
(push (list item nil) attrs)))))
((string= attr '&flag)
(setf put (lambda (item)
(push item flags))))
((string= attr '&body)
(setf put (lambda (item)
(setf body-var item))))
((string= attr '&allow-other-attributes)
(setf put (lambda (item)
(setf allow-other-attributes item))))
(t (funcall put attr)))
(funcall put attr)))
(list (nreverse required) (nreverse attrs) (nreverse flags) allow-other-attributes body-var)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Copyright (c) 2002-2004, Edward Marco Baringer
;;;; All rights reserved.
;;;;
;;;; Redistribution and use in source and binary forms, with or without
;;;; modification, are permitted provided that the following conditions are
;;;; met:
;;;;
;;;; - Redistributions of source code must retain the above copyright
;;;; notice, this list of conditions and the following disclaimer.
;;;;
;;;; - Redistributions in binary form must reproduce the above copyright
;;;; notice, this list of conditions and the following disclaimer in the
;;;; documentation and/or other materials provided with the distribution.
;;;;
;;;; - Neither the name of Edward Marco Baringer, nor BESE, nor the names
;;;; of its contributors may be used to endorse or promote products
;;;; derived from this software without specific prior written permission.
;;;;
;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
------------------------------------------------------------------------
--
-Marco
Ring the bells that still can ring.
Forget your perfect offering.
There is a crack in everything.
That's how the light gets in.
-Leonard Cohen
Marco Baringer wrote:
> Christophe Turle <······@nospam.fr> writes:
>
>
>>it was not exactly what i was looking for, it was without the
>>parenthesis around the keywords :
>>
>>(macroexpand-1 '(types-match-bind :vars :v
>> :expr :e
>> :pattern :p
>> (foo)
>> (bar) ))
>
>
> not that i actually think it's a good idea to use this for normal
> macros/functions, (it breaks a fundamental characteristic of parameter
> parsing) but if you're building a dsl it's great.
I don't see why it is bad to use it in normal macros/functions when it adds clarity.
> (attribute-bind (&attribute vars expr pattern &body body)
> '(:vars v :expr e :pattern p (foo) (bar))
> (values vars expr pattern body))
> ==>
> v
> e
> p
> ((foo) (bar))
>
> you'd use it in a macro like so:
>
> (defmacro whatever (&rest args)
> (attribute-bind (...) args
> ...))
so to use it more transparently :
;;; better to define a shadowing defmacro in an other user-package.
(defmacro defmacro1 (name lambda-list . body )
(if (body-after-keys lambda-list)
`(defmacro ,name (&rest args)
(attribute-bind ,(substitute '&attribute '&key lambda-list) args
,@body ))
`(defmacro ,name ,lambda-list ,@body ) ))
;;; helper perhaps better as inner function of defmacro1 ...
;;; not all cases are handled for sure but i don't care for now.
(defun body-after-keys (lambda-list)
(member '&body (member '&key lambda-list :test #'string=) :test #'string=) )
;;; now we can define macros with body at the end !
(defmacro1 types-match-bind (&key vars expr pattern &body body)
`(list ',vars ',expr ',pattern ',body) )
> the code:
>
> ------------------------------------------------------------------------
>
> (defmacro attribute-bind (attribute-spec list &body body)
> "Evaluate BODY with the values in LIST bound according to ATTRIBUTE-SPEC.
>
> ATTRIBUTE-SPEC has the following form:
>
> ( required-args* [ &attribute attributes* ]
> [ &allow-other-attributes others ]
> [ &body body ] )
>
> the symbols in REQUIRED-ARGS will be positionaly bound to the
> values in LIST. After the required args have been consumed any
> keyword value pairs will be consumed and bound to the
> corresponding attributes (binding form is just like &key in
> regular lambda lists, but only keyword symbols are allowed).
>
> if &allow-other-attributes is present than OTHERS will be bound
> to a list containing all the attributes in LIST which don't
> have a corresponding &attribute variable.
>
> if &body is present then BODY will be bound to anything
> remaining in LIST after attribute parsing is complete."
> (destructuring-bind (locals attrs flags allow-other-attributes body-var)
> (parse-attribute-spec attribute-spec)
> (let ((list-sym (gensym))
> (element-sym (gensym)))
> `(let ,(remove-if #'null (append locals
> attrs
> flags
> (list allow-other-attributes)
> (list body-var)
> (list (list list-sym list))))
> ,(when body-var
> `(declare (ignorable ,body-var)))
> ,@(loop
> for local in locals
> collect `(setf ,local (pop ,list-sym)))
-------------------------------------------------------------
> (iterate
> (while (and (consp ,list-sym)
> (keywordp (car ,list-sym))))
> (let ((,element-sym (pop ,list-sym)))
-------------------------------------------------------------
to be cl compliant replace above by =>
-------------------------------------------------------------
(loop while (and (consp ,list-sym)
(keywordp (car ,list-sym)))
do (let ((,element-sym (pop ,list-sym)))
-------------------------------------------------------------
> (case ,element-sym
> ,@(loop
> for attr in attrs
> ;; NB: ATTR is (symbol-to-bind-to default-value),
> ;; we want to match against the keyword whose
> ;; string name is (symbol-name symbol-to-bind-to),
> ;; hence the intern.
> collect `(,(intern (string (car attr)) :keyword)
> (setf ,(car attr) (pop ,list-sym))))
> ,@(loop
> for flag in flags
> collect `(,(intern (string flag) :keyword) (setf ,flag t)))
> (t
> ,(if allow-other-attributes
> `(progn
> (push ,element-sym ,allow-other-attributes)
> (push (pop ,list-sym) ,allow-other-attributes))
> `(error "Unrecognized attribute ~S in ~S" ,element-sym ,list-sym))))))
> ,(when (null body-var)
> `(when ,list-sym
> (warn "Ignoring extra elements in body: ~S" ,list-sym)))
> ,(when body-var
> `(setf ,body-var ,list-sym))
> ,(when allow-other-attributes
> `(setf ,allow-other-attributes (nreverse ,allow-other-attributes)))
> ,@(if (and (consp body)
> (consp (car body))
> (eql 'declare (car (car body))))
> `((locally ,@body))
> body)))))
>
In article <············@amma.irisa.fr>,
Christophe Turle <······@nospam.fr> wrote:
> it was not exactly what i was looking for, it was without the parenthesis
> around the keywords :
>
> (macroexpand-1 '(types-match-bind :vars :v
> :expr :e
> :pattern :p
> (foo)
> (bar) ))
CL's built-in parameter parser doesn't support this syntax. Once it
starts processing keyword/value pairs, the rest of the form at that
level has to have that pattern. Otherwise, the parser doesn't know when
it's done processing keywords and should switch to the &REST list.
This is why macros with bodies always have the keyword options in a
sublist -- the parser knows to stop when it reaches the end of that list
level.
--
Barry Margolin, ······@alum.mit.edu
Arlington, MA
*** PLEASE post questions in newsgroups, not directly to me ***
Pascal Bourguignon wrote:
> "ctu" <······@nospam.com> writes:
>
>
>>Hi all,
>>
>>I have some troubles defining the parameters of my 'types-match-bind'.
>>The problem is that keywords parameters are handle at the end, so i can't
>>have a "body" after them. I was first searching for a solution using the
>>macro destructuring facility, but i'm afraid it's not possible. some ideas ?
>>
>>(defmacro compilation-unit (&rest args)
>> (types-match-bind :vars (package import-declarations
>>type-declarations)
>> :expr args
>> :pattern ((package 0-1) (import-declaration 0-*)
>>(type-declaration 0-*))
>> `(make-compilation-unit
>> :package ,package
>> :import-declarations (list ,@import-declarations)
>> :type-declarations (list ,@type-declarations) )))
>>
>>
>>;;; my last bad attempt !
>>(defmacro types-match-bind ((&key vars expr pattern) . body )
>> ;; code will lie here when the parameters parsing will be ok.
>> (list vars expr pattern body) ; just to check the parameters.
>>)
>
>
> Almost. Remove the dot and use &body!
>
> (defmacro types-match-bind ((&key vars expr pattern) &body body )
> ;; code will lie here when the parameters parsing will be ok.
> (list vars expr pattern body)) ; just to check the parameters.
>
>
> But do you really need the keywords? Ie. are all of vars, expr and
> pattern optional?
They are not optional, but i find that keywords give at one glance the semantics of a function/macro.
> (defmacro types-match-bind ((vars expr pattern) &body body)
> ;; code will lie here when the parameters parsing will be ok.
> (list vars expr pattern body))
>
> CL-USER> (macroexpand-1 '(types-match-bind (my-var (+ an expr ession)
> "reg/*/exp")
> (print my-var)(terpri)))
>
> ==> (MY-VAR (+ AN EXPR ESSION) "reg/*/exp" ((PRINT MY-VAR) (TERPRI)))
>
>
ctu.