refactor calendar a bit, add initial docs

basis/calendar/calendar-docs.factor

@@ -0,0 +1,31 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math strings help.markup help.syntax
+calendar.backend ;
+IN: calendar
+
+HELP: duration
+{ $description "A duration is a period of time years, months, days, hours, minutes, and seconds.  All duration slots can store " { $link real } " numbers." } ;
+
+HELP: timestamp
+{ $description "A timestamp is a date and a time with a timezone offset.  Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } "." } ;
+
+{ timestamp duration } related-words
+
+HELP: gmt-offset-duration
+{ $values { "duration" duration } }
+{ $description "Returns a " { $link duration } " object with the GMT offset returned by " { $link gmt-offset } "." } ;
+
+HELP: <date>
+{ $values { "year" real } { "month" real } { "day" real } }
+{ $description "Returns a timestamp object representing the start of the specified day in your current timezone." }
+{ $examples
+    { $example "USE: calendar"
+               "12 25 2010 <date> ."
+                "T{ timestamp f 12 25 2010 0 0 0 T{ duration f 0 0 0 -5 0 0 }"
+    }
+} ;
+
+HELP: month-names
+{ $values { "array" array } }
+{ $description "Returns an array with the English names of all the months. January has a index of 1 instead of 0." } ;

basis/calendar/calendar.factor

@@ -1,52 +1,90 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-
 USING: arrays kernel math math.functions namespaces sequences
 strings system vocabs.loader calendar.backend threads
 accessors combinators locals classes.tuple math.order
-memoize ;
+memoize summary combinators.short-circuit ;
 IN: calendar
 
-TUPLE: timestamp year month day hour minute second gmt-offset ;
-
-C: <timestamp> timestamp
-
-TUPLE: duration year month day hour minute second ;
+TUPLE: duration
+    { year real }
+    { month real }
+    { day real }
+    { hour real }
+    { minute real }
+    { second real } ;
 
 C: <duration> duration
 
+TUPLE: timestamp
+    { year integer }
+    { month integer }
+    { day integer }
+    { hour integer }
+    { minute integer }
+    { second real }
+    { gmt-offset duration } ;
+
+C: <timestamp> timestamp
+
 : gmt-offset-duration ( -- duration )
     0 0 0 gmt-offset <duration> ;
 
 : <date> ( year month day -- timestamp )
     0 0 0 gmt-offset-duration <timestamp> ;
 
-: month-names
+ERROR: not-a-month n ;
+M: not-a-month summary
+    drop "Months are indexed starting at 1" ;
+
+<PRIVATE
+: check-month ( n -- n )
+    dup zero? [ not-a-month ] when ;
+PRIVATE>
+
+: month-names ( -- array )
     {
-        "Not a month" "January" "February" "March" "April" "May" "June"
+        "January" "February" "March" "April" "May" "June"
         "July" "August" "September" "October" "November" "December"
     } ;
 
-: month-abbreviations
+: month-name ( n -- string )
+    check-month 1- month-names nth ;
+
+: month-abbreviations ( -- array )
     {
-        "Not a month"
-        "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"
+        "Jan" "Feb" "Mar" "Apr" "May" "Jun"
+        "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"
     } ;
 
-: day-names
+: month-abbreviation ( n -- array )
+    check-month 1- month-abbreviations nth ;
+
+: day-names ( -- array )
     {
         "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"
     } ;
 
-: day-abbreviations2 { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ;
-: day-abbreviations3 { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ;
+: day-name ( n -- string ) day-names nth ;
 
-: average-month 30+5/12 ; inline
-: months-per-year 12 ; inline
-: days-per-year 3652425/10000 ; inline
-: hours-per-year 876582/100 ; inline
-: minutes-per-year 5259492/10 ; inline
-: seconds-per-year 31556952 ; inline
+: day-abbreviations2 ( -- array )
+    { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ;
+
+: day-abbreviation2 ( n -- string )
+    day-abbreviations2 nth ;
+
+: day-abbreviations3 ( -- array )
+    { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ;
+
+: day-abbreviation3 ( n -- string )
+    day-abbreviations3 nth ;
+
+: average-month ( -- ratio ) 30+5/12 ; inline
+: months-per-year ( -- integer ) 12 ; inline
+: days-per-year ( -- ratio ) 3652425/10000 ; inline
+: hours-per-year ( -- ratio ) 876582/100 ; inline
+: minutes-per-year ( -- ratio ) 5259492/10 ; inline
+: seconds-per-year ( -- integer ) 31556952 ; inline
 
 :: julian-day-number ( year month day -- n )
     #! Returns a composite date number
@@ -113,10 +151,12 @@ GENERIC: +second ( timestamp x -- timestamp )
     [ floor >integer ] keep over - ;
 
 : adjust-leap-year ( timestamp -- timestamp )
-    dup day>> 29 = over month>> 2 = pick leap-year? not and and
+    dup
+    { [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&&
     [ 3 >>month 1 >>day ] when ;
 
-: unless-zero >r dup zero? [ drop ] r> if ; inline
+: unless-zero ( n quot -- )
+    [ dup zero? [ drop ] ] dip if ; inline
 
 M: integer +year ( timestamp n -- timestamp )
     [ [ + ] curry change-year adjust-leap-year ] unless-zero ;

basis/calendar/format/format.factor

@@ -26,11 +26,11 @@ IN: calendar.format
 
 : DD ( time -- ) day>> write-00 ;
 
-: DAY ( time -- ) day-of-week day-abbreviations3 nth write ;
+: DAY ( time -- ) day-of-week day-abbreviation3 write ;
 
 : MM ( time -- ) month>> write-00 ;
 
-: MONTH ( time -- ) month>> month-abbreviations nth write ;
+: MONTH ( time -- ) month>> month-abbreviation write ;
 
 : YYYY ( time -- ) year>> write-0000 ;
 
@@ -57,7 +57,7 @@ GENERIC: month. ( obj -- )
 
 M: array month. ( pair -- )
     first2
-    [ month-names nth write bl number>string print ]
+    [ month-name write bl number>string print ]
     [ 1 zeller-congruence ]
     [ (days-in-month) day-abbreviations2 " " join print ] 2tri
     over "   " <repetition> concat write
@@ -191,7 +191,7 @@ ERROR: invalid-timestamp-format ;
         "," read-token day-abbreviations3 member? check-timestamp drop
         read1 CHAR: \s assert=
         read-sp checked-number >>day
-        read-sp month-abbreviations index check-timestamp >>month
+        read-sp month-abbreviations index 1+ check-timestamp >>month
         read-sp checked-number >>year
         ":" read-token checked-number >>hour
         ":" read-token checked-number >>minute
@@ -206,7 +206,7 @@ ERROR: invalid-timestamp-format ;
         "," read-token day-abbreviations3 member? check-timestamp drop
         read1 CHAR: \s assert=
         "-" read-token checked-number >>day
-        "-" read-token month-abbreviations index check-timestamp >>month
+        "-" read-token month-abbreviations index 1+ check-timestamp >>month
         read-sp checked-number >>year
         ":" read-token checked-number >>hour
         ":" read-token checked-number >>minute
@@ -219,7 +219,7 @@ ERROR: invalid-timestamp-format ;
 : (cookie-string>timestamp-2) ( -- timestamp )
     timestamp new
         read-sp day-abbreviations3 member? check-timestamp drop
-        read-sp month-abbreviations index check-timestamp >>month
+        read-sp month-abbreviations index 1+ check-timestamp >>month
         read-sp checked-number >>day
         ":" read-token checked-number >>hour
         ":" read-token checked-number >>minute