Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
0b4de37b63
|
|
@ -51,8 +51,16 @@ CONSTANT: month-names
|
|||
"July" "August" "September" "October" "November" "December"
|
||||
}
|
||||
|
||||
: month-name ( n -- string )
|
||||
check-month 1 - month-names nth ;
|
||||
<PRIVATE
|
||||
|
||||
: (month-name) ( n -- string ) 1 - month-names nth ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
GENERIC: month-name ( obj -- string )
|
||||
|
||||
M: integer month-name check-month 1 - month-names nth ;
|
||||
M: timestamp month-name month>> 1 - month-names nth ;
|
||||
|
||||
CONSTANT: month-abbreviations
|
||||
{
|
||||
|
|
@ -65,12 +73,8 @@ CONSTANT: month-abbreviations
|
|||
|
||||
CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 }
|
||||
|
||||
: day-names ( -- array )
|
||||
{
|
||||
"Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"
|
||||
} ;
|
||||
|
||||
: day-name ( n -- string ) day-names nth ;
|
||||
CONSTANT: day-names
|
||||
{ "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" }
|
||||
|
||||
CONSTANT: day-abbreviations2
|
||||
{ "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" }
|
||||
|
|
@ -317,6 +321,9 @@ GENERIC: time- ( time1 time2 -- time3 )
|
|||
M: timestamp <=> ( ts1 ts2 -- n )
|
||||
[ >gmt tuple-slots ] compare ;
|
||||
|
||||
: same-day? ( ts1 ts2 -- ? )
|
||||
[ >gmt >date< <date> ] bi@ = ;
|
||||
|
||||
: (time-) ( timestamp timestamp -- n )
|
||||
[ >gmt ] bi@
|
||||
[ [ >date< julian-day-number ] bi@ - 86400 * ] 2keep
|
||||
|
|
@ -399,6 +406,10 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
|
|||
: day-of-week ( timestamp -- n )
|
||||
>date< zeller-congruence ;
|
||||
|
||||
GENERIC: day-name ( obj -- string )
|
||||
M: integer day-name day-names nth ;
|
||||
M: timestamp day-name day-of-week day-names nth ;
|
||||
|
||||
:: (day-of-year) ( year month day -- n )
|
||||
day-counts month head-slice sum day +
|
||||
year leap-year? [
|
||||
|
|
@ -484,6 +495,14 @@ M: timestamp december clone 12 >>month ;
|
|||
: friday ( timestamp -- new-timestamp ) 5 day-this-week ;
|
||||
: saturday ( timestamp -- new-timestamp ) 6 day-this-week ;
|
||||
|
||||
: sunday? ( timestamp -- ? ) day-of-week 0 = ;
|
||||
: monday? ( timestamp -- ? ) day-of-week 1 = ;
|
||||
: tuesday? ( timestamp -- ? ) day-of-week 2 = ;
|
||||
: wednesday? ( timestamp -- ? ) day-of-week 3 = ;
|
||||
: thursday? ( timestamp -- ? ) day-of-week 4 = ;
|
||||
: friday? ( timestamp -- ? ) day-of-week 5 = ;
|
||||
: saturday? ( timestamp -- ? ) day-of-week 6 = ;
|
||||
|
||||
: 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 ;
|
||||
|
|
|
|||
|
|
@ -256,35 +256,22 @@ M: ppc %double>single-float FRSP ;
|
|||
M: ppc %unbox-alien ( dst src -- )
|
||||
alien-offset LWZ ;
|
||||
|
||||
M:: ppc %unbox-any-c-ptr ( dst src temp -- )
|
||||
M:: ppc %unbox-any-c-ptr ( dst src -- )
|
||||
[
|
||||
{ "is-byte-array" "end" "start" } [ define-label ] each
|
||||
! Address is computed in dst
|
||||
"end" define-label
|
||||
0 dst LI
|
||||
! Load object into scratch-reg
|
||||
scratch-reg src MR
|
||||
! We come back here with displaced aliens
|
||||
"start" resolve-label
|
||||
! Is the object f?
|
||||
0 scratch-reg \ f type-number CMPI
|
||||
! If so, done
|
||||
0 src \ f type-number CMPI
|
||||
"end" get BEQ
|
||||
! Compute tag in dst register
|
||||
dst src tag-mask get ANDI
|
||||
! Is the object an alien?
|
||||
0 scratch-reg header-offset LWZ
|
||||
0 0 alien type-number tag-fixnum CMPI
|
||||
"is-byte-array" get BNE
|
||||
! If so, load the offset
|
||||
0 scratch-reg alien-offset LWZ
|
||||
! Add it to address being computed
|
||||
dst dst 0 ADD
|
||||
! Now recurse on the underlying alien
|
||||
scratch-reg scratch-reg underlying-alien-offset LWZ
|
||||
"start" get B
|
||||
"is-byte-array" resolve-label
|
||||
! Add byte array address to address being computed
|
||||
dst dst scratch-reg ADD
|
||||
! Add an offset to start of byte array's data area
|
||||
dst dst byte-array-offset ADDI
|
||||
0 dst alien type-number CMPI
|
||||
! Add an offset to start of byte array's data
|
||||
dst src byte-array-offset ADDI
|
||||
"end" get BNE
|
||||
! If so, load the offset and add it to the address
|
||||
dst src alien-offset LWZ
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
|
|
@ -293,53 +280,84 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- )
|
|||
M:: ppc %box-alien ( dst src temp -- )
|
||||
[
|
||||
"f" define-label
|
||||
dst %load-immediate
|
||||
dst \ f type-number %load-immediate
|
||||
0 src 0 CMPI
|
||||
"f" get BEQ
|
||||
dst 5 cells alien temp %allot
|
||||
temp \ f type-number %load-immediate
|
||||
temp dst 1 alien@ STW
|
||||
temp dst 2 alien@ STW
|
||||
displacement dst 3 alien@ STW
|
||||
displacement dst 4 alien@ STW
|
||||
src dst 3 alien@ STW
|
||||
src dst 4 alien@ STW
|
||||
"f" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
|
||||
M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
|
||||
! This is ridiculous
|
||||
[
|
||||
"end" define-label
|
||||
"alloc" define-label
|
||||
"simple-case" define-label
|
||||
"not-f" define-label
|
||||
"not-alien" define-label
|
||||
|
||||
! If displacement is zero, return the base
|
||||
dst base MR
|
||||
0 displacement 0 CMPI
|
||||
"end" get BEQ
|
||||
! Quickly use displacement' before its needed for real, as allot temporary
|
||||
displacement' :> temp
|
||||
dst 4 cells alien temp %allot
|
||||
! If base is already a displaced alien, unpack it
|
||||
0 base \ f type-number CMPI
|
||||
"simple-case" get BEQ
|
||||
temp base header-offset LWZ
|
||||
0 temp alien type-number tag-fixnum CMPI
|
||||
"simple-case" get BNE
|
||||
! displacement += base.displacement
|
||||
temp base 3 alien@ LWZ
|
||||
displacement' displacement temp ADD
|
||||
! base = base.base
|
||||
base' base 1 alien@ LWZ
|
||||
"alloc" get B
|
||||
"simple-case" resolve-label
|
||||
displacement' displacement MR
|
||||
base' base MR
|
||||
"alloc" resolve-label
|
||||
! Store underlying-alien slot
|
||||
base' dst 1 alien@ STW
|
||||
! Store offset
|
||||
displacement' dst 3 alien@ STW
|
||||
! Store expired slot (its ok to clobber displacement')
|
||||
|
||||
! Displacement is non-zero, we're going to be allocating a new
|
||||
! object
|
||||
dst 5 cells alien temp %allot
|
||||
|
||||
! Set expired to f
|
||||
temp \ f type-number %load-immediate
|
||||
temp dst 2 alien@ STW
|
||||
|
||||
! Is base f?
|
||||
0 base \ f type-number CMPI
|
||||
"not-f" get BNE
|
||||
|
||||
! Yes, it is f. Fill in new object
|
||||
base dst 1 alien@ STW
|
||||
displacement dst 3 alien@ STW
|
||||
displacement dst 4 alien@ STW
|
||||
|
||||
"end" get B
|
||||
|
||||
"not-f" resolve-label
|
||||
|
||||
! Check base type
|
||||
temp base tag-mask get ANDI
|
||||
|
||||
! Is base an alien?
|
||||
0 temp alien type-number CMPI
|
||||
"not-alien" get BNE
|
||||
|
||||
! Yes, it is an alien. Set new alien's base to base.base
|
||||
temp base 1 alien@ LWZ
|
||||
temp dst 1 alien@ STW
|
||||
|
||||
! Compute displacement
|
||||
temp base 3 alien@ LWZ
|
||||
temp temp displacement ADD
|
||||
temp dst 3 alien@ STW
|
||||
|
||||
! Compute address
|
||||
temp base 4 alien@ LWZ
|
||||
temp temp displacement ADD
|
||||
temp dst 4 alien@ STW
|
||||
|
||||
! We are done
|
||||
"end" get B
|
||||
|
||||
! Is base a byte array? It has to be, by now...
|
||||
"not-alien" resolve-label
|
||||
|
||||
base dst 1 alien@ STW
|
||||
displacement dst 3 alien@ STW
|
||||
temp base byte-array-offset ADDI
|
||||
temp temp displacement ADD
|
||||
temp dst 4 alien@ STW
|
||||
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
|
|
|
|||
|
|
@ -116,8 +116,7 @@ M: pathname pprint*
|
|||
: check-recursion ( obj quot -- )
|
||||
nesting-limit? [
|
||||
drop
|
||||
"~" over class name>> "~" 3append
|
||||
swap present-text
|
||||
[ class name>> "~" dup surround ] keep present-text
|
||||
] [
|
||||
over recursion-check get member-eq? [
|
||||
drop "~circularity~" swap present-text
|
||||
|
|
@ -175,7 +174,7 @@ M: tuple pprint*
|
|||
: pprint-elements ( seq -- )
|
||||
do-length-limit
|
||||
[ [ pprint* ] each ] dip
|
||||
[ "~" swap number>string " more~" 3append text ] when* ;
|
||||
[ number>string "~" " more~" surround text ] when* ;
|
||||
|
||||
M: quotation pprint-delims drop \ [ \ ] ;
|
||||
M: curry pprint-delims drop \ [ \ ] ;
|
||||
|
|
|
|||
|
|
@ -11,8 +11,8 @@ VALUE: html-entities
|
|||
|
||||
: get-html ( -- table )
|
||||
{ "lat1" "special" "symbol" } [
|
||||
"vocab:xml/entities/html/xhtml-"
|
||||
swap ".ent" 3append read-entities-file
|
||||
"vocab:xml/entities/html/xhtml-" ".ent" surround
|
||||
read-entities-file
|
||||
] map first3 assoc-union assoc-union ;
|
||||
|
||||
get-html to: html-entities
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ H{ } clone sub-primitives set
|
|||
|
||||
"vocab:bootstrap/syntax.factor" parse-file
|
||||
|
||||
"vocab:cpu/" architecture get {
|
||||
architecture get {
|
||||
{ "x86.32" "x86/32" }
|
||||
{ "winnt-x86.64" "x86/64/winnt" }
|
||||
{ "unix-x86.64" "x86/64/unix" }
|
||||
|
|
@ -24,7 +24,7 @@ H{ } clone sub-primitives set
|
|||
{ "macosx-ppc" "ppc/macosx" }
|
||||
{ "arm" "arm" }
|
||||
} ?at [ "Bad architecture: " prepend throw ] unless
|
||||
"/bootstrap.factor" 3append parse-file
|
||||
"vocab:cpu/" "/bootstrap.factor" surround parse-file
|
||||
|
||||
"vocab:bootstrap/layouts/layouts.factor" parse-file
|
||||
|
||||
|
|
|
|||
|
|
@ -102,8 +102,8 @@ PRIVATE>
|
|||
[ 2 head ] dip append
|
||||
] }
|
||||
[
|
||||
[ trim-tail-separators "/" ] dip
|
||||
trim-head-separators 3append
|
||||
[ trim-tail-separators ]
|
||||
[ trim-head-separators ] bi* "/" glue
|
||||
]
|
||||
} cond ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 spin set-at ;
|
||||
>>
|
||||
|
||||
! 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
|
||||
: us-federal-holiday? ( timestamp/n -- ? )
|
||||
dup us-federal-holidays [ same-day? ] with any? ;
|
||||
|
||||
: memorial-day ( timestamp/n -- timestamp )
|
||||
may last-monday-of-month ; us-federal
|
||||
: canadian-holidays ( timestamp/n -- seq )
|
||||
canada find-holidays ;
|
||||
|
||||
: independence-day ( timestamp/n -- timestamp )
|
||||
july 4 >>day ; us-federal
|
||||
: post-office-open? ( timestamp -- ? )
|
||||
{ [ sunday? not ] [ us-federal-holiday? not ] } 1&& ;
|
||||
|
||||
: labor-day ( timestamp/n -- timestamp )
|
||||
september 1 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"
|
||||
|
||||
: columbus-day ( timestamp/n -- timestamp )
|
||||
october 2 monday-of-month ; us-federal
|
||||
HOLIDAY: martin-luther-king-day january 3 monday-of-month ;
|
||||
HOLIDAY-NAME: martin-luther-king-day us-federal "Martin Luther King Day"
|
||||
|
||||
: veterans'-day ( timestamp/n -- timestamp )
|
||||
november 11 >>day ; us-federal
|
||||
HOLIDAY: inauguration-day year dup 4 neg rem + january 20 >>day ;
|
||||
HOLIDAY-NAME: inauguration-day us "Inauguration Day"
|
||||
|
||||
: thanksgiving-day ( timestamp/n -- timestamp )
|
||||
november 4 thursday-of-month ; us-federal
|
||||
HOLIDAY: washington's-birthday february 3 monday-of-month ;
|
||||
HOLIDAY-NAME: washington's-birthday us-federal "Washington's Birthday"
|
||||
|
||||
: christmas-day ( timestamp/n -- timestamp )
|
||||
december 25 >>day ; us-federal
|
||||
HOLIDAY: memorial-day may last-monday-of-month ;
|
||||
HOLIDAY-NAME: memorial-day us-federal "Memorial Day"
|
||||
|
||||
! Other Holidays
|
||||
HOLIDAY: independence-day july 4 >>day ;
|
||||
HOLIDAY-NAME: independence-day us-federal "Independence Day"
|
||||
|
||||
: belly-laugh-day ( timestamp/n -- timestamp )
|
||||
january 24 >>day ;
|
||||
HOLIDAY: labor-day september 1 monday-of-month ;
|
||||
HOLIDAY-NAME: labor-day us-federal "Labor Day"
|
||||
|
||||
: groundhog-day ( timestamp/n -- timestamp )
|
||||
february 2 >>day ;
|
||||
HOLIDAY: columbus-day october 2 monday-of-month ;
|
||||
HOLIDAY-NAME: columbus-day us-federal "Columbus Day"
|
||||
|
||||
: lincoln's-birthday ( timestamp/n -- timestamp )
|
||||
february 12 >>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"
|
||||
|
||||
: valentine's-day ( timestamp/n -- timestamp )
|
||||
february 14 >>day ;
|
||||
HOLIDAY: thanksgiving-day november 4 thursday-of-month ;
|
||||
HOLIDAY-NAME: thanksgiving-day us-federal "Thanksgiving Day"
|
||||
|
||||
: st-patrick's-day ( timestamp/n -- timestamp )
|
||||
march 17 >>day ;
|
||||
HOLIDAY: canadian-thanksgiving-day october 2 monday-of-month ;
|
||||
HOLIDAY-NAME: canadian-thanksgiving-day canada "Thanksgiving Day"
|
||||
|
||||
: ash-wednesday ( timestamp/n -- timestamp )
|
||||
easter 46 days time- ;
|
||||
HOLIDAY: christmas-day december 25 >>day ;
|
||||
HOLIDAY-NAME: christmas-day world "Christmas Day"
|
||||
HOLIDAY-NAME: christmas-day us-federal "Christmas Day"
|
||||
|
||||
HOLIDAY: belly-laugh-day january 24 >>day ;
|
||||
|
||||
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 ;
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ IN: irc.client.internals
|
|||
irc> [ connect>> ] [ reconnect-attempts>> ] bi do-connect ;
|
||||
|
||||
: /JOIN ( channel password -- )
|
||||
[ " :" swap 3append ] when* "JOIN " prepend irc-print ;
|
||||
[ " :" glue ] when* "JOIN " prepend irc-print ;
|
||||
|
||||
: try-connect ( -- stream/f )
|
||||
irc> profile>> [ server>> ] [ port>> ] bi /CONNECT ;
|
||||
|
|
|
|||
|
|
@ -17,4 +17,4 @@ IN: mason.platform
|
|||
target-os get target-cpu get arch ;
|
||||
|
||||
: boot-image-name ( -- string )
|
||||
"boot." boot-image-arch ".image" 3append ;
|
||||
boot-image-arch "boot." ".image" surround ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue