refactor calendar a bit, add initial docs

diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor
new file mode 100644 (file)
index 0000000..0d335d1
--- /dev/null
+++ b/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." } ;

diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor
index 0abc00b4a44561ae3dffedeb5cca2ae3e8dcf619..402542de3bfc71346902ad9410bce2f4a1a562ff 100755 (executable)
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@@ -1,19 +1,31 @@
 ! 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 ;
+TUPLE: duration
+    { year real }
+    { month real }
+    { day real }
+    { hour real }
+    { minute real }
+    { second real } ;
 
-C: <timestamp> timestamp
+C: <duration> duration
 
-TUPLE: duration year month day hour minute second ;
+TUPLE: timestamp
+    { year integer }
+    { month integer }
+    { day integer }
+    { hour integer }
+    { minute integer }
+    { second real }
+    { gmt-offset duration } ;
 
-C: <duration> duration
+C: <timestamp> timestamp
 
 : gmt-offset-duration ( -- duration )
     0 0 0 gmt-offset <duration> ;
@@ -21,32 +33,58 @@ C: <duration> 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 ;
+
+: 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 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
+: 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 ;

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