Allow me to consider the following macro
(defmacro with-utime-parts ((&rest parts) utime &body body)
(let ((date (gensym "date"))
(month (gensym "month"))
(year (gensym "year"))
(ignore (gensym "ignore")))
`(multiple-value-bind (,ignore ,ignore ,ignore ,date ,month ,year)
(decode-universal-time ,utime)
(declare (ignore ,ignore))
(let ,(loop with var with part for p in parts
do (cond ((atom p) (setq part p var (intern (symbol-name p))))
(t (setq part (car p) var (second p))))
collect `(,var ,(ecase part
(:date date)
(:month month)
(:year year))))
,@body))))
The intention was to allow the user (myself) to write
(with-utime-parts (:year (:month m)) (get-universal-time)
(print (list year m)))
meaning that inside the macro's body he could use variables YEAR and
M.
The essence of my question is the usage of INTERN. It seems to me
rather suspicious, out of place, I used it because I don't know the
better way of converting :YEAR to YEAR. Another point which I'd like
to consult you. Do variables I introduce with LET have a package? Very
likely they don't therefore the INTERN is doubly suspicious in the
macro.
I would be grateful if you clarified this.
--
Vladimir Zolotykh
Vladimir Zolotykh <······@eurocom.od.ua> writes:
> Allow me to consider the following macro
>
> (defmacro with-utime-parts ((&rest parts) utime &body body)
> (let ((date (gensym "date"))
> (month (gensym "month"))
> (year (gensym "year"))
> (ignore (gensym "ignore")))
> `(multiple-value-bind (,ignore ,ignore ,ignore ,date ,month ,year)
> (decode-universal-time ,utime)
> (declare (ignore ,ignore))
> (let ,(loop with var with part for p in parts
> do (cond ((atom p) (setq part p var (intern (symbol-name p))))
> (t (setq part (car p) var (second p))))
> collect `(,var ,(ecase part
> (:date date)
> (:month month)
> (:year year))))
> ,@body))))
>
> The intention was to allow the user (myself) to write
>
> (with-utime-parts (:year (:month m)) (get-universal-time)
> (print (list year m)))
>
> meaning that inside the macro's body he could use variables YEAR and
> M.
>
> The essence of my question is the usage of INTERN. It seems to me
> rather suspicious, out of place, I used it because I don't know the
> better way of converting :YEAR to YEAR. Another point which I'd like
> to consult you. Do variables I introduce with LET have a package? Very
> likely they don't therefore the INTERN is doubly suspicious in the
> macro.
>
> I would be grateful if you clarified this.
The use of INTERN is necessary to get the symbols bound by LET in the
macroexpansion into the right package, that is, from the keyword
package into the user's current package.
Here's a variation that exports a set of symbols, so you don't have to
change where they're interned in the macro:
(defpackage :with-decoded-time
(:use :cl)
(:export :with-decoded-time
:second :minute :hour
:date :month :year :day
:daylight-p :zone))
(in-package :with-decoded-time)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *decoded-time-bindings*
'(second minute hour date month year day daylight-p zone)))
(defmacro with-decoded-time ((&rest bindings) time &body body)
(let ((ignored (set-difference *decoded-time-bindings* bindings)))
(assert (null (set-difference bindings *decoded-time-bindings*)))
`(multiple-value-bind ,*decoded-time-bindings*
(decode-universal-time ,time)
(declare (ignore ,@ignored))
,@body)))
Then users would do something like:
(defpackage :funk (:use :cl :with-decoded-time))
(in-package :funk)
(defun funk ()
(with-decoded-time (year month)
(get-universal-time)
(print (list year month))))
In FUNK, YEAR and MONTH are actually WITH-DECODED-TIME:YEAR and
WITH-DECODED-TIME:MONTH.
Zach
Accept my sincere gratefulness you both. I hope I understand the
question much better now. I especially noticed the usage of
set-difference. Despite me being aware of the existence of it I didn't
think of using it in this macro. The following is my insignificant
advance in the same direction. Having seen how immensely you imporoved
my first clumsy attempt I'm quite sure you can do the same with
decoded-time<.
(defmacro decoded-time< ((&rest bindings) time1 time2)
(let ((bindings1 (mapcar #'(lambda (b) `(,b ,(gensym))) bindings))
(bindings2 (mapcar #'(lambda (b) `(,b ,(gensym))) bindings)))
`(with-decoded-time (,@bindings1)
,time1
(with-decoded-time (,@bindings2)
,time2
(lexicographical< (list ,@(mapcar #'cadr bindings1))
(list ,@(mapcar #'cadr bindings2)))))))
(defun lexicographical< (list1 list2)
(cond ((null list1) (not (null list2)))
((null list2) nil)
((< (car list1) (car list2)))
((< (car list2) (car list1)) nil)
(t (lexicographical< (cdr list1) (cdr list2)))))
By the time in some future I might have collected a bunch of useful
utilites dealing with UNIVERSAL TIME with your help.
--
Vladimir Zolotykh
Vladimir Zolotykh <······@eurocom.od.ua> writes:
> Accept my sincere gratefulness you both. I hope I understand the
> question much better now. I especially noticed the usage of
> set-difference. Despite me being aware of the existence of it I didn't
> think of using it in this macro.
For what it's worth, Peter's is much nicer than mine. In particular, I
didn't think about the problem of introducing ignored bindings of
useful symbols. Peter's use of gensyms avoids this.
None of the macros so far accept an option to specify the zone in
GET-DECODED-TIME, and I've found that in practice it's pretty
important to take into account. Planet Lisp has had more than one bug
related to decoding universal times into the wrong timezone.
Zach
Zach Beane <····@xach.com> writes:
> Vladimir Zolotykh <······@eurocom.od.ua> writes:
>
>> Accept my sincere gratefulness you both. I hope I understand the
>> question much better now. I especially noticed the usage of
>> set-difference. Despite me being aware of the existence of it I didn't
>> think of using it in this macro.
>
> For what it's worth, Peter's is much nicer than mine. In particular, I
> didn't think about the problem of introducing ignored bindings of
> useful symbols. Peter's use of gensyms avoids this.
>
> None of the macros so far accept an option to specify the zone in
> GET-DECODED-TIME, and I've found that in practice it's pretty
> important to take into account. Planet Lisp has had more than one bug
> related to decoding universal times into the wrong timezone.
Okay, here's yet another version:
(defparameter *time-zones*
'(;; North America
(:nst 5/2 "Newfoundland Standard Time")
(:hnt 5/2 "Heure Normale de Terre-Neuve")
(:ndt 3/2 "Newfoundland Daylight Time")
(:hat 3/2 "Heure Avanc�e de Terre-Neuve")
(:haa -3 "Heure Avanc�e de l'Atlantique")
(:adt -3 "Atlantic Daylight Time")
(:hna -4 "Heure Normale de l'Atlantique")
(:hae -4 "Heure Avanc�e de l'Est")
(:edt -4 "Eastern Daylight Time")
(:ast -4 "Atlantic Standard Time")
(:hne -5 "Heure Normale de l'Est")
(:hac -5 "Heure Avanc�e du Centre")
(:est -5 "Eastern Standard Time")
(:cdt -5 "Central Daylight Time")
(:mdt -6 "Mountain Daylight Time")
(:hnc -6 "Heure Normale du Centre")
(:har -6 "Heure Avanc�e des Rocheuses")
(:cst -6 "Central Standard Time")
(:pdt -7 "Pacific Daylight Time")
(:mst -7 "Mountain Standard Time")
(:hnr -7 "Heure Normale des Rocheuses")
(:hap -7 "Heure Avanc�e du Pacifique")
(:pst -8 "Pacific Standard Time")
(:hnp -8 "Heure Normale du Pacifique")
(:hay -8 "Heure Avanc�e du Yukon")
(:akdt -8 "Alaska Daylight Time")
(:hny -9 "Heure Normale du Yukon")
(:hadt -9 "Hawaii-Aleutian Daylight Time")
(:akst -9 "Alaska Standard Time")
(:hast -10 "Hawaii-Aleutian Standard Time")
;; Military
(:m 12 "Mike Time Zone")
(:l 11 "Lima Time Zone")
(:k 10 "Kilo Time Zone")
(:i 9 "India Time Zone")
(:h 8 "Hotel Time Zone")
(:g 7 "Golf Time Zone")
(:f 6 "Foxtrot Time Zone")
(:e 5 "Echo Time Zone")
(:d 4 "Delta Time Zone")
(:c 3 "Charlie Time Zone")
(:b 2 "Bravo Time Zone")
(:a 1 "Alpha Time Zone")
(:z 0 "Zulu Time Zone")
(:n -1 "November Time Zone")
(:o -2 "Oscar Time Zone")
(:p -3 "Papa Time Zone")
(:q -4 "Quebec Time Zone")
(:r -5 "Romeo Time Zone")
(:s -6 "Sierra Time Zone")
(:t -7 "Tango Time Zone")
(:u -8 "Uniform Time Zone")
(:v -9 "Victor Time Zone")
(:w -10 "Whiskey Time Zone")
(:x -11 "X-ray Time Zone")
(:y -12 "Yankee Time Zone")
;; Europe
(:eest 3 "Eastern European Summer Time")
(:mesz 2 "Mitteleurop�ische Sommerzeit")
(:eet 2 "Eastern European Time")
(:cest 2 "Central European Summer Time")
(:west 1 "Western European Summer Time")
(:mez 1 "Mitteleurop�ische Zeit")
(:ist 1 "Irish Summer Time")
(:cet 1 "Central European Time")
(:bst 1 "British Summer Time")
(:wet 0 "Western European Time")
(:utc 0 "Coordinated Universal Time")
(:gmt 0 "Greenwich Mean Time")
;; Australia
(:nft 23/2 "Norfolk (Island) Time")
(:edt 11 "Eastern Daylight Time")
(:aedt 11 "Australian Eastern Daylight Time")
(:cdt 21/2 "Central Daylight Time")
(:acdt 21/2 "Australian Central Daylight Time")
(:est 10 "Eastern Standard Time")
(:aest 10 "Australian Eastern Standard Time")
(:cst 19/2 "Central Standard Time")
(:acst 19/2 "Australian Central Standard Time")
(:wst 8 "Western Standard Time")
(:awst 8 "Australian Western Standard Time")
(:cxt 7 "Christmas Island Time")))
(defmacro with-time ((&rest args) utc &body body)
(let* ((zone-cons (member '&zone args))
(zone (if zone-cons (cadr zone-cons) 0))
(args (nconc (ldiff args zone-cons) (cddr zone-cons))))
(when (find zone *time-zones* :key #'first)
(setf zone (second (find zone *time-zones* :key #'first))))
(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 ((vars (mapcar #'find-var '(second minute hour date month year day daylight-p zone))))
`(multiple-value-bind ,vars (decode-universal-time ,utc ,zone)
(declare (ignorable ,@vars))
,@body)))))
CL-USER> (with-time (hour minute second zone &zone :gmt)
(get-universal-time)
(list hour minute second zone))
(18 57 1 0)
CL-USER> (with-time (hour minute second zone)
(get-universal-time)
(list hour minute second zone))
(18 57 42 0)
CL-USER> (with-time (hour minute second zone &zone :pst)
(get-universal-time)
(list hour minute second zone))
(2 57 4 -8)
CL-USER> (with-time (hour minute second zone &zone -8)
(get-universal-time)
(list hour minute second zone))
(2 57 18 -8)
CL-USER>
-Peter
--
Peter Seibel ·····@javamonkey.com
Lisp is the red pill. -- John Fraser, comp.lang.lisp
In article <················@news.eurocom.od.ua>,
Vladimir Zolotykh <······@eurocom.od.ua> wrote:
> Accept my sincere gratefulness you both. I hope I understand the
> question much better now. I especially noticed the usage of
> set-difference.
On the one hand, your final code should make use of the many
useful functions available in Lisp. On the other hand, nothing
makes you understand them better than writing your own
code without them first.
Another example of a function that can be unexpectedly
useful appears below.
> Despite me being aware of the existence of it I didn't
> think of using it in this macro. The following is my insignificant
> advance in the same direction. Having seen how immensely you imporoved
> my first clumsy attempt I'm quite sure you can do the same with
> decoded-time<.
>
> (defun lexicographical< (list1 list2)
> (cond ((null list1) (not (null list2)))
> ((null list2) nil)
> ((< (car list1) (car list2)))
> ((< (car list2) (car list1)) nil)
> (t (lexicographical< (cdr list1) (cdr list2)))))
One of the sequence functions often overlooked is
MISMATCH. It compares two sequences, of possibly
differing lengths, and returns the position of the first
non-equal element, if any, or NIL. So it can do the looping
for you to find the first place you need to compare,
if any.
(defun lexicographical< (l1 l2)
(let ((n (mismatch l1 l2)))
(and (not (null n))
(lex< (nth n l1) (nth n l2)))))
(defun lex< (x y)
(or (null x)
(and (not (null y))
(< x y))))
Vladimir Zolotykh <······@eurocom.od.ua> writes:
> Allow me to consider the following macro
>
> (defmacro with-utime-parts ((&rest parts) utime &body body)
> (let ((date (gensym "date"))
> (month (gensym "month"))
> (year (gensym "year"))
> (ignore (gensym "ignore")))
> `(multiple-value-bind (,ignore ,ignore ,ignore ,date ,month ,year)
> (decode-universal-time ,utime)
> (declare (ignore ,ignore))
> (let ,(loop with var with part for p in parts
> do (cond ((atom p) (setq part p var (intern (symbol-name p))))
> (t (setq part (car p) var (second p))))
> collect `(,var ,(ecase part
> (:date date)
> (:month month)
> (:year year))))
> ,@body))))
>
> The intention was to allow the user (myself) to write
>
> (with-utime-parts (:year (:month m)) (get-universal-time)
> (print (list year m)))
>
> meaning that inside the macro's body he could use variables YEAR and
> M.
>
> The essence of my question is the usage of INTERN. It seems to me
> rather suspicious, out of place, I used it because I don't know the
> better way of converting :YEAR to YEAR. Another point which I'd like
> to consult you. Do variables I introduce with LET have a package? Very
> likely they don't therefore the INTERN is doubly suspicious in the
> macro.
Yes, it is suspect. You should avoid creating names this way exactly
because of the kinds of problems you're worrying about--all interned
symbols are in some package but when a macro INTERNs symbols they may
not end up in the package you expect. Better is either to require the
user of the macro to explicitly supply the names they want to use like
this:
(defmacro with-time ((&key second minute hour
date month year
day daylight-p zone) &body body)
(let ((vars (mapcar #'(lambda (x) (or x (gensym)))
(list second minute hour
date month year
day daylight-p zone))))
`(multiple-value-bind ,vars (get-decoded-time)
(declare (ignoreable ,@vars))
,@body)))
This lets you write:
(with-time (:second s :minute m :hour h)
(format t "~2,'0d:~2,'0d:~2,'0d~%" h m s))
But requires you to always provide the variables names.
If you want to provide more sugar, you could write something like this:
(defmacro with-time ((&rest args) &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)) (gensym))))
(let ((vars (mapcar #'find-var '(second minute hour date month year day daylight-p zone))))
`(multiple-value-bind ,vars (get-decoded-time)
(declare (ignoreable ,@vars))
,@body))))
Which allows you to write either this:
(with-time (second minute hour)
(format t "~2,'0d:~2,'0d:~2,'0d~%" hour minute second))
or this:
(with-time ((second s) (minute m) (hour h))
(format t "~2,'0d:~2,'0d:~2,'0d~%" h m s))
Note, however, that the names SECOND, MINUTE, HOUR, DATE, MONTH, YEAR,
DAY, DAYLIGHT-P, and ZONE are essentially part of the API of this
macro and will need to be exported from whatever package you define it
in.
-Peter
--
Peter Seibel ·····@javamonkey.com
Lisp is the red pill. -- John Fraser, comp.lang.lisp
Peter Seibel <·····@javamonkey.com> writes:
> Note, however, that the names SECOND, MINUTE, HOUR, DATE, MONTH, YEAR,
> DAY, DAYLIGHT-P, and ZONE are essentially part of the API of this
> macro and will need to be exported from whatever package you define it
> in.
The macro could also match the bindings up based on symbol-name instead
of symbol identity.
--
Rahul Jain
·····@nyct.net
Professional Software Developer, Amateur Quantum Mechanicist
Rahul Jain <·····@nyct.net> writes:
> Peter Seibel <·····@javamonkey.com> writes:
>
>> Note, however, that the names SECOND, MINUTE, HOUR, DATE, MONTH, YEAR,
>> DAY, DAYLIGHT-P, and ZONE are essentially part of the API of this
>> macro and will need to be exported from whatever package you define it
>> in.
>
> The macro could also match the bindings up based on symbol-name
> instead of symbol identity.
That's a good point. For the OP, that just means changing:
(find name args :key #'part-name)
to
(find name args :key #'part-name :test #'string=)
-Peter
--
Peter Seibel ·····@javamonkey.com
Lisp is the red pill. -- John Fraser, comp.lang.lisp