calendar.holidays: clone timestamps and make holidays mutating.

diff --git a/extra/calendar/holidays/holidays.factor b/extra/calendar/holidays/holidays.factor
index aa022ace653636c0c35b72ae34800474540786fc..f0b7ed7743e721badeb2ede0ee7ae3d902a8dc19 100644 (file)
--- a/extra/calendar/holidays/holidays.factor
+++ b/extra/calendar/holidays/holidays.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs calendar fry kernel locals parser
-sequences vocabs words ;
+USING: accessors assocs calendar fry hashtables kernel locals
+parser sequences vocabs words ;
 IN: calendar.holidays
 
 SINGLETONS: all world commonwealth-of-nations ;
@@ -9,20 +9,14 @@ SINGLETONS: all world commonwealth-of-nations ;
 <<
 SYNTAX: HOLIDAY:
     scan-new-word
-    dup "holiday" word-prop [
-        dup H{ } clone "holiday" set-word-prop
-    ] unless
     parse-definition ( timestamp/n -- timestamp ) define-declared ;
 
 SYNTAX: HOLIDAY-NAME:
-    [let
-        scan-word "holiday" word-prop :> holidays
-        scan-word :> name
-        scan-object :> value
-    value name holidays set-at ] ;
+    scan-word "holiday" scan-word scan-object swap
+    '[ _ _ rot ?set-at ] change-word-prop ;
 >>
 
-GENERIC: holidays ( n singleton -- seq )
+GENERIC: holidays ( timestamp/n singleton -- seq )
 
 <PRIVATE
 
@@ -30,7 +24,7 @@ GENERIC: holidays ( n singleton -- seq )
     all-words [ "holiday" word-prop key? ] with filter ;
 
 M: object holidays
-    (holidays) [ execute( timestamp -- timestamp' ) ] with map ;
+    (holidays) [ [ clone ] dip execute( timestamp -- timestamp ) ] with map ;
 
 PRIVATE>
 
@@ -40,15 +34,16 @@ M: all holidays drop (holidays) ;
     [ holidays ] [ drop ] 2bi '[ _ same-day? ] any? ;
 
 : holiday-assoc ( timestamp singleton -- assoc )
-    (holidays) swap
-    '[ [ _ swap execute( ts -- ts' ) >gmt midnight ] keep ] { } map>assoc ;
+    (holidays) swap '[
+        [ _ clone swap execute( timestamp -- timestamp ) ] keep
+    ] { } map>assoc ;
 
 : holiday-name ( singleton word -- string/f )
     "holiday" word-prop at ;
 
 : holiday-names ( timestamp/n singleton -- seq )
     [
-        [ >gmt midnight ] dip
+        [ clone ] dip
         [ drop ] [ holiday-assoc ] 2bi swap
         '[ drop _ same-day? ] assoc-filter values
     ] keep '[ _ swap "holiday" word-prop at ] map ;

diff --git a/extra/calendar/holidays/us/us.factor b/extra/calendar/holidays/us/us.factor
index 9ad2ecc5b220777591abbaf9285462e98d88a030..350cf8154ed6abf3064437df3fed9d401c627852 100644 (file)
--- a/extra/calendar/holidays/us/us.factor
+++ b/extra/calendar/holidays/us/us.factor
@@ -10,18 +10,19 @@ SINGLETONS: us us-federal ;
 
 <PRIVATE
 
-: adjust-federal-holiday ( timestamp -- timestamp' )
+: adjust-federal-holiday ( timestamp -- timestamp )
     {
-        { [ dup saturday? ] [ 1 days time- ] }
-        { [ dup sunday? ] [ 1 days time+ ] }
+        { [ dup saturday? ] [ -1 days (time+) ] }
+        { [ dup sunday? ] [ 1 days (time+) ] }
         [ ]
     } cond ;
 
 PRIVATE>
 
 M: us-federal holidays
-    (holidays)
-    [ execute( timestamp -- timestamp' ) adjust-federal-holiday ] with map ;
+    (holidays) [
+        [ clone ] dip execute( timestamp -- timestamp ) adjust-federal-holiday
+    ] with map ;
 
 : us-post-office-open? ( timestamp -- ? )
     { [ sunday? not ] [ us-federal holiday? not ] } 1&& ;