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

add unix-time>timestamp, timestamp>unix-time, and some utility words to calendar

db4
Doug Coleman 2009-11-14 21:10:54 -06:00
parent ccd35c2f4f
commit d4a88d0e39
2 changed files with 32 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/calendar/calendar-tests.factor
View File

@ -170,3 +170,8 @@ IN: calendar.tests
[ f ] [ now dup midnight eq? ] unit-test [ f ] [ now dup midnight eq? ] unit-test
[ f ] [ now dup easter eq? ] unit-test [ f ] [ now dup easter eq? ] unit-test
[ f ] [ now dup beginning-of-year eq? ] unit-test [ f ] [ now dup beginning-of-year eq? ] unit-test
[ t ] [ 1325376000 unix-time>timestamp 2012 <year-gmt> = ] unit-test
[ t ] [ 1356998399 unix-time>timestamp 2013 <year-gmt> 1 seconds time- = ] unit-test
[ t ] [ 1500000000 random [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test

30
basis/calendar/calendar.factor
View File

@ -17,6 +17,8 @@ TUPLE: duration
C: <duration> duration C: <duration> duration
: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
TUPLE: timestamp TUPLE: timestamp
{ year integer } { year integer }
{ month integer } { month integer }
@ -34,6 +36,15 @@ C: <timestamp> timestamp
: <date> ( year month day -- timestamp ) : <date> ( year month day -- timestamp )
0 0 0 gmt-offset-duration <timestamp> ; 0 0 0 gmt-offset-duration <timestamp> ;
: <date-gmt> ( year month day -- timestamp )
0 0 0 instant <timestamp> ;
: <year> ( year -- timestamp )
1 1 <date> ;
: <year-gmt> ( year -- timestamp )
1 1 <date-gmt> ;
ERROR: not-a-month ; ERROR: not-a-month ;
M: not-a-month summary M: not-a-month summary
drop "Months are indexed starting at 1" ; drop "Months are indexed starting at 1" ;
@ -149,7 +160,6 @@ M: timestamp easter ( timestamp -- timestamp )
: >time< ( timestamp -- hour minute second ) : >time< ( timestamp -- hour minute second )
[ hour>> ] [ minute>> ] [ second>> ] tri ; [ hour>> ] [ minute>> ] [ second>> ] tri ;
: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
: years ( x -- duration ) instant clone swap >>year ; : years ( x -- duration ) instant clone swap >>year ;
: months ( x -- duration ) instant clone swap >>month ; : months ( x -- duration ) instant clone swap >>month ;
: days ( x -- duration ) instant clone swap >>day ; : days ( x -- duration ) instant clone swap >>day ;
@ -430,6 +440,9 @@ M: timestamp day-name day-of-week day-names nth ;
: beginning-of-month ( timestamp -- new-timestamp ) : beginning-of-month ( timestamp -- new-timestamp )
midnight 1 >>day ; midnight 1 >>day ;
: end-of-month ( timestamp -- new-timestamp )
[ midnight ] [ days-in-month ] bi >>day ;
<PRIVATE <PRIVATE
: day-offset ( timestamp m -- new-timestamp n ) : day-offset ( timestamp m -- new-timestamp n )
@ -522,8 +535,13 @@ M: timestamp december clone 12 >>month ;
: beginning-of-week ( timestamp -- new-timestamp ) : beginning-of-week ( timestamp -- new-timestamp )
midnight sunday ; midnight sunday ;
: beginning-of-year ( timestamp -- new-timestamp ) GENERIC: beginning-of-year ( object -- new-timestamp )
beginning-of-month 1 >>month ; M: timestamp beginning-of-year beginning-of-month 1 >>month ;
M: integer beginning-of-year <year> ;
GENERIC: end-of-year ( object -- new-timestamp )
M: timestamp end-of-year 12 >>month 31 >>day ;
M: integer end-of-year 12 31 <date> ;
: time-since-midnight ( timestamp -- duration ) : time-since-midnight ( timestamp -- duration )
dup midnight time- ; dup midnight time- ;
@ -531,6 +549,12 @@ M: timestamp december clone 12 >>month ;
: since-1970 ( duration -- timestamp ) : since-1970 ( duration -- timestamp )
unix-1970 time+ >local-time ; unix-1970 time+ >local-time ;
: timestamp>unix-time ( timestamp -- seconds )
unix-1970 time- second>> ;
: unix-time>timestamp ( seconds -- timestamp )
seconds unix-1970 time+ ;
M: timestamp sleep-until timestamp>micros sleep-until ; M: timestamp sleep-until timestamp>micros sleep-until ;
M: duration sleep hence sleep-until ; M: duration sleep hence sleep-until ;