From a6f0fcd5b2d642db73cbe41cfad6b30f22acb94d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 11 Nov 2009 15:52:30 -0600 Subject: [PATCH 1/4] add nth day of month --- basis/calendar/calendar.factor | 35 ++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 0378e2701e..fbaac2e914 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -398,12 +398,28 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ; : day-of-year ( timestamp -- n ) >date< (day-of-year) ; +: midnight ( timestamp -- new-timestamp ) + clone 0 >>hour 0 >>minute 0 >>second ; inline + +: noon ( timestamp -- new-timestamp ) + midnight 12 >>hour ; inline + +: beginning-of-month ( timestamp -- new-timestamp ) + midnight 1 >>day ; + > ] bi@ = [ 1 weeks time+ ] unless + n 1 - [ weeks time+ ] unless-zero ; + PRIVATE> : sunday ( timestamp -- new-timestamp ) 0 day-this-week ; @@ -414,14 +430,13 @@ PRIVATE> : friday ( timestamp -- new-timestamp ) 5 day-this-week ; : saturday ( timestamp -- new-timestamp ) 6 day-this-week ; -: midnight ( timestamp -- new-timestamp ) - clone 0 >>hour 0 >>minute 0 >>second ; inline - -: noon ( timestamp -- new-timestamp ) - midnight 12 >>hour ; inline - -: beginning-of-month ( timestamp -- new-timestamp ) - midnight 1 >>day ; +: sunday-of-month ( timestamp n -- new-timestamp ) 0 nth-day-this-month ; +: monday-of-month ( timestamp n -- new-timestamp ) 1 nth-day-this-month ; +: tuesday-of-month ( timestamp n -- new-timestamp ) 2 nth-day-this-month ; +: wednesday-of-month ( timestamp n -- new-timestamp ) 3 nth-day-this-month ; +: thursday-of-month ( timestamp n -- new-timestamp ) 4 nth-day-this-month ; +: friday-of-month ( timestamp n -- new-timestamp ) 5 nth-day-this-month ; +: saturday-of-month ( timestamp n -- new-timestamp ) 6 nth-day-this-month ; : beginning-of-week ( timestamp -- new-timestamp ) midnight sunday ; From e3dc3ae5dd1abedc797387ef9439f4388a30b1a5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 11 Nov 2009 17:19:14 -0600 Subject: [PATCH 2/4] add more calendar utility words --- basis/calendar/calendar.factor | 62 ++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index fbaac2e914..83178871f0 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -157,6 +157,18 @@ M: timestamp easter ( timestamp -- timestamp ) : microseconds ( x -- duration ) 1000000 / seconds ; : nanoseconds ( x -- duration ) 1000000000 / seconds ; +GENERIC: year ( obj -- n ) +M: integer year ; +M: timestamp year year>> ; + +GENERIC: month ( obj -- n ) +M: integer month ; +M: timestamp month month>> ; + +GENERIC: day ( obj -- n ) +M: integer day ; +M: timestamp day day>> ; + GENERIC: leap-year? ( obj -- ? ) M: integer leap-year? ( year -- ? ) @@ -420,8 +432,50 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ; dup timestamp [ month>> ] bi@ = [ 1 weeks time+ ] unless n 1 - [ weeks time+ ] unless-zero ; +: last-day-this-month ( timestamp day -- new-timestamp ) + [ 1 months time+ 1 ] dip nth-day-this-month 1 weeks time- ; + PRIVATE> +GENERIC: january ( obj -- timestamp ) +GENERIC: february ( obj -- timestamp ) +GENERIC: march ( obj -- timestamp ) +GENERIC: april ( obj -- timestamp ) +GENERIC: may ( obj -- timestamp ) +GENERIC: june ( obj -- timestamp ) +GENERIC: july ( obj -- timestamp ) +GENERIC: august ( obj -- timestamp ) +GENERIC: september ( obj -- timestamp ) +GENERIC: october ( obj -- timestamp ) +GENERIC: november ( obj -- timestamp ) +GENERIC: december ( obj -- timestamp ) + +M: integer january 1 1 ; +M: integer february 2 1 ; +M: integer march 3 1 ; +M: integer april 4 1 ; +M: integer may 5 1 ; +M: integer june 6 1 ; +M: integer july 7 1 ; +M: integer august 8 1 ; +M: integer september 9 1 ; +M: integer october 10 1 ; +M: integer november 11 1 ; +M: integer december 12 1 ; + +M: timestamp january clone 1 >>month ; +M: timestamp february clone 2 >>month ; +M: timestamp march clone 3 >>month ; +M: timestamp april clone 4 >>month ; +M: timestamp may clone 5 >>month ; +M: timestamp june clone 6 >>month ; +M: timestamp july clone 7 >>month ; +M: timestamp august clone 8 >>month ; +M: timestamp september clone 9 >>month ; +M: timestamp october clone 10 >>month ; +M: timestamp november clone 11 >>month ; +M: timestamp december clone 12 >>month ; + : sunday ( timestamp -- new-timestamp ) 0 day-this-week ; : monday ( timestamp -- new-timestamp ) 1 day-this-week ; : tuesday ( timestamp -- new-timestamp ) 2 day-this-week ; @@ -438,6 +492,14 @@ PRIVATE> : friday-of-month ( timestamp n -- new-timestamp ) 5 nth-day-this-month ; : saturday-of-month ( timestamp n -- new-timestamp ) 6 nth-day-this-month ; +: last-sunday-of-month ( timestamp -- new-timestamp ) 0 last-day-this-month ; +: last-monday-of-month ( timestamp -- new-timestamp ) 1 last-day-this-month ; +: last-tuesday-of-month ( timestamp -- new-timestamp ) 2 last-day-this-month ; +: last-wednesday-of-month ( timestamp -- new-timestamp ) 3 last-day-this-month ; +: last-thursday-of-month ( timestamp -- new-timestamp ) 4 last-day-this-month ; +: last-friday-of-month ( timestamp -- new-timestamp ) 5 last-day-this-month ; +: last-saturday-of-month ( timestamp -- new-timestamp ) 6 last-day-this-month ; + : beginning-of-week ( timestamp -- new-timestamp ) midnight sunday ; From a2fe85b34a74770541f6a06ca43a13eb2c65ff62 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 11 Nov 2009 17:20:01 -0600 Subject: [PATCH 3/4] add US holidays vocab --- extra/calendar/holidays/us/authors.txt | 1 + extra/calendar/holidays/us/us.factor | 130 +++++++++++++++++++++++++ 2 files changed, 131 insertions(+) create mode 100644 extra/calendar/holidays/us/authors.txt create mode 100644 extra/calendar/holidays/us/us.factor diff --git a/extra/calendar/holidays/us/authors.txt b/extra/calendar/holidays/us/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/calendar/holidays/us/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/calendar/holidays/us/us.factor b/extra/calendar/holidays/us/us.factor new file mode 100644 index 0000000000..f60f2163c2 --- /dev/null +++ b/extra/calendar/holidays/us/us.factor @@ -0,0 +1,130 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar kernel math words ; +IN: calendar.holidays.us + +<< +SYNTAX: us-federal + word "us-federal" dup set-word-prop ; +>> + +! Federal Holidays +: new-years-day ( timestamp/n -- timestamp ) + january 1 >>day ; us-federal + +: martin-luther-king-day ( timestamp/n -- timestamp ) + january 3 monday-of-month ; us-federal + +: inauguration-day ( timestamp/n -- timestamp ) + year dup 4 mod + january 20 >>day ; us-federal + +: washington's-birthday ( timestamp/n -- timestamp ) + february 3 monday-of-month ; us-federal + +ALIAS: presidents-day washington's-birthday us-federal + +: memorial-day ( timestamp/n -- timestamp ) + may last-monday-of-month ; us-federal + +: independence-day ( timestamp/n -- timestamp ) + july 4 >>day ; us-federal + +: labor-day ( timestamp/n -- timestamp ) + september 1 monday-of-month ; us-federal + +: columbus-day ( timestamp/n -- timestamp ) + october 2 monday-of-month ; us-federal + +: veterans'-day ( timestamp/n -- timestamp ) + november 11 >>day ; us-federal + +: thanksgiving-day ( timestamp/n -- timestamp ) + november 4 thursday-of-month ; us-federal + +: christmas-day ( timestamp/n -- timestamp ) + december 25 >>day ; us-federal + +! Other Holidays + +: belly-laugh-day ( timestamp/n -- timestamp ) + january 24 >>day ; + +: groundhog-day ( timestamp/n -- timestamp ) + february 2 >>day ; + +: lincoln's-birthday ( timestamp/n -- timestamp ) + february 12 >>day ; + +: valentine's-day ( timestamp/n -- timestamp ) + february 14 >>day ; + +: st-patrick's-day ( timestamp/n -- timestamp ) + march 17 >>day ; + +: ash-wednesday ( timestamp/n -- timestamp ) + easter 46 days time- ; + +ALIAS: first-day-of-lent ash-wednesday + +: fat-tuesday ( timestamp/n -- timestamp ) + ash-wednesday 1 days time- ; + +: good-friday ( timestamp/n -- timestamp ) + easter 2 days time- ; + +: tax-day ( timestamp/n -- timestamp ) + april 15 >>day ; + +: earth-day ( timestamp/n -- timestamp ) + april 22 >>day ; + +: administrative-professionals'-day ( timestamp/n -- timestamp ) + april last-saturday-of-month wednesday ; + +: cinco-de-mayo ( timestamp/n -- timestamp ) + may 5 >>day ; + +: mother's-day ( timestamp/n -- timestamp ) + may 2 sunday-of-month ; + +: armed-forces-day ( timestamp/n -- timestamp ) + may 3 saturday-of-month ; + +: flag-day ( timestamp/n -- timestamp ) + june 14 >>day ; + +: parents'-day ( timestamp/n -- timestamp ) + july 4 sunday-of-month ; + +: grandparents'-day ( timestamp/n -- timestamp ) + labor-day 1 weeks time+ ; + +: patriot-day ( timestamp/n -- timestamp ) + september 11 >>day ; + +: stepfamily-day ( timestamp/n -- timestamp ) + september 16 >>day ; + +: citizenship-day ( timestamp/n -- timestamp ) + september 17 >>day ; + +: boss's-day ( timestamp/n -- timestamp ) + october 16 >>day ; + +: sweetest-day ( timestamp/n -- timestamp ) + october 3 saturday-of-month ; + +: halloween ( timestamp/n -- timestamp ) + october 31 >>day ; + +: election-day ( timestamp/n -- timestamp ) + november 1 monday-of-month 1 days time+ ; + +: black-friday ( timestamp/n -- timestamp ) + thanksgiving-day 1 days time+ ; + +: pearl-harbor-remembrance-day ( timestamp/n -- timestamp ) + december 7 >>day ; + +: new-year's-eve ( timestamp/n -- timestamp ) + december 31 >>day ; From a9eb2de22dd38aa8ddf28cf1dd3f7ee4f31db8e5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 11 Nov 2009 17:28:53 -0600 Subject: [PATCH 4/4] messed up inauguration-day --- extra/calendar/holidays/us/us.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/calendar/holidays/us/us.factor b/extra/calendar/holidays/us/us.factor index f60f2163c2..7b3a7ea570 100644 --- a/extra/calendar/holidays/us/us.factor +++ b/extra/calendar/holidays/us/us.factor @@ -16,7 +16,7 @@ SYNTAX: us-federal january 3 monday-of-month ; us-federal : inauguration-day ( timestamp/n -- timestamp ) - year dup 4 mod + january 20 >>day ; us-federal + year dup neg 4 rem + january 20 >>day ; us-federal : washington's-birthday ( timestamp/n -- timestamp ) february 3 monday-of-month ; us-federal