Udpate calendar to remove some circular dependencies
parent
3546f5150d
commit
54ccb0f48c
|
@ -0,0 +1,5 @@
|
||||||
|
USING: kernel ;
|
||||||
|
IN: calendar.backend
|
||||||
|
|
||||||
|
SYMBOL: calendar-backend
|
||||||
|
HOOK: gmt-offset calendar-backend
|
|
@ -3,13 +3,10 @@
|
||||||
|
|
||||||
USING: arrays hashtables io io.streams.string kernel math
|
USING: arrays hashtables io io.streams.string kernel math
|
||||||
math.vectors math.functions math.parser namespaces sequences
|
math.vectors math.functions math.parser namespaces sequences
|
||||||
strings tuples system debugger combinators vocabs.loader ;
|
strings tuples system debugger combinators vocabs.loader
|
||||||
|
calendar.backend structs alien.c-types unix ;
|
||||||
IN: calendar
|
IN: calendar
|
||||||
|
|
||||||
SYMBOL: calendar-impl
|
|
||||||
|
|
||||||
HOOK: gmt-offset calendar-impl ( -- n )
|
|
||||||
|
|
||||||
TUPLE: timestamp year month day hour minute second gmt-offset ;
|
TUPLE: timestamp year month day hour minute second gmt-offset ;
|
||||||
|
|
||||||
C: <timestamp> timestamp
|
C: <timestamp> timestamp
|
||||||
|
@ -225,6 +222,24 @@ M: timestamp <=> ( ts1 ts2 -- n )
|
||||||
: timestamp>unix-time ( timestamp -- n )
|
: timestamp>unix-time ( timestamp -- n )
|
||||||
unix-1970 timestamp- >bignum ;
|
unix-1970 timestamp- >bignum ;
|
||||||
|
|
||||||
|
: timestamp>timeval ( timestamp -- timeval )
|
||||||
|
timestamp>unix-time 1000 * make-timeval ;
|
||||||
|
|
||||||
|
: timeval>timestamp ( timeval -- timestamp )
|
||||||
|
[ timeval-sec ] keep
|
||||||
|
timeval-usec 1000000 / + unix-time>timestamp ;
|
||||||
|
|
||||||
|
: timestamp>timespec ( timestamp -- timespec )
|
||||||
|
timestamp>unix-time "timespec" <c-object>
|
||||||
|
[ set-timespec-sec ] keep ;
|
||||||
|
|
||||||
|
: timespec>timestamp ( timespec -- timestamp )
|
||||||
|
[ timespec-sec ] keep
|
||||||
|
timespec-nsec 1000000000 / +
|
||||||
|
unix-time>timestamp ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
: gmt ( -- timestamp )
|
: gmt ( -- timestamp )
|
||||||
#! GMT time, right now
|
#! GMT time, right now
|
||||||
unix-1970 millis 1000 /f seconds +dt ;
|
unix-1970 millis 1000 /f seconds +dt ;
|
||||||
|
@ -353,6 +368,37 @@ M: timestamp <=> ( ts1 ts2 -- n )
|
||||||
] if
|
] if
|
||||||
] string-out ;
|
] string-out ;
|
||||||
|
|
||||||
|
: day-offset ( timestamp m -- timestamp n )
|
||||||
|
over day-of-week - ; inline
|
||||||
|
|
||||||
|
: day-this-week ( timestamp n -- timestamp )
|
||||||
|
day-offset days +dt ;
|
||||||
|
|
||||||
|
: sunday ( timestamp -- timestamp ) 0 day-this-week ;
|
||||||
|
: monday ( timestamp -- timestamp ) 1 day-this-week ;
|
||||||
|
: tuesday ( timestamp -- timestamp ) 2 day-this-week ;
|
||||||
|
: wednesday ( timestamp -- timestamp ) 3 day-this-week ;
|
||||||
|
: thursday ( timestamp -- timestamp ) 4 day-this-week ;
|
||||||
|
: friday ( timestamp -- timestamp ) 5 day-this-week ;
|
||||||
|
: saturday ( timestamp -- timestamp ) 6 day-this-week ;
|
||||||
|
|
||||||
|
: beginning-of-day ( timestamp -- new-timestamp )
|
||||||
|
clone dup >r 0 0 0 r>
|
||||||
|
{ set-timestamp-hour set-timestamp-minute set-timestamp-second }
|
||||||
|
set-slots ; inline
|
||||||
|
|
||||||
|
: beginning-of-month ( timestamp -- new-timestamp )
|
||||||
|
clone dup beginning-of-day dup >r 1 r> { set-timestamp-day } set-slots ;
|
||||||
|
|
||||||
|
: beginning-of-week ( timestamp -- new-timestamp )
|
||||||
|
clone dup sunday beginning-of-day ;
|
||||||
|
|
||||||
|
: beginning-of-year ( timestamp -- new-timestamp )
|
||||||
|
clone dup beginning-of-month dup >r 1 r> { set-timestamp-month } set-slots ;
|
||||||
|
|
||||||
|
: seconds-since-midnight ( timestamp -- x )
|
||||||
|
dup beginning-of-day timestamp- ;
|
||||||
|
|
||||||
{
|
{
|
||||||
{ [ unix? ] [ "calendar.unix" ] }
|
{ [ unix? ] [ "calendar.unix" ] }
|
||||||
{ [ windows? ] [ "calendar.windows" ] }
|
{ [ windows? ] [ "calendar.windows" ] }
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
USING: alien alien.c-types arrays kernel structs
|
USING: alien alien.c-types arrays calendar.backend
|
||||||
math unix calendar namespaces ;
|
kernel structs math unix namespaces ;
|
||||||
IN: calendar.unix
|
IN: calendar.unix
|
||||||
|
|
||||||
TUPLE: unix-calendar ;
|
TUPLE: unix-calendar ;
|
||||||
|
|
||||||
T{ unix-calendar } calendar-impl set-global
|
T{ unix-calendar } calendar-backend set-global
|
||||||
|
|
||||||
: get-time
|
: get-time
|
||||||
f time <uint> localtime ;
|
f time <uint> localtime ;
|
||||||
|
@ -14,19 +14,3 @@ T{ unix-calendar } calendar-impl set-global
|
||||||
|
|
||||||
M: unix-calendar gmt-offset
|
M: unix-calendar gmt-offset
|
||||||
get-time tm-gmtoff 3600 / ;
|
get-time tm-gmtoff 3600 / ;
|
||||||
|
|
||||||
: timestamp>timeval ( timestamp -- timeval )
|
|
||||||
timestamp>unix-time 1000 * make-timeval ;
|
|
||||||
|
|
||||||
: timeval>timestamp ( timeval -- timestamp )
|
|
||||||
[ timeval-sec ] keep
|
|
||||||
timeval-usec 1000000 / + unix-time>timestamp ;
|
|
||||||
|
|
||||||
: timestamp>timespec ( timestamp -- timespec )
|
|
||||||
timestamp>unix-time "timespec" <c-object>
|
|
||||||
[ set-timespec-sec ] keep ;
|
|
||||||
|
|
||||||
: timespec>timestamp ( timespec -- timestamp )
|
|
||||||
[ timespec-sec ] keep
|
|
||||||
timespec-nsec 1000000000 / +
|
|
||||||
unix-time>timestamp ;
|
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
USING: alien alien.c-types kernel math
|
USING: alien alien.c-types kernel math
|
||||||
windows windows.kernel32 calendar namespaces ;
|
windows windows.kernel32 namespaces ;
|
||||||
IN: calendar.windows
|
IN: calendar.windows
|
||||||
|
|
||||||
TUPLE: windows-calendar ;
|
TUPLE: windows-calendar ;
|
||||||
|
|
||||||
T{ windows-calendar } calendar-impl set-global
|
T{ windows-calendar } calendar-backend set-global
|
||||||
|
|
||||||
M: windows-calendar gmt-offset ( -- float )
|
M: windows-calendar gmt-offset ( -- float )
|
||||||
"TIME_ZONE_INFORMATION" <c-object>
|
"TIME_ZONE_INFORMATION" <c-object>
|
||||||
|
@ -45,4 +45,3 @@ M: windows-calendar gmt-offset ( -- float )
|
||||||
|
|
||||||
: FILETIME>timestamp ( FILETIME -- timestamp/f )
|
: FILETIME>timestamp ( FILETIME -- timestamp/f )
|
||||||
FILETIME>windows-time windows-time>timestamp ;
|
FILETIME>windows-time windows-time>timestamp ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue