calendar.holidays: simplify M\ all holidays.
parent
e257280abd
commit
9d19fb939a
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs calendar fry kernel locals parser
|
USING: accessors assocs calendar fry kernel locals parser
|
||||||
sequences vocabs words memoize ;
|
sequences vocabs words ;
|
||||||
IN: calendar.holidays
|
IN: calendar.holidays
|
||||||
|
|
||||||
SINGLETONS: all world commonwealth-of-nations ;
|
SINGLETONS: all world commonwealth-of-nations ;
|
||||||
|
@ -15,7 +15,10 @@ SYNTAX: HOLIDAY:
|
||||||
parse-definition ( timestamp/n -- timestamp ) define-declared ;
|
parse-definition ( timestamp/n -- timestamp ) define-declared ;
|
||||||
|
|
||||||
SYNTAX: HOLIDAY-NAME:
|
SYNTAX: HOLIDAY-NAME:
|
||||||
[let scan-word "holiday" word-prop :> holidays scan-word :> name scan-object :> value
|
[let
|
||||||
|
scan-word "holiday" word-prop :> holidays
|
||||||
|
scan-word :> name
|
||||||
|
scan-object :> value
|
||||||
value name holidays set-at ] ;
|
value name holidays set-at ] ;
|
||||||
>>
|
>>
|
||||||
|
|
||||||
|
@ -24,16 +27,14 @@ GENERIC: holidays ( n singleton -- seq )
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (holidays) ( singleton -- seq )
|
: (holidays) ( singleton -- seq )
|
||||||
all-words swap '[ "holiday" word-prop _ swap key? ] filter ;
|
all-words [ "holiday" word-prop key? ] with filter ;
|
||||||
|
|
||||||
M: object holidays
|
M: object holidays
|
||||||
(holidays) [ execute( timestamp -- timestamp' ) ] with map ;
|
(holidays) [ execute( timestamp -- timestamp' ) ] with map ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
M: all holidays
|
M: all holidays drop (holidays) ;
|
||||||
drop
|
|
||||||
all-words [ "holiday" word-prop key? ] with filter ;
|
|
||||||
|
|
||||||
: holiday? ( timestamp/n singleton -- ? )
|
: holiday? ( timestamp/n singleton -- ? )
|
||||||
[ holidays ] [ drop ] 2bi '[ _ same-day? ] any? ;
|
[ holidays ] [ drop ] 2bi '[ _ same-day? ] any? ;
|
||||||
|
|
Loading…
Reference in New Issue