calendar: some minor performance improvements.

db4
John Benediktsson 2012-07-16 16:45:59 -07:00
parent 4043244ce5
commit eb87558b6a
1 changed files with 26 additions and 6 deletions

View File

@ -342,8 +342,25 @@ M: timestamp time-
: before ( duration -- -duration ) : before ( duration -- -duration )
-1 time* ; -1 time* ;
<PRIVATE
: -slots ( obj1 obj2 quot -- n obj1 obj2 )
[ bi@ - ] curry 2keep ; inline
PRIVATE>
M: duration time- M: duration time-
before time+ ; over timestamp? [
before time+
] [
[ year>> ] -slots
[ month>> ] -slots
[ day>> ] -slots
[ hour>> ] -slots
[ minute>> ] -slots
[ second>> ] -slots
2drop <duration>
] if ;
: <zero> ( -- timestamp ) : <zero> ( -- timestamp )
0 0 0 <date-gmt> ; inline 0 0 0 <date-gmt> ; inline
@ -356,19 +373,22 @@ M: duration time-
1970 <year-gmt> ; inline 1970 <year-gmt> ; inline
: millis>timestamp ( x -- timestamp ) : millis>timestamp ( x -- timestamp )
[ unix-1970 ] dip milliseconds time+ ; [ unix-1970 ] dip 1000 / +second ;
: timestamp>millis ( timestamp -- n ) : timestamp>millis ( timestamp -- n )
unix-1970 (time-) 1000 * >integer ; unix-1970 (time-) 1000 * >integer ;
: micros>timestamp ( x -- timestamp ) : micros>timestamp ( x -- timestamp )
[ unix-1970 ] dip microseconds time+ ; [ unix-1970 ] dip 1000000 / +second ;
: timestamp>micros ( timestamp -- n ) : timestamp>micros ( timestamp -- n )
unix-1970 (time-) 1000000 * >integer ; unix-1970 (time-) 1000000 * >integer ;
: now ( -- timestamp ) gmt >local-time ; : now ( -- timestamp )
gmt gmt-offset-duration (time+) >>gmt-offset ;
: hence ( duration -- timestamp ) now swap time+ ; : hence ( duration -- timestamp ) now swap time+ ;
: ago ( duration -- timestamp ) now swap time- ; : ago ( duration -- timestamp ) now swap time- ;
: zeller-congruence ( year month day -- n ) : zeller-congruence ( year month day -- n )
@ -532,10 +552,10 @@ M: integer end-of-year 12 31 <date> ;
unix-1970 time+ ; inline unix-1970 time+ ; inline
: timestamp>unix-time ( timestamp -- seconds ) : timestamp>unix-time ( timestamp -- seconds )
unix-1970 time- second>> ; inline unix-1970 (time-) ; inline
: unix-time>timestamp ( seconds -- timestamp ) : unix-time>timestamp ( seconds -- timestamp )
seconds since-1970 ; inline [ unix-1970 ] dip +second ; inline
{ {
{ [ os unix? ] [ "calendar.unix" ] } { [ os unix? ] [ "calendar.unix" ] }