diff --git a/extra/calendar/holidays/us/us.factor b/extra/calendar/holidays/us/us.factor index 7b3a7ea570..60018dfb6a 100644 --- a/extra/calendar/holidays/us/us.factor +++ b/extra/calendar/holidays/us/us.factor @@ -1,130 +1,143 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors calendar kernel math words ; +USING: accessors assocs calendar combinators.short-circuit fry +kernel lexer math namespaces parser sequences shuffle vocabs +words ; IN: calendar.holidays.us +SYMBOLS: world us us-federal canada +commonwealth-of-nations ; + << -SYNTAX: us-federal - word "us-federal" dup set-word-prop ; +SYNTAX: HOLIDAY: + CREATE-WORD + dup H{ } clone "holiday" set-word-prop + parse-definition (( timestamp/n -- timestamp )) define-declared ; + +SYNTAX: HOLIDAY-NAME: + scan-word "holiday" word-prop scan-word scan-object >at drop ; >> -! Federal Holidays -: new-years-day ( timestamp/n -- timestamp ) - january 1 >>day ; us-federal +: holiday>timestamp ( n word -- timestamp ) + execute( timestamp -- timestamp' ) ; -: martin-luther-king-day ( timestamp/n -- timestamp ) - january 3 monday-of-month ; us-federal +: find-holidays ( n symbol -- seq ) + all-words swap '[ "holiday" word-prop _ swap key? ] filter + [ holiday>timestamp ] with map ; -: inauguration-day ( timestamp/n -- timestamp ) - year dup neg 4 rem + january 20 >>day ; us-federal +: adjust-federal-holiday ( timestamp -- timestamp' ) + dup saturday? [ + 1 days time- + ] [ + dup sunday? [ + 1 days time+ + ] when + ] if ; -: washington's-birthday ( timestamp/n -- timestamp ) - february 3 monday-of-month ; us-federal +: us-federal-holidays ( timestamp/n -- seq ) + us-federal find-holidays [ adjust-federal-holiday ] map ; -ALIAS: presidents-day washington's-birthday us-federal +: canadian-holidays ( timestamp/n -- seq ) + canada find-holidays ; -: memorial-day ( timestamp/n -- timestamp ) - may last-monday-of-month ; us-federal +HOLIDAY: new-year's-day january 1 >>day ; +HOLIDAY-NAME: new-year's-day world "New Year's Day" +HOLIDAY-NAME: new-year's-day us-federal "New Year's Day" -: independence-day ( timestamp/n -- timestamp ) - july 4 >>day ; us-federal +HOLIDAY: martin-luther-king-day january 3 monday-of-month ; +HOLIDAY-NAME: martin-luther-king-day us-federal "Martin Luther King Day" -: labor-day ( timestamp/n -- timestamp ) - september 1 monday-of-month ; us-federal +HOLIDAY: inauguration-day year dup 4 neg rem + january 20 >>day ; +HOLIDAY-NAME: inauguration-day us "Inauguration Day" -: columbus-day ( timestamp/n -- timestamp ) - october 2 monday-of-month ; us-federal +HOLIDAY: washington's-birthday february 3 monday-of-month ; +HOLIDAY-NAME: washington's-birthday us-federal "Washington's Birthday" -: veterans'-day ( timestamp/n -- timestamp ) - november 11 >>day ; us-federal +HOLIDAY: memorial-day may last-monday-of-month ; +HOLIDAY-NAME: memorial-day us-federal "Memorial Day" -: thanksgiving-day ( timestamp/n -- timestamp ) - november 4 thursday-of-month ; us-federal +HOLIDAY: independence-day july 4 >>day ; +HOLIDAY-NAME: independence-day us-federal "Independence Day" -: christmas-day ( timestamp/n -- timestamp ) - december 25 >>day ; us-federal +HOLIDAY: labor-day september 1 monday-of-month ; +HOLIDAY-NAME: labor-day us-federal "Labor Day" -! Other Holidays +HOLIDAY: columbus-day october 2 monday-of-month ; +HOLIDAY-NAME: columbus-day us-federal "Columbus Day" -: belly-laugh-day ( timestamp/n -- timestamp ) - january 24 >>day ; +HOLIDAY: veterans-day november 11 >>day ; +HOLIDAY-NAME: veterans-day us-federal "Veterans Day" +HOLIDAY-NAME: veterans-day world "Armistice Day" +HOLIDAY-NAME: veterans-day commonwealth-of-nations "Remembrance Day" -: groundhog-day ( timestamp/n -- timestamp ) - february 2 >>day ; +HOLIDAY: thanksgiving-day november 4 thursday-of-month ; +HOLIDAY-NAME: thanksgiving-day us-federal "Thanksgiving Day" -: lincoln's-birthday ( timestamp/n -- timestamp ) - february 12 >>day ; +HOLIDAY: canadian-thanksgiving-day october 2 monday-of-month ; +HOLIDAY-NAME: canadian-thanksgiving-day canada "Thanksgiving Day" -: valentine's-day ( timestamp/n -- timestamp ) - february 14 >>day ; +HOLIDAY: christmas-day december 25 >>day ; +HOLIDAY-NAME: christmas-day world "Christmas Day" +HOLIDAY-NAME: christmas-day us-federal "Christmas Day" -: st-patrick's-day ( timestamp/n -- timestamp ) - march 17 >>day ; +HOLIDAY: belly-laugh-day january 24 >>day ; -: ash-wednesday ( timestamp/n -- timestamp ) - easter 46 days time- ; +HOLIDAY: groundhog-day february 2 >>day ; + +HOLIDAY: lincoln's-birthday february 12 >>day ; + +HOLIDAY: valentine's-day february 14 >>day ; + +HOLIDAY: st-patrick's-day march 17 >>day ; + +HOLIDAY: ash-wednesday easter 46 days time- ; ALIAS: first-day-of-lent ash-wednesday -: fat-tuesday ( timestamp/n -- timestamp ) - ash-wednesday 1 days time- ; +HOLIDAY: fat-tuesday ash-wednesday 1 days time- ; -: good-friday ( timestamp/n -- timestamp ) - easter 2 days time- ; +HOLIDAY: good-friday easter 2 days time- ; -: tax-day ( timestamp/n -- timestamp ) - april 15 >>day ; +HOLIDAY: tax-day april 15 >>day ; -: earth-day ( timestamp/n -- timestamp ) - april 22 >>day ; +HOLIDAY: earth-day april 22 >>day ; -: administrative-professionals'-day ( timestamp/n -- timestamp ) - april last-saturday-of-month wednesday ; +HOLIDAY: administrative-professionals'-day april last-saturday-of-month wednesday ; -: cinco-de-mayo ( timestamp/n -- timestamp ) - may 5 >>day ; +HOLIDAY: cinco-de-mayo may 5 >>day ; -: mother's-day ( timestamp/n -- timestamp ) - may 2 sunday-of-month ; +HOLIDAY: mother's-day may 2 sunday-of-month ; -: armed-forces-day ( timestamp/n -- timestamp ) - may 3 saturday-of-month ; +HOLIDAY: armed-forces-day may 3 saturday-of-month ; -: flag-day ( timestamp/n -- timestamp ) - june 14 >>day ; +HOLIDAY: flag-day june 14 >>day ; -: parents'-day ( timestamp/n -- timestamp ) - july 4 sunday-of-month ; +HOLIDAY: parents'-day july 4 sunday-of-month ; -: grandparents'-day ( timestamp/n -- timestamp ) - labor-day 1 weeks time+ ; +HOLIDAY: grandparents'-day labor-day 1 weeks time+ ; -: patriot-day ( timestamp/n -- timestamp ) - september 11 >>day ; +HOLIDAY: patriot-day september 11 >>day ; -: stepfamily-day ( timestamp/n -- timestamp ) - september 16 >>day ; +HOLIDAY: stepfamily-day september 16 >>day ; -: citizenship-day ( timestamp/n -- timestamp ) - september 17 >>day ; +HOLIDAY: citizenship-day september 17 >>day ; -: boss's-day ( timestamp/n -- timestamp ) - october 16 >>day ; +HOLIDAY: boss's-day october 16 >>day ; -: sweetest-day ( timestamp/n -- timestamp ) - october 3 saturday-of-month ; +HOLIDAY: sweetest-day october 3 saturday-of-month ; -: halloween ( timestamp/n -- timestamp ) - october 31 >>day ; +HOLIDAY: halloween october 31 >>day ; -: election-day ( timestamp/n -- timestamp ) - november 1 monday-of-month 1 days time+ ; +HOLIDAY: election-day november 1 monday-of-month 1 days time+ ; -: black-friday ( timestamp/n -- timestamp ) - thanksgiving-day 1 days time+ ; +HOLIDAY: black-friday thanksgiving-day 1 days time+ ; -: pearl-harbor-remembrance-day ( timestamp/n -- timestamp ) - december 7 >>day ; +HOLIDAY: pearl-harbor-remembrance-day december 7 >>day ; -: new-year's-eve ( timestamp/n -- timestamp ) - december 31 >>day ; +HOLIDAY: new-year's-eve december 31 >>day ; + +: post-office-open? ( timestamp -- ? ) + { + [ sunday? not ] + [ dup us-federal-holidays [ same-day? ] with any? not ] + } 1&& ;