Commit 757cf520 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

In with-parameters, right-hand sides may use old values of parameters

In with-parameters, right-hand sides may use old values of parameters like 'let.
parent 502d6464
;; Global/local parameters to pass to functions
;; Liam Healy 2013-02-16 20:51:14HST variable-metadata.lisp
;; Time-stamp: <2013-05-31 18:12:51EDT parameters.lisp>
;; Time-stamp: <2013-09-21 18:43:45EDT parameters.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -197,18 +197,24 @@
;;; Change from previous: this uses let-style names-values.
(defmacro with-parameters ((category &rest name-values) &body body)
"Provide local scope for parameter values, and possibly bind new values."
`(let (,@(mapcar
(lambda (nm)
(if (listp nm)
(find-parameter category (first nm))
(list (find-parameter category nm) `(parameter-value ,category ,nm))))
name-values))
,(when (some 'listp name-values)
`(setf
,@(loop for nv in name-values
when (listp nv)
append (list `(parameter-value ,category ,(first nv)) (second nv)))))
,@body))
(multiple-value-bind (setvals rhs-values)
(loop for nv in name-values
for symb = (gensym "RHS")
when (listp nv)
collect (list symb (second nv)) into rhs-values
when (listp nv)
append (list `(parameter-value ,category ,(first nv)) symb) into setvals
finally (return (values setvals rhs-values)))
`(let ,rhs-values
(let (,@(mapcar
(lambda (nm)
(if (listp nm)
(find-parameter category (first nm))
(list (find-parameter category nm) `(parameter-value ,category ,nm))))
name-values))
,(when (some 'listp name-values)
`(setf ,@setvals))
,@body))))
;;;
#+(or)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment