diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index c42bba51f5..e8c0495665 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -40,10 +40,10 @@ CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } GENERIC: leap-year? ( obj -- ? ) -M: integer leap-year? ( year -- ? ) +M: integer leap-year? dup 100 divisor? 400 4 ? divisor? ; -M: timestamp leap-year? ( timestamp -- ? ) +M: timestamp leap-year? year>> leap-year? ; : (days-in-month) ( year month -- n ) @@ -121,10 +121,10 @@ GENERIC: easter ( obj -- obj' ) h l + 7 m * - 114 + 31 /mod 1 + ; -M: integer easter ( year -- timestamp ) +M: integer easter dup easter-month-day ; -M: timestamp easter ( timestamp -- timestamp ) +M: timestamp easter clone dup year>> easter-month-day swapd >>day swap >>month ; @@ -167,52 +167,52 @@ GENERIC: +second ( timestamp x -- timestamp ) { [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&& [ 3 >>month 1 >>day ] when ; -M: integer +year ( timestamp n -- timestamp ) +M: integer +year [ + ] curry change-year adjust-leap-year ; -M: real +year ( timestamp n -- timestamp ) +M: real +year [ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ; : months/years ( n -- months years ) 12 /rem [ 1 - 12 ] when-zero swap ; inline -M: integer +month ( timestamp n -- timestamp ) +M: integer +month [ over month>> + months/years [ >>month ] dip +year ] unless-zero ; -M: real +month ( timestamp n -- timestamp ) +M: real +month [ float>whole-part swapd average-month * +day swap +month ] unless-zero ; -M: integer +day ( timestamp n -- timestamp ) +M: integer +day [ over >date< julian-day-number + julian-day-number>date [ >>year ] [ >>month ] [ >>day ] tri* ] unless-zero ; -M: real +day ( timestamp n -- timestamp ) +M: real +day [ float>whole-part swapd 24 * +hour swap +day ] unless-zero ; : hours/days ( n -- hours days ) 24 /rem swap ; -M: integer +hour ( timestamp n -- timestamp ) +M: integer +hour [ over hour>> + hours/days [ >>hour ] dip +day ] unless-zero ; -M: real +hour ( timestamp n -- timestamp ) +M: real +hour float>whole-part swapd 60 * +minute swap +hour ; : minutes/hours ( n -- minutes hours ) 60 /rem swap ; -M: integer +minute ( timestamp n -- timestamp ) +M: integer +minute [ over minute>> + minutes/hours [ >>minute ] dip +hour ] unless-zero ; -M: real +minute ( timestamp n -- timestamp ) +M: real +minute [ float>whole-part swapd 60 * +second swap +minute ] unless-zero ; : seconds/minutes ( n -- seconds minutes ) 60 /rem swap >integer ; -M: number +second ( timestamp n -- timestamp ) +M: number +second [ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ; : (time+) ( timestamp duration -- timestamp' duration ) @@ -291,8 +291,7 @@ GENERIC: time- ( time1 time2 -- time3 ) [ neg +year 0 ] change-year drop ] if ; -M: timestamp <=> ( ts1 ts2 -- n ) - [ >gmt tuple-slots ] compare ; +M: timestamp <=> [ >gmt tuple-slots ] compare ; : same-day? ( ts1 ts2 -- ? ) [ >gmt >date< ] same? ; @@ -376,8 +375,9 @@ M: duration time- GENERIC: days-in-year ( obj -- n ) -M: integer days-in-year ( year -- n ) leap-year? 366 365 ? ; -M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ; +M: integer days-in-year leap-year? 366 365 ? ; + +M: timestamp days-in-year year>> days-in-year ; : days-in-month ( timestamp -- n ) >date< drop (days-in-month) ; diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index 853bd32c2c..bf1668ebd7 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -52,15 +52,15 @@ MACRO: formatted ( spec -- quot ) GENERIC: day. ( obj -- ) -M: integer day. ( n -- ) +M: integer day. number>string dup length 2 < [ bl ] when write ; -M: timestamp day. ( timestamp -- ) +M: timestamp day. day>> day. ; GENERIC: month. ( obj -- ) -M: array month. ( pair -- ) +M: array month. first2 [ month-name write bl number>string print ] [ 1 zeller-congruence ] @@ -71,15 +71,15 @@ M: array month. ( pair -- ) 1 + + 7 mod zero? [ nl ] [ bl ] if ] with each-integer nl ; -M: timestamp month. ( timestamp -- ) +M: timestamp month. [ year>> ] [ month>> ] bi 2array month. ; GENERIC: year. ( obj -- ) -M: integer year. ( n -- ) +M: integer year. 12 [ 1 + 2array month. nl ] with each-integer ; -M: timestamp year. ( timestamp -- ) +M: timestamp year. year>> year. ; : timestamp>mdtm ( timestamp -- str ) diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index ac729a5cef..f86e5c043b 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -31,7 +31,7 @@ IN: calendar.unix : timezone-name ( -- string ) get-time zone>> ; -M: unix gmt-offset ( -- hours minutes seconds ) +M: unix gmt-offset get-time gmtoff>> 3600 /mod 60 /mod ; : current-timeval ( -- timeval ) diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor index f866fe81fa..09227c6afb 100644 --- a/basis/calendar/windows/windows.factor +++ b/basis/calendar/windows/windows.factor @@ -28,7 +28,7 @@ IN: calendar.windows [ [ wSecond>> ] [ wMilliseconds>> 1000 / ] bi + ] } cleave instant ; -M: windows gmt-offset ( -- hours minutes seconds ) +M: windows gmt-offset TIME_ZONE_INFORMATION dup GetTimeZoneInformation { { TIME_ZONE_ID_INVALID [ win32-error ] }