Hi
Half a year ago Peter Seibel posted macro WITH-TIME in comp.lang.lisp
(http://groups-beta.google.com/group/comp.lang.lisp/browse_frm/thread/56b18e1d21e29d92)
I modified it slightly and was quite happy with it till I found that I
sometimes need something like
(with-time (year month) *utime*
(setq year (read) month (read)))
and having *utime* changed properly (only the year, month parts of the
universal time must be changed, all others must remain as they were).
I modified the original macro to achieve that:
(defmacro with-time-place ((&rest args) place &body body)
(labels ((part-name (spec)
(if (symbolp spec) spec (second spec)))
(var-name (spec)
(if (symbolp spec) spec (first spec)))
(find-var (name)
(or (var-name (find name args :key #'part-name))
(gensym))))
(let ((vars (mapcar #'find-var
'(second minute hour date month year day
daylight-p zone))))
`(multiple-value-bind ,vars (decode-universal-time ,place)
(declare (ignorable ,@vars))
(unwind-protect
(progn ,@body)
(setf ,place
(encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars))))))))
Unfortunately, I can't call it like this
(with-time-place (year month) (get-universal-time) ...)
What is worse I don't know how to distinguish 'place' (something that
has setf function) from 'not place' (like (get-universal-time)).
If I knew how to scan BODY in this macro and determine if it has SETQ
forms for variables in interest I could use that as a
'distinguisher'. But about that I know even less. Would you tell me
how to solve this except of course having two almost identical macros ?
Thanks in advance
--
Vladimir Zolotykh
"Vladimir Zolotykh" <······@eurocom.od.ua> writes:
> Hi
>
> Half a year ago Peter Seibel posted macro WITH-TIME in comp.lang.lisp
> (http://groups-beta.google.com/group/comp.lang.lisp/browse_frm/thread/56b18e1d21e29d92)
>
> I modified it slightly and was quite happy with it till I found that I
> sometimes need something like
>
> (with-time (year month) *utime*
> (setq year (read) month (read)))
>
> and having *utime* changed properly (only the year, month parts of the
> universal time must be changed, all others must remain as they were).
>
> I modified the original macro to achieve that:
>
> (defmacro with-time-place ((&rest args) place &body body)
> (labels ((part-name (spec)
> (if (symbolp spec) spec (second spec)))
> (var-name (spec)
> (if (symbolp spec) spec (first spec)))
> (find-var (name)
> (or (var-name (find name args :key #'part-name))
> (gensym))))
> (let ((vars (mapcar #'find-var
> '(second minute hour date month year day
> daylight-p zone))))
> `(multiple-value-bind ,vars (decode-universal-time ,place)
> (declare (ignorable ,@vars))
> (unwind-protect
> (progn ,@body)
> (setf ,place
> (encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars))))))))
>
> Unfortunately, I can't call it like this
>
> (with-time-place (year month) (get-universal-time) ...)
>
> What is worse I don't know how to distinguish 'place' (something that
> has setf function) from 'not place' (like (get-universal-time)).
>
> If I knew how to scan BODY in this macro and determine if it has SETQ
> forms for variables in interest I could use that as a
> 'distinguisher'. But about that I know even less. Would you tell me
> how to solve this except of course having two almost identical macros ?
You could use GET-SETF-EXPANSION, but you'd need to use it at run-time:
(defmacro with-time-place ((&rest args) place &body body)
(labels ((part-name (spec)
(if (symbolp spec) spec (second spec)))
(var-name (spec)
(if (symbolp spec) spec (first spec)))
(find-var (name)
(or (var-name (find name args :key #'part-name))
(gensym))))
(let ((vars (mapcar #'find-var
'(second minute hour date month year day
daylight-p zone))))
`(multiple-value-bind ,vars (decode-universal-time ,place)
(declare (ignorable ,@vars))
(unwind-protect
(progn ,@body)
(handler-case
(progn (get-setf-expansion ,place)
(setf ,place
(encode-universal-time ,@(subseq vars 0 6)
,(nth 8 vars))))
(error ())))))))
--
__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. -- Georges W. Bush
Pascal Bourguignon <···@informatimago.com> writes:
> "Vladimir Zolotykh" <······@eurocom.od.ua> writes:
>
>> Hi
>>
>> Half a year ago Peter Seibel posted macro WITH-TIME in comp.lang.lisp
>> (http://groups-beta.google.com/group/comp.lang.lisp/browse_frm/thread/56b18e1d21e29d92)
>>
>> I modified it slightly and was quite happy with it till I found that I
>> sometimes need something like
>>
>> (with-time (year month) *utime*
>> (setq year (read) month (read)))
>>
>> and having *utime* changed properly (only the year, month parts of the
>> universal time must be changed, all others must remain as they were).
>>
>> I modified the original macro to achieve that:
>>
>> (defmacro with-time-place ((&rest args) place &body body)
>> (labels ((part-name (spec)
>> (if (symbolp spec) spec (second spec)))
>> (var-name (spec)
>> (if (symbolp spec) spec (first spec)))
>> (find-var (name)
>> (or (var-name (find name args :key #'part-name))
>> (gensym))))
>> (let ((vars (mapcar #'find-var
>> '(second minute hour date month year day
>> daylight-p zone))))
>> `(multiple-value-bind ,vars (decode-universal-time ,place)
>> (declare (ignorable ,@vars))
>> (unwind-protect
>> (progn ,@body)
>> (setf ,place
>> (encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars))))))))
>>
>> Unfortunately, I can't call it like this
>>
>> (with-time-place (year month) (get-universal-time) ...)
>>
>> What is worse I don't know how to distinguish 'place' (something that
>> has setf function) from 'not place' (like (get-universal-time)).
>>
>> If I knew how to scan BODY in this macro and determine if it has SETQ
>> forms for variables in interest I could use that as a
>> 'distinguisher'. But about that I know even less. Would you tell me
>> how to solve this except of course having two almost identical macros ?
>
> You could use GET-SETF-EXPANSION, but you'd need to use it at run-time:
>
> (defmacro with-time-place ((&rest args) place &body body)
> (labels ((part-name (spec)
> (if (symbolp spec) spec (second spec)))
> (var-name (spec)
> (if (symbolp spec) spec (first spec)))
> (find-var (name)
> (or (var-name (find name args :key #'part-name))
> (gensym))))
> (let ((vars (mapcar #'find-var
> '(second minute hour date month year day
> daylight-p zone))))
> `(multiple-value-bind ,vars (decode-universal-time ,place)
> (declare (ignorable ,@vars))
> (unwind-protect
> (progn ,@body)
> (handler-case
> (progn (get-setf-expansion ,place)
> (setf ,place
> (encode-universal-time ,@(subseq vars 0 6)
> ,(nth 8 vars))))
> (error ())))))))
>
What does that do except compute and throw away the setf expansion?
(Note the not o the GET-SETF-EXPANSION dictionary entry:
Any compound form is a valid place, since any compound form whose
operator f has no setf expander are expanded into a call to (setf
f).
-Peter
--
Peter Seibel * ·····@gigamonkeys.com
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/
Peter Seibel <·····@gigamonkeys.com> writes:
>> You could use GET-SETF-EXPANSION, but you'd need to use it at run-time:
> [...]
> What does that do except compute and throw away the setf expansion?
Nothing, remove the (get-setf-expansion ,place), it's a remnant of editing.
It seems I send that message with too much or too little in it ;-) Sorry.
--
__Pascal Bourguignon__ http://www.informatimago.com/
You never feed me.
Perhaps I'll sleep on your face.
That will sure show you.
In article <················@algow.eurocom.od.ua>,
"Vladimir Zolotykh" <······@eurocom.od.ua> wrote:
> Unfortunately, I can't call it like this
>
> (with-time-place (year month) (get-universal-time) ...)
>
> What is worse I don't know how to distinguish 'place' (something that
> has setf function) from 'not place' (like (get-universal-time)).
Why do you need to do this? Your macro should only be used with a
SETF'able place. The above code is no more valid than
(setf (get-universal-time) ...)
would be, and an error is appropriate. When not using a place, they
should use WITH-TIME rather than WITH-TIME-PLACE.
--
Barry Margolin, ······@alum.mit.edu
Arlington, MA
*** PLEASE post questions in newsgroups, not directly to me ***
On Fri, 17 Jun 2005 20:15:18 -0400, Barry Margolin <······@alum.mit.edu>
wrote:
> Why do you need to do this?
Because I don't like the idea of having two almost identical macros. The
only part
in which they differ is
(unwind-protect
(progn ,@body)
(setf ,place (encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars)))
it is from with-time-place, while with-time instead of that code has just
the following
,@body
Here is the with-time
(defmacro with-time ((&rest args) utc &body body)
(labels ((part-name (spec)
(if (symbolp spec) spec (second spec)))
(var-name (spec)
(if (symbolp spec) spec (first spec)))
(find-var (name)
(or (var-name (find name args :key #'part-name))
(gensym))))
(let ((vars (mapcar #'find-var
'(second minute hour date month year day
daylight-p zone))))
`(multiple-value-bind ,vars (decode-universal-time ,utc)
(declare (ignorable ,@vars))
,@body))))
To get with-time-macro it is enough to just substitude ,@body with
(uniwind-protect ...)
I don't know how to get rid of this annoying duplication.
--
Vladimir Zolotykh
On Sat, 18 Jun 2005 13:16:51 +0300, Vladimir Zolotykh
<······@eurocom.od.ua> wrote:
> I don't know how to get rid of this annoying duplication.
I think the best solution in this case would be to express with-time-place
in terms of with-time,
simply speaking with-time-place somehow calls with-time. Unfortunately,
with-time-place
needs the vars variable from within the with-time. I don't know how to
achive that.
--
Vladimir Zolotykh
In article <················@algow.eurocom.od.ua>,
"Vladimir Zolotykh" <······@eurocom.od.ua> wrote:
> On Fri, 17 Jun 2005 20:15:18 -0400, Barry Margolin <······@alum.mit.edu>
> wrote:
>
> > Why do you need to do this?
>
> Because I don't like the idea of having two almost identical macros. The
> only part
> in which they differ is
>
> (unwind-protect
> (progn ,@body)
> (setf ,place (encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars)))
>
> it is from with-time-place, while with-time instead of that code has just
> the following
>
> ,@body
How about a single macro with a parameter that indicates whether they
want to update the place. After all, even if the place is updatable,
maybe the caller doesn't want it to be modified. So something like:
(defmacro with-time ((&key update-p) (&rest args) utc) &body body)
...
(unwind-protect
(progn ,@body)
,(when update-p
`(setf ,utc ...))))
--
Barry Margolin, ······@alum.mit.edu
Arlington, MA
*** PLEASE post questions in newsgroups, not directly to me ***
"Vladimir Zolotykh" <······@eurocom.od.ua> writes:
> On Fri, 17 Jun 2005 20:15:18 -0400, Barry Margolin
> <······@alum.mit.edu> wrote:
>
>> Why do you need to do this?
>
> Because I don't like the idea of having two almost identical
> macros. The only part
> in which they differ is
>
> (unwind-protect
> (progn ,@body)
> (setf ,place (encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars)))
>
> it is from with-time-place, while with-time instead of that code has
> just the following
>
> ,@body
>
> Here is the with-time
>
> (defmacro with-time ((&rest args) utc &body body)
> (labels ((part-name (spec)
> (if (symbolp spec) spec (second spec)))
> (var-name (spec)
> (if (symbolp spec) spec (first spec)))
> (find-var (name)
> (or (var-name (find name args :key #'part-name))
> (gensym))))
> (let ((vars (mapcar #'find-var
> '(second minute hour date month year day
> daylight-p zone))))
> `(multiple-value-bind ,vars (decode-universal-time ,utc)
> (declare (ignorable ,@vars))
> ,@body))))
>
> To get with-time-macro it is enough to just substitude ,@body with
> (uniwind-protect ...)
>
> I don't know how to get rid of this annoying duplication.
Macros are functions. Don't you kow how to factor code in two functions?
(defmacro with-time ((&rest args) value &body body)
(generate-time-code args :value value body))
(defmacro with-time-place ((&rest args) place &body body)
(generate-time-code args :place place body))
;; rot13'ed wrong solution of the exercise:
(qrsha trarengr-gvzr-pbqr (netf xvaq bowrpg obql)
(ynoryf ((cneg-anzr (fcrp)
(vs (flzobyc fcrp) fcrp (frpbaq fcrp)))
(ine-anzr (fcrp)
(vs (flzobyc fcrp) fcrp (svefg fcrp)))
(svaq-ine (anzr)
(be (ine-anzr (svaq anzr netf :xrl #'cneg-anzr))
(traflz))))
(yrg ((inef (zncpne #'svaq-ine
'(frpbaq zvahgr ubhe qngr zbagu lrne qnl
qnlyvtug-c mbar))))
`(zhygvcyr-inyhr-ovaq ,inef (qrpbqr-havirefny-gvzr ,bowrpg)
(qrpyner (vtabenoyr ,@inef))
,(vs (rd :cynpr xvaq)
`(hajvaq-cebgrpg
(cebta ,@obql)
(frgs ,bowrpg (rapbqr-havirefny-gvzr ,@(fhofrd inef 0 6)
,(agu 8 inef))))
`(cebta ,@obql))))))
But actually, this simple solution is wrong, because the place is
evaluated several times. For example try:
(let ((times (make-array '(10) :element-type '(integer 0) :initial-element 0))
(i 0))
(with-time-place (hour) (aref times (incf i)) (incf hour))
(print times))
--> #(0 0 3600 0 0 0 0 0 0 0)
If you try to make it right, you'll see that you've got bad bases.
If you have a encode-universal-time in such a lexical scope,
then you must have a corresponding decode-universal-time.
Or if you don't want to have the decode-universal-time, then you must
not keep the encode-universal-time, which can be done if you write a
defsetf-er for encoded universal times.
;; rot13'ed right solution of the exercise:
(qrsha trarengr-gvzr-pbqr (inef xvaq bowrpg obql)
(ynoryf ((cneg-anzr (fcrp)
(vs (flzobyc fcrp) fcrp (frpbaq fcrp)))
(ine-anzr (fcrp)
(vs (flzobyc fcrp) fcrp (svefg fcrp)))
(svaq-ine (anzr)
(be (ine-anzr (svaq anzr inef :xrl #'cneg-anzr))
(traflz))))
(yrg ((inef (zncpne #'svaq-ine
'(frpbaq zvahgr ubhe qngr zbagu lrne qnl
qnlyvtug-c mbar))))
(vs (rd :cynpr xvaq)
(zhygvcyr-inyhr-ovaq (qhzzvrf inyf arj frggre trggre)
(trg-frgs-rkcnafvba bowrpg)
`(yrg* (,@(zncpne (shapgvba yvfg) qhzzvrf inyf)
(,(pne arj) ,trggre))
(zhygvcyr-inyhr-ovaq ,inef (qrpbqr-havirefny-gvzr ,(pne arj))
(qrpyner (vtabenoyr ,@inef))
(hajvaq-cebgrpg
(cebta ,@obql)
(yrg ((,(pne arj) (rapbqr-havirefny-gvzr ,@(fhofrd inef 0 6)
,(agu 8 inef))))
,frggre)))))
`(zhygvcyr-inyhr-ovaq ,inef (qrpbqr-havirefny-gvzr ,bowrpg)
(qrpyner (vtabenoyr ,@inef))
(cebta ,@obql))))))
; (I'm starting to think I should encode these solutions in base64,
; rot13 lisp is too transparent...)
Now:
(let ((times (make-array '(10) :element-type '(integer 0) :initial-element 0))
(i 0))
(with-time-place (hour) (aref times (incf i)) (incf hour))
(print times))
--> #(0 3600 0 0 0 0 0 0 0 0)
and:
(with-time (hour) (get-universal-time) (print hour))
--> 21 ; now
--
__Pascal Bourguignon__ http://www.informatimago.com/
"Vladimir Zolotykh" <······@eurocom.od.ua> writes:
> Hi
>
> Half a year ago Peter Seibel posted macro WITH-TIME in comp.lang.lisp
> (http://groups-beta.google.com/group/comp.lang.lisp/browse_frm/thread/56b18e1d21e29d92)
>
> I modified it slightly and was quite happy with it till I found that I
> sometimes need something like
>
> (with-time (year month) *utime*
> (setq year (read) month (read)))
>
> and having *utime* changed properly (only the year, month parts of the
> universal time must be changed, all others must remain as they were).
>
> I modified the original macro to achieve that:
>
> (defmacro with-time-place ((&rest args) place &body body)
> (labels ((part-name (spec)
> (if (symbolp spec) spec (second spec)))
> (var-name (spec)
> (if (symbolp spec) spec (first spec)))
> (find-var (name)
> (or (var-name (find name args :key #'part-name))
> (gensym))))
> (let ((vars (mapcar #'find-var
> '(second minute hour date month year day
> daylight-p zone))))
> `(multiple-value-bind ,vars (decode-universal-time ,place)
> (declare (ignorable ,@vars))
> (unwind-protect
> (progn ,@body)
> (setf ,place
> (encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars))))))))
>
> Unfortunately, I can't call it like this
>
> (with-time-place (year month) (get-universal-time) ...)
>
> What is worse I don't know how to distinguish 'place' (something that
> has setf function) from 'not place' (like (get-universal-time)).
>
> If I knew how to scan BODY in this macro and determine if it has SETQ
> forms for variables in interest I could use that as a
> 'distinguisher'. But about that I know even less. Would you tell me
> how to solve this except of course having two almost identical macros ?
As Barry pointed out, that *should* fail because (get-universal-time)
isn't a place. There isn't--as far as I know--anyway to know at
macro-expansion time whether a given form is a place. (Indeed, it's
not clear that that's a static property--the function FOO may not be a
place when you expand a macro but if you subsequently define a
function (SETF FOO) then it is.)
So it seems the best you can do is only try to set the UTC place if
the code in the body actually sets any of the individual
parts. Something like this should do the trick:
(defmacro with-time ((&rest args) utc &body body)
(labels ((part-name (spec)
(if (symbolp spec) spec (first spec)))
(var-name (spec)
(if (symbolp spec) spec (second spec)))
(find-var (name)
(or (var-name (find name args :key #'part-name :test #'string=)) (gensym))))
(let ((parts '(second minute hour date month year day daylight-p zone)))
(let ((vars (mapcar #'find-var parts))
(copies (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) parts)))
`(multiple-value-bind ,vars (decode-universal-time ,utc)
(let ,(loop for var2 in copies for var in vars collect `(,var2 ,var))
(multiple-value-prog1
(progn ,@body)
(unless (and ,@(loop for var2 in copies for var in vars collect `(eql ,var2 ,var)))
(setf ,utc (encode-universal-time ,@(subseq vars 0 6) ,(nth 8 vars)))))))))))
Another way to do the same way which is somewhat more convoluted but
possibly does less work at runtime since most of the generated code
ought to be compiled away and it doesn't do a bunch of comparisons at
the end is this:
(defmacro with-time ((&rest args) utc &body body)
(labels ((part-name (spec)
(if (symbolp spec) spec (first spec)))
(var-name (spec)
(if (symbolp spec) spec (second spec)))
(find-var (name)
(or (var-name (find name args :key #'part-name :test #'string=)) (make-symbol (string name)))))
(let ((parts '(second minute hour date month year day daylight-p zone)))
(let ((dirty (gensym))
(vars (mapcar #'find-var parts))
(tmps (mapcar #'(lambda (x) (make-symbol (format nil "tmp-~a" x))) parts))
(fns (mapcar #'(lambda (x) (make-symbol (format nil "fn-~a" x))) parts)))
`(let ((,dirty nil))
(multiple-value-bind ,tmps (decode-universal-time ,utc)
(declare (ignoreable ,@tmps))
(flet (,@(loop for fn in fns for tmp in tmps collect `(,fn () ,tmp))
,@(loop for fn in fns for tmp in tmps collect `((setf ,fn) (new) (setf ,dirty t ,tmp new))))
(symbol-macrolet (,@(loop for var in vars for fn in fns collect `(,var (,fn))))
(multiple-value-prog1
(progn ,@body)
(when ,dirty
(setf ,utc (encode-universal-time ,@(subseq tmps 0 6) ,(nth 8 tmps)))))))))))))
Also note that I don't put the setting of the place in an
UNWIND-PROTECT because you probably don't want the place to be set
unless the whole body completes normally. For example, do you really
want this to set *utc*, even if DO-SOMETHING signals an error and some
handler invokes a restart, unwinding the stack before MONTH is set?
(with-time (year month) *utc*
(setf year (read))
(do-something)
(setf month (read)))
-Peter
--
Peter Seibel * ·····@gigamonkeys.com
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/