Get rid of a -roll usage

diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor
index 6b1f02187d768759eaf55e001da313b2a33b5e2d..e7b0b6f43ada0dbf1a26d8683fcd4f8f20d3ed18 100755 (executable)
--- a/extra/calendar/calendar.factor
+++ b/extra/calendar/calendar.factor
@@ -303,41 +303,25 @@ GENERIC: days-in-year ( obj -- n )
 M: integer days-in-year ( year -- n ) leap-year? 366 365 ? ;
 M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
 
-GENERIC: days-in-month ( obj -- n )
+: (days-in-month) ( year month -- n )
+    dup 2 = [ drop leap-year? 29 28 ? ] [ nip day-counts nth ] if ;
 
-M: array days-in-month ( obj -- n )
-    first2 dup 2 = [
-        drop leap-year? 29 28 ?
-    ] [
-        nip day-counts nth
-    ] if ;
-
-M: timestamp days-in-month ( timestamp -- n )
-    >date< drop 2array days-in-month ;
-
-GENERIC: day-of-week ( obj -- n )
+: days-in-month ( timestamp -- n )
+    >date< drop (days-in-month) ;
 
-M: timestamp day-of-week ( timestamp -- n )
+: day-of-week ( timestamp -- n )
     >date< zeller-congruence ;
 
-M: array day-of-week ( array -- n )
-    first3 zeller-congruence ;
-
-GENERIC: day-of-year ( obj -- n )
-
-M: array day-of-year ( array -- n )
-    first3
-    3dup day-counts rot head-slice sum +
-    swap leap-year? [
-        -roll
-        pick 3 1 <date> >r <date> r>
+:: (day-of-year) ( year month day -- n )
+    day-counts month head-slice sum day +
+    year leap-year? [
+        year month day <date>
+        year 3 1 <date>
         after=? [ 1+ ] when
-    ] [
-        >r 3drop r>
-    ] if ;
+    ] when ;
 
-M: timestamp day-of-year ( timestamp -- n )
-    >date< 3array day-of-year ;
+: day-of-year ( timestamp -- n )
+    >date< (day-of-year) ;
 
 : day-offset ( timestamp m -- timestamp n )
     over day-of-week - ; inline

diff --git a/extra/calendar/format/format.factor b/extra/calendar/format/format.factor
index 15dee790066fa795173fcc9ed0462c5bafc22ce9..e2b6a280effd8a56b8aee9075da91e19cb92b8b8 100755 (executable)
--- a/extra/calendar/format/format.factor
+++ b/extra/calendar/format/format.factor
@@ -57,9 +57,9 @@ GENERIC: month. ( obj -- )
 \r
 M: array month. ( pair -- )\r
     first2\r
-    [ month-names nth write bl number>string print ] 2keep\r
-    [ 1 zeller-congruence ] 2keep\r
-    2array days-in-month day-abbreviations2 " " join print\r
+    [ month-names nth write bl number>string print ]\r
+    [ 1 zeller-congruence ]\r
+    [ (days-in-month) day-abbreviations2 " " join print ] 2tri\r
     over "   " <repetition> concat write\r
     [\r
         [ 1+ day. ] keep\r