Final calendar cleanup

extra/calendar/calendar-tests.factor

@@ -1,14 +1,15 @@
 USING: arrays calendar kernel math sequences tools.test
 continuations system ;
 
-! [ 2004 12 32 0   0  0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2004 12 32 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
-! [ 2004  2 30 0   0  0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2004  2 30 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
-! [ 2003  2 29 0   0  0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2003  2 29 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
-! [ 2004 -2  9 0   0  0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2004 -2  9 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
-! [ 2004 12  0 0   0  0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2004 12  0 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
-! [ 2004 12  1 24  0  0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2004 12  1 24  0  0 0 <timestamp> valid-timestamp? ] unit-test
-! [ 2004 12  1 23 60  0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2004 12  1 23 60  0 0 <timestamp> valid-timestamp? ] unit-test
-! [ 2004 12  1 23 59 60 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
+[ f ] [ 2004 12  1 23 59 60 0 <timestamp> valid-timestamp? ] unit-test
+[ t ] [ now valid-timestamp? ] unit-test
 
 [ f ] [ 1900 leap-year? ] unit-test
 [ t ] [ 1904 leap-year? ] unit-test

extra/calendar/calendar.factor

@@ -37,9 +37,12 @@ C: <duration> duration
 : day-abbreviations2 { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ;
 : day-abbreviations3 { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ;
 
-: average-month ( -- x )
+: average-month 30+5/12 ; inline
-    #! length of average month in days
+: months-per-year 12 ; inline
-    30.41666666666667 ;
+: days-per-year 3652425/10000 ; inline
+: hours-per-year 876582/100 ; inline
+: minutes-per-year 5259492/10 ; inline
+: seconds-per-year 31556952 ; inline
 
 <PRIVATE
 
@@ -129,7 +132,7 @@ M: integer +year ( timestamp n -- timestamp )
     [ [ + ] curry change-year adjust-leap-year ] unless-zero ;
 
 M: real +year ( timestamp n -- timestamp )
-    [ float>whole-part swapd 365.2425 * +day swap +year ] unless-zero ;
+    [ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ;
 
 : months/years ( n -- months years )
     12 /rem dup zero? [ drop 1- 12 ] when swap ; inline
@@ -191,33 +194,37 @@ M: timestamp time+
     >r clone r> (time+) drop ;
 
 M: duration time+
-    [ year>> ] +slots
+    dup timestamp? [
-    [ month>> ] +slots
+        swap time+
-    [ day>> ] +slots
+    ] [
-    [ hour>> ] +slots
+        [ year>> ] +slots
-    [ minute>> ] +slots
+        [ month>> ] +slots
-    [ second>> ] +slots
+        [ day>> ] +slots
-    2drop <duration> ;
+        [ hour>> ] +slots
+        [ minute>> ] +slots
+        [ second>> ] +slots
+        2drop <duration>
+    ] if ;
 
 : dt>years ( dt -- x )
     #! Uses average month/year length since dt loses calendar
     #! data
     0 swap
     [ year>> + ] keep
-    [ month>> 12 / + ] keep
+    [ month>> months-per-year / + ] keep
-    [ day>> 365.2425 / + ] keep
+    [ day>> days-per-year / + ] keep
-    [ hour>> 8765.82 / + ] keep
+    [ hour>> hours-per-year / + ] keep
-    [ minute>> 525949.2 / + ] keep
+    [ minute>> minutes-per-year / + ] keep
-    second>> 31556952.0 / + ;
+    second>> seconds-per-year / + ;
 
 M: duration <=> [ dt>years ] compare ;
 
-: dt>months ( dt -- x ) dt>years 12 * ;
+: dt>months ( dt -- x ) dt>years months-per-year * ;
-: dt>days ( dt -- x ) dt>years 365.2425 * ;
+: dt>days ( dt -- x ) dt>years days-per-year * ;
-: dt>hours ( dt -- x ) dt>years 8765.82 * ;
+: dt>hours ( dt -- x ) dt>years hours-per-year * ;
-: dt>minutes ( dt -- x ) dt>years 525949.2 * ;
+: dt>minutes ( dt -- x ) dt>years minutes-per-year * ;
-: dt>seconds ( dt -- x ) dt>years 31556952 * ;
+: dt>seconds ( dt -- x ) dt>years seconds-per-year * ;
-: dt>milliseconds ( dt -- x ) dt>years 31556952000 * ;
+: dt>milliseconds ( dt -- x ) dt>seconds 1000 * ;
 
 : convert-timezone ( timestamp n -- timestamp )
     over gmt-offset>> over = [ drop ] [
@@ -233,26 +240,16 @@ M: duration <=> [ dt>years ] compare ;
 M: timestamp <=> ( ts1 ts2 -- n )
     [ >gmt tuple-slots ] compare ;
 
-: time- ( timestamp timestamp -- seconds )
+: (time-) ( timestamp timestamp -- n )
-    #! Exact calendar-time difference
     [ >gmt ] 2apply
     [ [ >date< julian-day-number ] 2apply - 86400 * ] 2keep
     [ >time< >r >r 3600 * r> 60 * r> + + ] 2apply - + ;
 
-: unix-1970 ( -- timestamp )
+GENERIC: time- ( time1 time2 -- time )
-    1970 1 1 0 0 0 0 <timestamp> ; foldable
 
-: millis>timestamp ( n -- timestamp )
+M: timestamp time-
-    >r unix-1970 r> milliseconds time+ ;
+    #! Exact calendar-time difference
-
+    (time-) seconds ;
-: timestamp>millis ( timestamp -- n )
-    unix-1970 time- 1000 * >integer ;
-
-: gmt ( -- timestamp )
-    #! GMT time, right now
-    unix-1970 millis milliseconds time+ ;
-
-: now ( -- timestamp ) gmt >local-time ;
 
 : before ( dt -- -dt )
     [ year>>   neg ] keep
@@ -263,10 +260,34 @@ M: timestamp <=> ( ts1 ts2 -- n )
       second>> neg
     <duration> ;
 
-: from-now ( dt -- timestamp ) now swap time+ ;
+M: duration time-
-: ago ( dt -- timestamp ) before from-now ;
+    before time+ ;
 
-: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ;
+: <zero> 0 0 0 0 0 0 0 <timestamp> ;
+
+: valid-timestamp? ( timestamp -- ? )
+    clone 0 >>gmt-offset
+    dup <zero> time- <zero> time+ = ;
+
+: unix-1970 ( -- timestamp )
+    1970 1 1 0 0 0 0 <timestamp> ; foldable
+
+: millis>timestamp ( n -- timestamp )
+    >r unix-1970 r> milliseconds time+ ;
+
+: timestamp>millis ( timestamp -- n )
+    unix-1970 (time-) 1000 * >integer ;
+
+: gmt ( -- timestamp )
+    #! GMT time, right now
+    unix-1970 millis milliseconds time+ ;
+
+: now ( -- timestamp ) gmt >local-time ;
+
+: from-now ( dt -- timestamp ) now swap time+ ;
+: ago ( dt -- timestamp ) now swap time- ;
+
+: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
 
 : zeller-congruence ( year month day -- n )
     #! Zeller Congruence
@@ -347,7 +368,7 @@ M: timestamp day-of-year ( timestamp -- n )
 : beginning-of-year ( timestamp -- new-timestamp )
     beginning-of-month 1 >>month ;
 
-: seconds-since-midnight ( timestamp -- x )
+: time-since-midnight ( timestamp -- duration )
     dup beginning-of-day time- ;
 
 M: timestamp sleep-until timestamp>millis sleep-until ;

extra/project-euler/019/019.factor

@@ -45,25 +45,20 @@ IN: project-euler.019
 <PRIVATE
 
 : start-date ( -- timestamp )
-    1901 1 1 0 0 0 0 <timestamp> ;
+    1901 1 1 <date> ;
 
 : end-date ( -- timestamp )
-    2000 12 31 0 0 0 0 <timestamp> ;
+    2000 12 31 <date> ;
 
-: (first-days) ( end-date start-date -- )
+: first-days ( end-date start-date -- days )
-    2dup time- 0 >= [
+    [ 2dup after=? ]
-        dup day-of-week , 1 months time+ (first-days)
+    [ dup 1 months time+ swap day-of-week ]
-    ] [
+    [ ] unfold 2nip ;
-        2drop
-    ] if ;
-
-: first-days ( start-date end-date -- seq )
-    [ swap (first-days) ] { } make ;
 
 PRIVATE>
 
 : euler019a ( -- answer )
-    start-date end-date first-days [ zero? ] count ;
+    end-date start-date first-days [ zero? ] count ;
 
 ! [ euler019a ] 100 ave-time
 ! 131 ms run / 3 ms GC ave time - 100 trials

extra/windows/time/time.factor

@@ -23,7 +23,7 @@ IN: windows.time
 
 : timestamp>windows-time ( timestamp -- n )
     #! 64bit number representing # of nanoseconds since Jan 1, 1601 (UTC)
-    >gmt windows-1601 time- >integer 10000000 * ;
+    >gmt windows-1601 (time-) 10000000 * >integer ;
 
 : windows-time>FILETIME ( n -- FILETIME )
     "FILETIME" <c-object>