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. +%---------------------------------------------------------------------------%