steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

calendar refactoring

release
erg 2006-07-25 11:36:46 +00:00
parent 9031ba9f63
commit 35780c90fc
2 changed files with 158 additions and 216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

153
contrib/calendar/calendar.factor
View File

@ -6,8 +6,19 @@ IN: calendar
TUPLE: timestamp year month day hour minute second gmt-offset ; TUPLE: timestamp year month day hour minute second gmt-offset ;
TUPLE: dt year month day hour minute second ; TUPLE: dt year month day hour minute second ;
IN: calendar-internals
C: timestamp ( year month day hour minute second gmt-offset -- <timestamp> )
[ set-timestamp-gmt-offset ] keep
[ set-timestamp-second ] keep
[ set-timestamp-minute ] keep
[ set-timestamp-hour ] keep
[ set-timestamp-day ] keep
[ set-timestamp-month ] keep
[ set-timestamp-year ] keep ;
IN: calendar
SYMBOL: gmt-offset SYMBOL: gmt-offset
global [ 7 gmt-offset set ] bind 7 gmt-offset set-global
: month-names : month-names
{ {
@ -33,44 +44,18 @@ global [ 7 gmt-offset set ] bind
#! length of average month in days #! length of average month in days
30.41666666666667 ; 30.41666666666667 ;
: default-array ( seq default -- seq ) IN: kernel
#! Pad seq with values from default until they are the same length M: tuple <=> ( tuple tuple -- n )
#! useful for default parameters like: (year=1,month=1,day=1) [ tuple>array 2 over length rot <slice> >array ] 2apply <=> ;
#! { 6 } { 1 1 1 } default-array -> { 6 1 1 }
2dup [ length ] 2apply >= [
drop clone
] [
2dup [ length ] 2apply swap - over length [ swap - ] keep rot
<slice> append
] if ;
: first6 IN: calendar
#! to compile words
[ first ] keep
[ second ] keep
[ third ] keep
[ fourth ] keep
[ 4 swap nth ] keep
5 swap nth ;
: first7
#! instead of [ ] each
[ first6 ] keep 6 swap nth ;
: prepare-timestamp
#! Default parameters for timestamp, expand on stack
{ 1970 1 1 0 0 0 0 } default-array dup length 7 >
[ "make-timestamp expects an array up to length 7" throw ] when first7 ;
DEFER: >gmt
DEFER: +dt DEFER: +dt
DEFER: timestamp=
DEFER: seconds DEFER: seconds
: make-timestamp ( year month day hour minute second gmt-offset -- <timestamp> )
: make-timestamp ( seq -- timestamp ) <timestamp> [ 0 seconds +dt ] keep
#! Default to 1/1/1 0:0:0 [ <=> zero? [ "invalid timestamp" throw ] unless ] keep ;
prepare-timestamp <timestamp>
[ 0 seconds +dt ] keep
[ timestamp= [ "invalid timestamp" throw ] unless ] keep ;
SYMBOL: a SYMBOL: a
SYMBOL: b SYMBOL: b
@ -126,11 +111,6 @@ SYMBOL: m
: minutes ( n -- dt ) zero-dt [ set-dt-minute ] keep ; : minutes ( n -- dt ) zero-dt [ set-dt-minute ] keep ;
: seconds ( n -- dt ) zero-dt [ set-dt-second ] keep ; : seconds ( n -- dt ) zero-dt [ set-dt-second ] keep ;
: /mod-wrap ( f n -- q r )
#! q is positive or negative, r is positive from 0 <= r < n
[ /f floor >bignum ] 2keep
[ mod ] keep swap dup 0 < [ + ] [ nip ] if ;
: julian-day-number>timestamp ( n -- timestamp ) : julian-day-number>timestamp ( n -- timestamp )
julian-day-number>date 0 0 0 0 <timestamp> ; julian-day-number>date 0 0 0 0 <timestamp> ;
@ -141,6 +121,11 @@ GENERIC: +hour ( timestamp x -- timestamp )
GENERIC: +minute ( timestamp x -- timestamp ) GENERIC: +minute ( timestamp x -- timestamp )
GENERIC: +second ( timestamp x -- timestamp ) GENERIC: +second ( timestamp x -- timestamp )
: /mod-wrap ( f n -- q r )
#! q is positive or negative, r is positive from 0 <= r < n
[ /f floor >bignum ] 2keep
[ mod ] keep swap dup 0 < [ + ] [ nip ] if ;
: float>whole-part ( float -- int float ) : float>whole-part ( float -- int float )
[ floor >bignum ] keep dupd swap - ; [ floor >bignum ] keep dupd swap - ;
@ -159,45 +144,36 @@ GENERIC: +second ( timestamp x -- timestamp )
M: integer +year ( timestamp n -- timestamp ) M: integer +year ( timestamp n -- timestamp )
over timestamp-year + swap [ set-timestamp-year ] keep over timestamp-year + swap [ set-timestamp-year ] keep
adjust-leap-year ; adjust-leap-year ;
M: float +year ( timestamp n -- timestamp ) M: real +year ( timestamp n -- timestamp )
float>whole-part rot swap 365.2425 * +day swap +year ; >float float>whole-part rot swap 365.2425 * +day swap +year ;
M: ratio +year ( timestamp n -- timestamp ) >float +year ;
M: integer +month ( timestamp n -- timestamp ) M: integer +month ( timestamp n -- timestamp )
over timestamp-month + 12 /mod-wrap over timestamp-month + 12 /mod-wrap
dup 0 = [ drop 12 >r 1- r> ] when pick set-timestamp-month +year ; dup 0 = [ drop 12 >r 1- r> ] when pick set-timestamp-month +year ;
M: float +month ( timestamp n -- timestamp ) M: real +month ( timestamp n -- timestamp )
float>whole-part rot swap average-month * +day swap +month ; >float float>whole-part rot swap average-month * +day swap +month ;
M: ratio +month ( timestamp n -- timestamp ) >float +month ;
M: integer +day ( timestamp n -- timestamp ) M: integer +day ( timestamp n -- timestamp )
swap [ date julian-day-number + julian-day-number>timestamp ] keep swap [ date julian-day-number + julian-day-number>timestamp ] keep
swap >r time r> [ set-time ] keep ; swap >r time r> [ set-time ] keep ;
M: float +day ( timestamp n -- timestamp ) M: real +day ( timestamp n -- timestamp )
float>whole-part rot swap 24 * +hour swap +day ; >float float>whole-part rot swap 24 * +hour swap +day ;
M: ratio +day ( timestamp n -- timestamp ) >float +day ;
M: integer +hour ( timestamp n -- timestamp ) M: integer +hour ( timestamp n -- timestamp )
over timestamp-hour + 24 /mod-wrap pick set-timestamp-hour +day ; over timestamp-hour + 24 /mod-wrap pick set-timestamp-hour +day ;
M: float +hour ( timestamp n -- timestamp ) M: real +hour ( timestamp n -- timestamp )
float>whole-part rot swap 60 * +minute swap +hour ; >float float>whole-part rot swap 60 * +minute swap +hour ;
M: ratio +hour ( timestamp n -- timestamp ) >float +hour ;
M: integer +minute ( timestamp n -- timestamp ) M: integer +minute ( timestamp n -- timestamp )
over timestamp-minute + 60 /mod-wrap pick set-timestamp-minute +hour ; over timestamp-minute + 60 /mod-wrap pick set-timestamp-minute +hour ;
M: float +minute ( timestamp n -- timestamp ) M: real +minute ( timestamp n -- timestamp )
float>whole-part rot swap 60 * +second swap +minute ; >float float>whole-part rot swap 60 * +second swap +minute ;
M: ratio +minute ( timestamp n -- timestamp ) >float +minute ;
: (+second) ( timestamp n -- timestamp ) M: number +second ( timestamp n -- timestamp )
over timestamp-second + 60 /mod-wrap >r >bignum r> over timestamp-second + 60 /mod-wrap >r >bignum r>
pick set-timestamp-second +minute ; pick set-timestamp-second +minute ;
M: integer +second ( timestamp n -- timestamp ) (+second) ;
M: ratio +second ( timestamp n -- timestamp ) (+second) ;
M: float +second ( timestamp n -- timestamp ) (+second) ;
GENERIC: +dt ( obj obj -- timestamp ) : +dt ( timestamp dt -- timestamp )
: (+dt) ( timestamp dt -- timestamp )
dupd dupd
[ dt-second +second ] keep [ dt-second +second ] keep
[ dt-minute +minute ] keep [ dt-minute +minute ] keep
@ -207,13 +183,10 @@ GENERIC: +dt ( obj obj -- timestamp )
dt-year +year dt-year +year
swap timestamp-gmt-offset over set-timestamp-gmt-offset ; swap timestamp-gmt-offset over set-timestamp-gmt-offset ;
M: dt +dt ( timestamp dt -- timestamp ) (+dt) ;
M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ;
: dt>vec ( dt -- vec ) tuple>array 2 8 rot <slice> ; : dt>vec ( dt -- vec ) tuple>array 2 8 rot <slice> ;
: vec>dt ( vec -- dt ) first6 <dt> ; : vec>dt ( vec -- dt ) { dt f } swap append >tuple ;
: +dts ( dt dt -- dt ) [ dt>vec ] 2apply v+ vec>dt ; : +dts ( dt dt -- dt ) [ dt>vec ] 2apply v+ vec>dt ;
: timestamp>vec ( timestamp -- vec ) tuple>array 2 8 rot <slice> ; : timestamp>vec ( dt -- vec ) tuple>array 2 8 rot <slice> ;
: dt>years ( dt -- x ) : dt>years ( dt -- x )
dt>vec [ 1 12 365.2425 8765.82 525949.2 31556952.0 ] [ / ] 2map sum ; dt>vec [ 1 12 365.2425 8765.82 525949.2 31556952.0 ] [ / ] 2map sum ;
@ -237,14 +210,16 @@ M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ;
#! GMT time, right now #! GMT time, right now
1970 1 1 0 0 0 0 <timestamp> millis 1000 /f seconds +dt ; 1970 1 1 0 0 0 0 <timestamp> millis 1000 /f seconds +dt ;
: timestamp- ( timestamp timestamp -- dt ) [ >gmt timestamp>vec ] 2apply v- ;
: now ( -- timestamp ) gmt >local-time ; : now ( -- timestamp ) gmt >local-time ;
: before ( dt -- -dt ) dt>vec [ neg ] map vec>dt ; : before ( dt -- -dt ) dt>vec [ neg ] map vec>dt ;
: ago ( dt -- timestamp ) before now +dt ; : from-now ( dt -- timestamp ) now swap +dt ;
: from-now ( dt -- timestamp ) now +dt ; : ago ( dt -- timestamp ) before from-now ;
: days-in-year ( year -- n ) leap-year? 366 365 ? ; : days-in-year ( year -- n ) leap-year? 366 365 ? ;
: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; : day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ;
: days-in-month ( year month -- ) : days-in-month ( year month -- n )
swap leap-year? [ swap leap-year? [
[ day-counts nth ] keep 2 = [ 1+ ] when [ day-counts nth ] keep 2 = [ 1+ ] when
] [ ] [
@ -254,49 +229,24 @@ M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ;
! Zeller Congruence ! Zeller Congruence
! http://web.textfiles.com/computers/formulas.txt ! http://web.textfiles.com/computers/formulas.txt
! good for any date since October 15, 1582 ! good for any date since October 15, 1582
: (day-of-week) ( year month day -- day-of-week ) : (day-of-week) ( year month day -- n )
>r dup 2 <= [ 12 + >r 1- r> ] when >r dup 2 <= [ 12 + >r 1- r> ] when
>r dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + r> >r dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + r>
[ 1+ 3 * 5 /i + ] keep 2 * + r> [ 1+ 3 * 5 /i + ] keep 2 * + r>
1+ + 7 mod ; 1+ + 7 mod ;
: day-of-week ( timestamp -- n ) : day-of-week ( timestamp -- n )
[ timestamp-year ] keep [ timestamp-year ] keep [ timestamp-month ] keep timestamp-day
[ timestamp-month ] keep
timestamp-day
(day-of-week) ; (day-of-week) ;
: (timestamp=) ( timestamp timestamp -- n timestamp timestamp )
[ timestamp>vec ] 2apply
[ [ = ] 2map f swap index ] 2keep ;
: timestamp= ( timestamp timestamp -- ? )
(timestamp=) 2drop -1 = ;
: timestamp> ( timestamp timestamp -- ? )
(timestamp=) >r >r dup -1 = [
r> r> 3drop f
] [
r> dupd nth r> rot swap nth >
] if ;
: timestamp>= ( timestamp timestamp -- ? )
[ timestamp> ] 2keep timestamp= or ;
: timestamp< ( timestamp timestamp -- ? )
[ timestamp> not ] 2keep timestamp= not and ;
: timestamp<= ( timestamp timestamp -- ? )
[ timestamp< ] 2keep timestamp= or ;
: day-of-year ( timestamp -- n ) : day-of-year ( timestamp -- n )
[ [
[ timestamp-year leap-year? ] keep [ timestamp-year leap-year? ] keep
dup timestamp-year 3 1 3array make-timestamp timestamp>= and 1 0 ? [ date 3array ] keep timestamp-year 3 1 3array <=> 0 >= and 1 0 ?
] keep ] keep
0 swap [ timestamp-month day-counts <slice> sum + ] keep 0 swap [ timestamp-month day-counts <slice> sum + ] keep
timestamp-day + ; timestamp-day + ;
: month>days days-in-month nth ;
: print-day ( n -- ) : print-day ( n -- )
unparse dup length 2 < [ unparse dup length 2 < [
" " write " " write
@ -305,11 +255,12 @@ M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ;
: print-month ( year month -- ) : print-month ( year month -- )
[ month-names nth write " " write unparse print ] 2keep [ month-names nth write " " write unparse print ] 2keep
[ 1 (day-of-week) ] 2keep [ 1 (day-of-week) ] 2keep
days-in-month days-in-month day-abbreviations2 " " join print
day-abbreviations2 " " join print
over [ " " write ] times over [ " " write ] times
[ [ 1+ print-day ] keep 1+ + 7 mod 0 = [ terpri ] [ " " write ] if ] each-with [
terpri ; [ 1+ print-day ] keep
1+ + 7 mod 0 = [ terpri ] [ " " write ] if
] each-with terpri ;
: print-year ( year -- ) : print-year ( year -- )
12 [ 1+ print-month terpri ] each-with ; 12 [ 1+ print-month terpri ] each-with ;

221
contrib/calendar/test/calendar.factor
View File

@ -1,16 +1,13 @@
USING: arrays calendar errors kernel test ; USING: arrays calendar errors kernel math sequences test ;
[ { 1970 1 1 0 0 0 0 } ] [ { } { 1970 1 1 0 0 0 0 } default-array ] unit-test [ "invalid timestamp" ] [ [ 2004 12 32 0 0 0 0 make-timestamp ] catch ] unit-test
[ { 2006 1 1 0 0 0 0 } ] [ { 2006 } { 1970 1 1 0 0 0 0 } default-array ] unit-test [ "invalid timestamp" ] [ [ 2004 2 30 0 0 0 0 make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ 2003 2 29 0 0 0 0 make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ 2004 12 32 3array make-timestamp ] catch ] unit-test [ "invalid timestamp" ] [ [ 2004 -2 9 0 0 0 0 make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ 2004 2 30 3array make-timestamp ] catch ] unit-test [ "invalid timestamp" ] [ [ 2004 12 0 0 0 0 0 make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ 2003 2 29 3array make-timestamp ] catch ] unit-test [ "invalid timestamp" ] [ [ 2004 12 1 24 0 0 0 make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ 2004 -2 9 3array make-timestamp ] catch ] unit-test [ "invalid timestamp" ] [ [ 2004 12 1 23 60 0 0 make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ 2004 12 0 3array make-timestamp ] catch ] unit-test [ "invalid timestamp" ] [ [ 2004 12 1 23 59 60 0 0 make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ { 2004 12 1 24 } make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ { 2004 12 1 23 60 } make-timestamp ] catch ] unit-test
[ "invalid timestamp" ] [ [ { 2004 12 1 23 59 60 } make-timestamp ] catch ] unit-test
[ f ] [ 1900 leap-year? ] unit-test [ f ] [ 1900 leap-year? ] unit-test
[ t ] [ 1904 leap-year? ] unit-test [ t ] [ 1904 leap-year? ] unit-test
@ -18,118 +15,112 @@ USING: arrays calendar errors kernel test ;
[ f ] [ 2001 leap-year? ] unit-test [ f ] [ 2001 leap-year? ] unit-test
[ f ] [ 2006 leap-year? ] unit-test [ f ] [ 2006 leap-year? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 1 seconds +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp 1 seconds +dt
2006 10 10 0 0 1 0 <timestamp> timestamp= ] unit-test 2006 10 10 0 0 1 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 100 seconds +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp 100 seconds +dt
2006 10 10 0 1 40 0 <timestamp> timestamp= ] unit-test 2006 10 10 0 1 40 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -100 seconds +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp -100 seconds +dt
2006 10 9 23 58 20 0 <timestamp> timestamp= ] unit-test 2006 10 9 23 58 20 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 86400 seconds +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp 86400 seconds +dt
2006 10 11 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 10 11 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 10 minutes +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp 10 minutes +dt
2006 10 10 0 10 0 0 <timestamp> timestamp= ] unit-test 2006 10 10 0 10 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 10.5 minutes +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp 10.5 minutes +dt
2006 10 10 0 10 30 0 <timestamp> timestamp= ] unit-test 2006 10 10 0 10 30 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 3/4 minutes +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp 3/4 minutes +dt
2006 10 10 0 0 45 0 <timestamp> timestamp= ] unit-test 2006 10 10 0 0 45 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -3/4 minutes +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp -3/4 minutes +dt
2006 10 9 23 59 15 0 <timestamp> timestamp= ] unit-test 2006 10 9 23 59 15 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 7200 minutes +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp 7200 minutes +dt
2006 10 15 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 10 15 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -10 minutes +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp -10 minutes +dt
2006 10 9 23 50 0 0 <timestamp> timestamp= ] unit-test 2006 10 9 23 50 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -100 minutes +dt [ t ] [ 2006 10 10 0 0 0 0 make-timestamp -100 minutes +dt
2006 10 9 22 20 0 0 <timestamp> timestamp= ] unit-test 2006 10 9 22 20 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 hours +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 hours +dt
2006 1 1 1 0 0 0 <timestamp> timestamp= ] unit-test 2006 1 1 1 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 24 hours +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 24 hours +dt
2006 1 2 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 1 2 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -24 hours +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -24 hours +dt
2005 12 31 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 12 31 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 12 hours +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 12 hours +dt
2006 1 1 12 0 0 0 <timestamp> timestamp= ] unit-test 2006 1 1 12 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 72 hours +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 72 hours +dt
2006 1 4 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 1 4 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 days +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 days +dt
2006 1 2 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 1 2 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -1 days +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -1 days +dt
2005 12 31 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 12 31 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 365 days +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 365 days +dt
2007 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2007 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -365 days +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -365 days +dt
2005 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2004 1 1 0 0 0 0 <timestamp> 365 days +dt [ t ] [ 2004 1 1 0 0 0 0 make-timestamp 365 days +dt
2004 12 31 0 0 0 0 <timestamp> timestamp= ] unit-test 2004 12 31 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2004 1 1 0 0 0 0 <timestamp> 366 days +dt [ t ] [ 2004 1 1 0 0 0 0 make-timestamp 366 days +dt
2005 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 11 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 11 months +dt
2006 12 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 12 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 12 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 12 months +dt
2007 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2007 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 24 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 24 months +dt
2008 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2008 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 13 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 13 months +dt
2007 2 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2007 2 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 months +dt
2006 2 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 2 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 0 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 0 months +dt
2006 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -1 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -1 months +dt
2005 12 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 12 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -2 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -2 months +dt
2005 11 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 11 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -13 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -13 months +dt
2004 12 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2004 12 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -24 months +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -24 months +dt
2004 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2004 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2004 2 29 0 0 0 0 <timestamp> 12 months +dt [ t ] [ 2004 2 29 0 0 0 0 make-timestamp 12 months +dt
2005 3 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 3 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2004 2 29 0 0 0 0 <timestamp> -12 months +dt [ t ] [ 2004 2 29 0 0 0 0 make-timestamp -12 months +dt
2003 3 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2003 3 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 0 years +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 0 years +dt
2006 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2006 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 years +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 years +dt
2007 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2007 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -1 years +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -1 years +dt
2005 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 2005 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -100 years +dt [ t ] [ 2006 1 1 0 0 0 0 make-timestamp -100 years +dt
1906 1 1 0 0 0 0 <timestamp> timestamp= ] unit-test 1906 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test
! [ t ] [ 2004 2 29 0 0 0 0 <timestamp> -1 years +dt ! [ t ] [ 2004 2 29 0 0 0 0 make-timestamp -1 years +dt
! 2003 2 28 0 0 0 0 <timestamp> timestamp= ] unit-test ! 2003 2 28 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ 5 ] [ 2006 7 14 0 0 0 0 <timestamp> day-of-week ] unit-test [ 5 ] [ 2006 7 14 0 0 0 0 make-timestamp day-of-week ] unit-test
[ f ] [ 2006 7 14 0 0 0 0 <timestamp> dup timestamp> ] unit-test [ t ] [ 2006 7 14 [ julian-day-number julian-day-number>date 0 0 0 0 make-timestamp ] 3keep 0 0 0 0 make-timestamp <=> zero? ] unit-test
[ f ] [ 2006 7 14 0 0 0 0 <timestamp> dup timestamp< ] unit-test
[ t ] [ 2006 7 14 0 0 0 0 <timestamp> dup timestamp>= ] unit-test
[ t ] [ 2006 7 14 0 0 0 0 <timestamp> dup timestamp<= ] unit-test
[ t ] [ 2006 7 14 0 0 0 0 <timestamp> dup timestamp= ] unit-test
[ t ] [ 2006 7 14 [ julian-day-number julian-day-number>date 3array make-timestamp ] 3keep 3array make-timestamp timestamp= ] unit-test [ 1 ] [ 2006 1 1 0 0 0 0 make-timestamp day-of-year ] unit-test
[ 60 ] [ 2004 2 29 0 0 0 0 make-timestamp day-of-year ] unit-test
[ 61 ] [ 2004 3 1 0 0 0 0 make-timestamp day-of-year ] unit-test
[ 366 ] [ 2004 12 31 0 0 0 0 make-timestamp day-of-year ] unit-test
[ 365 ] [ 2003 12 31 0 0 0 0 make-timestamp day-of-year ] unit-test
[ 60 ] [ 2003 3 1 0 0 0 0 make-timestamp day-of-year ] unit-test
[ 1 ] [ 2006 1 1 3array make-timestamp day-of-year ] unit-test [ t ] [ 2004 12 31 0 0 0 0 make-timestamp dup <=> zero? ] unit-test
[ 60 ] [ 2004 2 29 3array make-timestamp day-of-year ] unit-test [ t ] [ 2004 1 1 0 0 0 0 make-timestamp 10 seconds 5 years +dts +dt
[ 61 ] [ 2004 3 1 3array make-timestamp day-of-year ] unit-test 2009 1 1 0 0 10 0 make-timestamp <=> zero? ] unit-test
[ 366 ] [ 2004 12 31 3array make-timestamp day-of-year ] unit-test [ t ] [ 2004 1 1 0 0 0 0 make-timestamp -10 seconds -5 years +dts +dt
[ 365 ] [ 2003 12 31 3array make-timestamp day-of-year ] unit-test 1998 12 31 23 59 50 0 make-timestamp <=> zero? ] unit-test
[ 60 ] [ 2003 3 1 3array make-timestamp day-of-year ] unit-test
[ t ] [ 2004 12 31 3array make-timestamp dup timestamp= ] unit-test [ t ] [ 2004 1 1 23 0 0 12 make-timestamp 0 convert-timezone
[ t ] [ 2004 1 1 0 0 0 0 <timestamp> 10 seconds 5 years +dts +dt 2004 1 1 11 0 0 0 make-timestamp <=> zero? ] unit-test
2009 1 1 0 0 10 0 <timestamp> timestamp= ] unit-test [ t ] [ 2004 1 1 5 0 0 -11 make-timestamp 0 convert-timezone
[ t ] [ 2004 1 1 0 0 0 0 <timestamp> -10 seconds -5 years +dts +dt 2004 1 1 16 0 0 0 make-timestamp <=> zero? ] unit-test
1998 12 31 23 59 50 0 <timestamp> timestamp= ] unit-test [ t ] [ 2004 1 1 23 0 0 9.5 make-timestamp 0 convert-timezone
2004 1 1 13 30 0 0 make-timestamp <=> zero? ] unit-test
[ t ] [ 2004 1 1 23 0 0 12 <timestamp> 0 convert-timezone
2004 1 1 11 0 0 0 <timestamp> timestamp= ] unit-test
[ t ] [ 2004 1 1 5 0 0 -11 <timestamp> 0 convert-timezone
2004 1 1 16 0 0 0 <timestamp> timestamp= ] unit-test
[ t ] [ 2004 1 1 23 0 0 9.5 <timestamp> 0 convert-timezone
2004 1 1 13 30 0 0 <timestamp> timestamp= ] unit-test