calendar: fix end-of-week modifying the input

diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor
index 20321455998419d28833063b731993099e22fdf7..51476b0d6969494d6404839ca10cfedcadbd091d 100644 (file)
--- a/basis/calendar/calendar-tests.factor
+++ b/basis/calendar/calendar-tests.factor
@@ -437,3 +437,15 @@ IN: calendar
     2000 1 1 <date> 4 >>hour
     2000 1 1 <date> same-day?
 ] unit-test
+
+{
+    T{ timestamp { year 2023 } { month 4 } { day 9 } }
+    T{ timestamp
+        { year 2023 }
+        { month 4 }
+        { day 15 }
+        { hour 23 }
+        { minute 59 }
+        { second 59+999/1000 }
+    }
+} [ 2023 4 13 <date-gmt> start-of-week dup end-of-week ] unit-test

diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor
index ae6af139709b1b08ebc7968c25530a0cb4977701..d7bbdd2a206d40682349fb4a14c7000b4b857b7e 100644 (file)
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@@ -14,8 +14,12 @@ ERROR: not-in-interval value interval ;
 
 HOOK: gmt-offset os ( -- hours minutes seconds )
 
+ALIAS: utc-offset gmt-offset
+
 HOOK: now-gmt os ( -- timestamp )
 
+ALIAS: now-utc now-gmt
+
 TUPLE: duration
     { year real }
     { month real }
@@ -76,12 +80,16 @@ M: timestamp clone (clone) [ clone ] change-gmt-offset ;
 : <date-gmt> ( year month day -- timestamp )
     0 0 0 instant <timestamp> ; inline
 
+ALIAS: <date-utc> <date-gmt>
+
 : <year> ( year -- timestamp )
     1 1 <date> ; inline
 
 : <year-gmt> ( year -- timestamp )
     1 1 <date-gmt> ; inline
 
+ALIAS: <year-utc> <year-gmt>
+
 CONSTANT: average-month 30+5/12
 CONSTANT: months-per-year 12
 CONSTANT: days-per-year 3652425/10000
@@ -499,8 +507,14 @@ ALIAS: start-of-day midnight
 : end-of-day ( timestamp -- timestamp' )
     clone 23 >>hour 59 >>minute 59+999/1000 >>second ; inline
 
+: first-day-of-month ( timestamp -- timestamp' )
+    clone 1 >>day ;
+
+: last-day-of-month ( timestamp -- timestamp' )
+    clone dup days-in-month >>day ; inline
+
 : start-of-month ( timestamp -- timestamp' )
-    midnight 1 >>day ; inline
+    midnight first-day-of-month ; inline
 
 : end-of-month ( timestamp -- timestamp' )
     [ end-of-day ] [ days-in-month ] bi >>day ;
@@ -511,12 +525,6 @@ ALIAS: start-of-day midnight
 : end-of-quarter ( timestamp -- timestamp' )
     dup quarter 1 - 3 * 3 + >>month end-of-month ; inline
 
-: first-day-of-month ( timestamp -- timestamp' )
-    clone 1 >>day ;
-
-: last-day-of-month ( timestamp -- timestamp' )
-    clone dup days-in-month >>day ; inline
-
 GENERIC: first-day-of-year ( object -- timestamp )
 M: timestamp first-day-of-year clone 1 >>month 1 >>day ;
 M: integer first-day-of-year <year> ;
@@ -579,7 +587,7 @@ M: integer last-day-of-year 12 31 <date> ;
     over day-of-week - ; inline
 
 : day-this-week ( timestamp n -- timestamp' )
-    day-offset days (time+) ;
+    day-offset days time+ ;
 
 : closest-day ( timestamp n -- timestamp' )
     [ dup day-of-week 7 swap - ] [ + 7 mod ] bi*