[m-rev.] for review: add is_leap_year/1 and days_in_month/2

[Julien Fischer]

For review by anyone.

Add is_leap_year/1 and days_in_month/2.

Add a predicate to the calendar module for testing if a year is a leap year.
Use a more efficient method for determining this than the existing code
in the implementation of this module used (and replace that code with
a call to the new predicate).

Add the function days_to_month/2, which is a strongly typed wrapper
for the implementation function max_day_in_month_for/2.

Add a new test case covering basic operations in the calendar module,
together with the newly added operations.

library/calendar.m:
    As above.

NEWS.md:
    Announce the new additions.

tests/hard_coded/Mmakefile:
tests/hard_coded/calendar_basics.{m,exp}:
    Add the new test case.

Julien.

diff --git a/NEWS.md b/NEWS.md
index 5d49d2628..2e5f084be 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -224,6 +224,13 @@ Changes to the Mercury standard library
     - func `promise_only_solution/1`
     - pred `promise_only_solution_io/4`

+### Changes to the `calendar` module
+
+* The following function and predicate have been added:
+
+    - func `days_in_month/2`
+    - pred `is_leap_year/1`
+
 ### Changes to the `char` module

 * The following type has had its typeclass memberships changed:
diff --git a/library/calendar.m b/library/calendar.m
index 78f7f70e7..2affb0911 100644
--- a/library/calendar.m
+++ b/library/calendar.m
@@ -124,6 +124,24 @@
     %
 :- func month_to_int0(month) = int.

+    % days_in_month(Year, Month) = Days:
+    %
+    % Return the number of days in Month of Year in the proleptic
+    % Gregorian calendar.
+    %
+:- func days_in_month(year, month) = int.
+
+    % is_leap_year(Year):
+    %
+    % Succeed if-and-only-if Year is a leap year in the proleptic
+    % Gregorian calendar.
+    %
+    % A year is a leap year if it is divisible by 4, except that years
+    % divisible by 100 are not leap years, unless they are also divisible
+    % by 400.
+    %
+:- pred is_leap_year(year::in) is semidet.
+
 %---------------------%

     % init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date):
@@ -670,11 +688,37 @@ month_to_int(Month) = Int :-
 month_to_int0(Month) = Int :-
     int0_to_month(Int, Month).

+days_in_month(Year, Month) =
+    max_day_in_month_for(Year, month_to_int(Month)).
+
+is_leap_year(Year) :-
+    ( if Year /\ 3 = 0 then
+        % Year is divisible by 4.
+        ( if Year `unchecked_rem` 25 \= 0 then
+            % Year is not divisible by 25. Since it is divisible by 4
+            % but not by 25, it is not divisible by lcm(4, 25) = 100,
+            % so it is not a century year. All non-century years that are
+            % multiples of 4 are leap years.
+            true
+        else
+            % Year is divisible by both 4 and 25, therefore it is
+            % divisible by lcm(4, 25) = 100: it is a century year.
+            % A century year is a leap year only if it is divisible
+            % by 400. Since Year is already divisible by 100,
+            % it is divisible by 400 iff it is also divisible by
+            % lcm(100, 16) = 400, i.e. iff it is divisible by 16.
+            Year /\ 15 = 0
+        )
+    else
+        % Year is not divisible by 4, so it is not a leap year.
+        fail
+    ).
+
 %---------------------------------------------------------------------------%

 init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date) :-
     Day >= 1,
-    Day =< max_day_in_month_for(Year, month_to_int(Month)),
+    Day =< days_in_month(Year, Month),
     Hour >= 0,
     Hour < 24,
     Minute >= 0,
@@ -1089,7 +1133,7 @@ max_day_in_month_for(YearValue, MonthValue) = Max :-
             Max0 = 30
         ;
             M = 2,
-            ( if ( Y mod 400 = 0 ; ( Y mod 100 \= 0, Y mod 4 = 0 ) ) then
+            ( if is_leap_year(Y) then
                 Max0 = 29
             else
                 Max0 = 28
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 68cb61346..dc4e1b1ad 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -791,6 +791,7 @@ ifeq "$(findstring profdeep,$(GRADE))" ""
  bitwise_uint32 \
  bitwise_uint64 \
  bitwise_uint8 \
+ calendar_basics \
  calendar_init_date \
  char_to_string \
  clamp_int \
diff --git a/tests/hard_coded/calendar_basics.exp
b/tests/hard_coded/calendar_basics.exp
new file mode 100644
index 000000000..3beef968b
--- /dev/null
+++ b/tests/hard_coded/calendar_basics.exp
@@ -0,0 +1,109 @@
+=== Test det_int_to_month/2 ===
+
+det_int_to_month(-1) ==> EXCEPTION
+det_int_to_month(0) ==> EXCEPTION
+det_int_to_month(1) ==> january
+det_int_to_month(2) ==> february
+det_int_to_month(11) ==> november
+det_int_to_month(12) ==> december
+det_int_to_month(13) ==> EXCEPTION
+
+=== Test det_int0_to_month/2 ===
+
+det_int0_to_month(-1) ==> EXCEPTION
+det_int0_to_month(0) ==> january
+det_int0_to_month(1) ==> february
+det_int0_to_month(2) ==> march
+det_int0_to_month(11) ==> december
+det_int0_to_month(12) ==> EXCEPTION
+det_int0_to_month(13) ==> EXCEPTION
+
+=== Test int_to_month/2 ===
+
+int_to_month(-1) ==> FAILED
+int_to_month(0) ==> FAILED
+int_to_month(1) ==> january
+int_to_month(2) ==> february
+int_to_month(11) ==> november
+int_to_month(12) ==> december
+int_to_month(13) ==> FAILED
+
+=== Test int0_to_month/2 ===
+
+int0_to_month(-1) ==> FAILED
+int0_to_month(0) ==> january
+int0_to_month(1) ==> february
+int0_to_month(2) ==> march
+int0_to_month(11) ==> december
+int0_to_month(12) ==> FAILED
+int0_to_month(13) ==> FAILED
+
+=== Test month_to_int/1 ===
+
+month_to_int(january) = 1
+month_to_int(february) = 2
+month_to_int(march) = 3
+month_to_int(april) = 4
+month_to_int(may) = 5
+month_to_int(june) = 6
+month_to_int(july) = 7
+month_to_int(august) = 8
+month_to_int(september) = 9
+month_to_int(october) = 10
+month_to_int(november) = 11
+month_to_int(december) = 12
+
+=== Test month_to_int0/1 ===
+
+month_to_int0(january) = 0
+month_to_int0(february) = 1
+month_to_int0(march) = 2
+month_to_int0(april) = 3
+month_to_int0(may) = 4
+month_to_int0(june) = 5
+month_to_int0(july) = 6
+month_to_int0(august) = 7
+month_to_int0(september) = 8
+month_to_int0(october) = 9
+month_to_int0(november) = 10
+month_to_int0(december) = 11
+
+=== Test days_in_month/2 ===
+
+days_in_month(1977, january) = 31
+days_in_month(1977, february) = 28
+days_in_month(1977, march) = 31
+days_in_month(1977, april) = 30
+days_in_month(1977, may) = 31
+days_in_month(1977, june) = 30
+days_in_month(1977, july) = 31
+days_in_month(1977, august) = 31
+days_in_month(1977, september) = 30
+days_in_month(1977, october) = 31
+days_in_month(1977, november) = 30
+days_in_month(1977, december) = 31
+
+days_in_month(2000, january) = 31
+days_in_month(2000, february) = 29
+days_in_month(2000, march) = 31
+days_in_month(2000, april) = 30
+days_in_month(2000, may) = 31
+days_in_month(2000, june) = 30
+days_in_month(2000, july) = 31
+days_in_month(2000, august) = 31
+days_in_month(2000, september) = 30
+days_in_month(2000, october) = 31
+days_in_month(2000, november) = 30
+days_in_month(2000, december) = 31
+
+=== Test is_leap_year/1 ===
+
+Year 2000 is a leap year.
+Year 1900 is a common year.
+Year 2024 is a leap year.
+Year 2023 is a common year.
+Year 0 is a leap year.
+Year -1 is a common year.
+Year -4 is a leap year.
+Year -100 is a common year.
+
diff --git a/tests/hard_coded/calendar_basics.m
b/tests/hard_coded/calendar_basics.m
new file mode 100644
index 000000000..0c0901f98
--- /dev/null
+++ b/tests/hard_coded/calendar_basics.m
@@ -0,0 +1,179 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+
+:- module calendar_basics.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module calendar.
+:- import_module list.
+:- import_module string.
+
+%---------------------------------------------------------------------------%
+
+main(!IO) :-
+    test_det_int_to_month("det_int_to_month", det_int_to_month, !IO),
+    test_det_int_to_month("det_int0_to_month", det_int0_to_month, !IO),
+    test_int_to_month("int_to_month",
+        (pred(I::in, M::out) is semidet :- int_to_month(I, M)), !IO),
+    test_int_to_month("int0_to_month",
+        (pred(I::in, M::out) is semidet :- int0_to_month(I, M)), !IO),
+    test_month_to_int("month_to_int", month_to_int, !IO),
+    test_month_to_int("month_to_int0", month_to_int0, !IO),
+    test_days_in_month(!IO),
+    test_is_leap_year(!IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred test_det_int_to_month(string::in,
+    (func(int) = month)::in, io::di, io::uo) is cc_multi.
+
+test_det_int_to_month(Desc, Func, !IO) :-
+    io.format("=== Test %s/2 ===\n\n", [s(Desc)], !IO),
+    list.foldl(do_test_det_int_to_month(Desc, Func), ints, !IO),
+    io.nl(!IO).
+
+:- pred do_test_det_int_to_month(string::in,
+    (func(int) = month)::in, int::in, io::di, io::uo) is cc_multi.
+
+do_test_det_int_to_month(Desc, Func, Int, !IO) :-
+    io.format("%s(%d) ==> ", [s(Desc), i(Int)], !IO),
+    ( try []
+        Month = Func(Int)
+    then
+        io.format("%s\n", [s(string(Month))], !IO)
+    catch_any _ ->
+        io.write_string("EXCEPTION\n", !IO)
+    ).
+
+%---------------------------------------------------------------------------%
+
+:- pred test_int_to_month(string::in,
+    pred(int, month)::in(pred(in, out) is semidet), io::di, io::uo) is det.
+
+test_int_to_month(Desc, Pred, !IO) :-
+    io.format("=== Test %s/2 ===\n\n", [s(Desc)], !IO),
+    list.foldl(do_test_int_to_month(Desc, Pred), ints, !IO),
+    io.nl(!IO).
+
+:- pred do_test_int_to_month(string::in,
+    pred(int, month)::in(pred(in, out) is semidet), int::in,
+    io::di, io::uo) is det.
+
+do_test_int_to_month(Desc, Pred, Int, !IO) :-
+    io.format("%s(%d) ==> ", [s(Desc), i(Int)], !IO),
+    ( if Pred(Int, Month) then
+        io.format("%s\n", [s(string(Month))], !IO)
+    else
+        io.write_string("FAILED\n", !IO)
+    ).
+
+:- func ints = list(int).
+
+ints = [
+    -1,
+    0,
+    1,
+    2,
+    11,
+    12,
+    13
+].
+
+%---------------------------------------------------------------------------%
+
+:- pred test_month_to_int(string::in, (func(month) = int)::in,
+    io::di, io::uo) is det.
+
+test_month_to_int(Desc, Func, !IO) :-
+    io.format("=== Test %s/1 ===\n\n", [s(Desc)], !IO),
+    list.foldl(do_test_month_to_int(Desc, Func), months, !IO),
+    io.nl(!IO).
+
+:- pred do_test_month_to_int(string::in, (func(month) = int)::in, month::in,
+    io::di, io::uo) is det.
+
+do_test_month_to_int(Desc, Func, Month, !IO) :-
+    Int = Func(Month),
+    io.format("%s(%s) = %d\n", [s(Desc), s(string(Month)), i(Int)], !IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred test_days_in_month(io::di, io::uo) is det.
+
+test_days_in_month(!IO) :-
+    io.write_string("=== Test days_in_month/2 ===\n\n", !IO),
+    list.foldl(do_test_days_in_month, [1977, 2000], !IO).
+
+:- pred do_test_days_in_month(year::in, io::di, io::uo) is det.
+
+do_test_days_in_month(Year, !IO) :-
+    list.foldl(do_test_days_in_month_2(Year), months, !IO),
+    io.nl(!IO).
+
+:- pred do_test_days_in_month_2(year::in, month::in, io::di, io::uo) is det.
+
+do_test_days_in_month_2(Year, Month, !IO) :-
+    DaysInMonth = days_in_month(Year, Month),
+    io.format("days_in_month(%d, %s) = %d\n",
+        [i(Year), s(string(Month)), i(DaysInMonth)], !IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred test_is_leap_year(io::di, io::uo) is det.
+
+test_is_leap_year(!IO) :-
+    io.write_string("=== Test is_leap_year/1 ===\n\n", !IO),
+    list.foldl(do_test_is_leap_year, test_years, !IO),
+    io.nl(!IO).
+
+:- pred do_test_is_leap_year(year::in, io::di, io::uo) is det.
+
+do_test_is_leap_year(Year, !IO) :-
+    Desc = ( if is_leap_year(Year) then "leap" else "common" ),
+    io.format("Year %d is a %s year.\n", [i(Year), s(Desc)], !IO).
+
+:- func test_years = list(year).
+
+test_years = [
+    2000,   % Divisible by 400: leap year.
+    1900,   % Divisible by 100, but not by 100: common year.
+    2024,   % Divisible by 4, but not by 1000: leap year.
+    2023,   % Not divisible by 4: common year.
+       0,   % Divisible by 400: leap year.
+      -1,   % Not divisible by 4: common year.
+      -4,   % Divisible by 4: leap year.
+    -100    % Divisible by 100, but not 400: common year.
+].
+
+%---------------------------------------------------------------------------%
+
+:- func months = list(month).
+
+months = [
+    january,
+    february,
+    march,
+    april,
+    may,
+    june,
+    july,
+    august,
+    september,
+    october,
+    november,
+    december
+].
+
+%---------------------------------------------------------------------------%
+:- end_module calendar_basics.
+%---------------------------------------------------------------------------%