steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

remove duplicate defintion of unless-zero from calendar

Doug Coleman 2009-08-13 00:48:50 -05:00
parent 3aa4682301
commit 2f18c2a52b
1 changed files with 3 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/calendar/calendar.factor
View File

@ -34,14 +34,14 @@ C: <timestamp> timestamp
: <date> ( year month day -- timestamp ) : <date> ( year month day -- timestamp )
0 0 0 gmt-offset-duration <timestamp> ; 0 0 0 gmt-offset-duration <timestamp> ;
ERROR: not-a-month n ; ERROR: not-a-month ;
M: not-a-month summary M: not-a-month summary
drop "Months are indexed starting at 1" ; drop "Months are indexed starting at 1" ;
<PRIVATE <PRIVATE
: check-month ( n -- n ) : check-month ( n -- n )
dup zero? [ not-a-month ] when ; [ not-a-month ] when-zero ;
PRIVATE> PRIVATE>
@ -186,9 +186,6 @@ GENERIC: +second ( timestamp x -- timestamp )
{ [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&& { [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&&
[ 3 >>month 1 >>day ] when ; [ 3 >>month 1 >>day ] when ;
: unless-zero ( n quot -- )
[ dup zero? [ drop ] ] dip if ; inline
M: integer +year ( timestamp n -- timestamp ) M: integer +year ( timestamp n -- timestamp )
[ [ + ] curry change-year adjust-leap-year ] unless-zero ; [ [ + ] curry change-year adjust-leap-year ] unless-zero ;
@ -196,7 +193,7 @@ M: real +year ( timestamp n -- timestamp )
[ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ; [ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ;
: months/years ( n -- months years ) : months/years ( n -- months years )
12 /rem dup zero? [ drop 1- 12 ] when swap ; inline 12 /rem [ 1 - 12 ] when-zero swap ; inline
M: integer +month ( timestamp n -- timestamp ) M: integer +month ( timestamp n -- timestamp )
[ over month>> + months/years [ >>month ] dip +year ] unless-zero ; [ over month>> + months/years [ >>month ] dip +year ] unless-zero ;