%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2009-2010 The University of Melbourne. % Copyright (C) 2013-2019 The Mercury team. % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % % File: calendar.m. % Main authors: maclarty % Stability: low. % % Proleptic Gregorian calendar utilities. % % The Gregorian calendar is the calendar that is currently used by most of % the world. In this calendar, a year is a leap year if it is divisible by % 4, but not divisible by 100. The only exception is if the year is divisible % by 400, in which case it is a leap year. For example 1900 is not leap year, % while 2000 is. The proleptic Gregorian calendar is an extension of the % Gregorian calendar backward in time to before it was first introduced in % 1582. % %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- module calendar. :- interface. :- import_module io. %---------------------------------------------------------------------------% % A point on the Proleptic Gregorian calendar, to the nearest microsecond. % :- type date. % A more meaningful name for the above. % :- type date_time == date. % Date components. % :- type year == int. % Year 0 is 1 BC, -1 is 2 BC, etc. :- type day_of_month == int. % 1..31 depending on the month and year :- type hour == int. % 0..23 :- type minute == int. % 0..59 :- type second == int. % 0..61 (60 and 61 are for leap seconds) :- type microsecond == int. % 0..999999 :- type month ---> january ; february ; march ; april ; may ; june ; july ; august ; september ; october ; november ; december. :- type day_of_week ---> monday ; tuesday ; wednesday ; thursday ; friday ; saturday ; sunday. %---------------------% % Functions to retrieve the components of a date. % :- func year(date) = year. :- func month(date) = month. :- func day_of_month(date) = day_of_month. :- func day_of_week(date) = day_of_week. :- func hour(date) = hour. :- func minute(date) = minute. :- func second(date) = second. :- func microsecond(date) = microsecond. % int_to_month(Int, Month): % Int is the number of Month where months are numbered from 1-12. % :- pred int_to_month(int, month). :- mode int_to_month(in, out) is semidet. :- mode int_to_month(out, in) is det. % det_int_to_month(Int) returns the month corresponding to Int. % Throws an exception if Int is not in 1-12. % :- func det_int_to_month(int) = month. % int_to_month(Int, Month): % Int is the number of Month where months are numbered from 0-11. % :- pred int0_to_month(int, month). :- mode int0_to_month(in, out) is semidet. :- mode int0_to_month(out, in) is det. % det_int0_to_month(Int) returns the month corresponding to Int. % Throws an exception if Int is not in 0-11. % :- func det_int0_to_month(int) = month. % month_to_int(Month) returns the number of Month where months are % numbered from 1-12. % :- func month_to_int(month) = int. % month_to_int0(Month) returns the number of Month where months are % numbered from 0-11. % :- func month_to_int0(month) = int. %---------------------% % init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date): % Initialize a new date. Fails if the given date is invalid. % :- pred init_date(year::in, month::in, day_of_month::in, hour::in, minute::in, second::in, microsecond::in, date::out) is semidet. % Same as above, but throws an exception if the date is invalid. % :- func det_init_date(year, month, day_of_month, hour, minute, second, microsecond) = date. % Retrieve all the components of a date. % :- pred unpack_date(date::in, year::out, month::out, day_of_month::out, hour::out, minute::out, second::out, microsecond::out) is det. %---------------------% % Convert a string of the form "YYYY-MM-DD HH:MM:SS.mmmmmm" to a date. % The microseconds component (.mmmmmm) is optional. % :- pred date_from_string(string::in, date::out) is semidet. % Same as above, but throws an exception if the string is not a valid date. % :- func det_date_from_string(string) = date. % Convert a date to a string of the form "YYYY-MM-DD HH:MM:SS.mmmmmm". % If the microseconds component of the date is zero, then the % ".mmmmmm" part is omitted. % :- func date_to_string(date) = string. %---------------------% % Get the current local time. % :- pred current_local_time(date::out, io::di, io::uo) is det. % Get the current UTC time. % :- pred current_utc_time(date::out, io::di, io::uo) is det. % Calculate the Julian day number for a date on the Gregorian calendar. % :- func julian_day_number(date) = int. % Returns 1970/01/01 00:00:00. % :- func unix_epoch = date. % same_date(A, B): % True iff A and B are equal with respect to only their date components. % The time components are ignored. % :- pred same_date(date::in, date::in) is semidet. %---------------------------------------------------------------------------% % % Durations. % % A period of time measured in years, months, days, hours, minutes, % seconds and microseconds. Internally a duration is represented % using only months, days, seconds and microseconds components. % :- type duration. % Duration components. % :- type years == int. :- type months == int. :- type days == int. :- type hours == int. :- type minutes == int. :- type seconds == int. :- type microseconds == int. % Functions to retrieve duration components. % :- func years(duration) = years. :- func months(duration) = months. :- func days(duration) = days. :- func hours(duration) = hours. :- func minutes(duration) = minutes. :- func seconds(duration) = seconds. :- func microseconds(duration) = microseconds. % init_duration(Years, Months, Days, Hours, Minutes, % Seconds, MicroSeconds) = Duration. % Create a new duration. All of the components should either be % non-negative or non-positive (they can all be zero). % :- func init_duration(years, months, days, hours, minutes, seconds, microseconds) = duration. % Retrieve all the components of a duration. % :- pred unpack_duration(duration::in, years::out, months::out, days::out, hours::out, minutes::out, seconds::out, microseconds::out) is det. % Return the zero length duration. % :- func zero_duration = duration. % Negate a duration. % :- func negate(duration) = duration. %---------------------% % Parse a duration string. % % The string should be of the form "PnYnMnDTnHnMnS" where each "n" is a % non-negative integer representing the number of years (Y), months (M), % days (D), hours (H), minutes (M) or seconds (S). The duration string % always starts with 'P' and the 'T' separates the date and time components % of the duration. A component may be omitted if it is zero, and the 'T' % separator is not required if all the time components are zero. % The second component may include a fraction component using a period. % This fraction component should not have a resolution higher than a % microsecond. % % For example the duration 1 year, 18 months, 100 days, 10 hours, 15 % minutes 90 seconds and 300 microseconds can be written as: % P1Y18M100DT10H15M90.0003S % while the duration 1 month and 2 days can be written as: % P1M2D % % Note that internally the duration is represented using only months, % days, seconds and microseconds, so that % duration_to_string(det_duration_from_string("P1Y18M100DT10H15M90.0003S")) % will result in the string "P2Y6M100DT10H16M30.0003S". % :- pred duration_from_string(string::in, duration::out) is semidet. % Same as above, but throws an exception if the duration string is invalid. % :- func det_duration_from_string(string) = duration. % Convert a duration to a string using the same representation % parsed by duration_from_string. % :- func duration_to_string(duration) = string. %---------------------% % Add a duration to a date. % % First the years and months are added to the date. % If this causes the day to be out of range (e.g. April 31), then it is % decreased until it is in range (e.g. April 30). Next the remaining % days, hours, minutes and seconds components are added. These could % in turn cause the month and year components of the date to change again. % :- pred add_duration(duration::in, date::in, date::out) is det. % This predicate implements a partial order relation on durations. % DurationA is less than or equal to DurationB iff for all of the % dates list below, adding DurationA to the date results in a date % less than or equal to the date obtained by adding DurationB. % % 1696-09-01 00:00:00 % 1697-02-01 00:00:00 % 1903-03-01 00:00:00 % 1903-07-01 00:00:00 % % There is only a partial order on durations, because some durations % cannot be said to be less than, equal to or greater than another duration % (e.g. 1 month vs. 30 days). % :- pred duration_leq(duration::in, duration::in) is semidet. % Get the difference between local and UTC time as a duration. % % local_time_offset(TZ, !IO) is equivalent to: % current_local_time(Local, !IO), % current_utc_time(UTC, !IO), % TZ = duration(UTC, Local) % except that it is as if the calls to current_utc_time and % current_local_time occurred at the same instant. % % To convert UTC time to local time, add the result of local_time_offset/3 % to UTC (using add_duration/3). To compute UTC given the local time, % first negate the result of local_time_offset/3 (using negate/1) and then % add it to the local time. % :- pred local_time_offset(duration::out, io::di, io::uo) is det. % duration(DateA, DateB) = Duration. % Find the duration between two dates using a "greedy" algorithm. % The algorithm is greedy in the sense that it will try to maximise each % component in the returned duration in the following order: years, months, % days, hours, minutes, seconds, microseconds. % The returned duration is positive if DateB is after DateA and negative % if DateB is before DateA. % Any leap seconds that occurred between the two dates are ignored. % The dates should be in the same timezone and in the same daylight % savings phase. To work out the duration between dates in different % timezones or daylight savings phases, first convert the dates to UTC. % % If the seconds components of DateA and DateB are < 60 then % add_duration(DateA, duration(DateA, DateB), DateB) will hold, but % add_duration(DateB, negate(duration(DateA, DateB)), DateA) may not hold. % For example if: % DateA = 2001-01-31 % DateB = 2001-02-28 % Duration = 1 month % then the following holds: % add_duration(duration(DateA, DateB), DateA, DateB) % but the following does not: % add_duration(negate(duration(DateA, DateB), DateB, DateA) % (Adding -1 month to 2001-02-28 will yield 2001-01-28). % :- func duration(date, date) = duration. % Same as above, except that the year and month components of the % returned duration will always be zero. The duration will be in terms % of days, hours, minutes, seconds and microseconds only. % :- func day_duration(date, date) = duration. %---------------------------------------------------------------------------% % % Folds over ranges of dates. % % foldl_days(Pred, Start, End, !Acc): % Calls Pred for each day in the range of dates from Start to End % with an accumulator. % Each date in the range is generated by adding a duration of one day % to the previous date using the add_duration/3 predicate. % Consequently, the time components of the dates in the range may % differ if the time components of the given start and end times % include leap seconds. % :- pred foldl_days(pred(date, A, A), date, date, A, A). :- mode foldl_days(pred(in, in, out) is det, in, in, in, out) is det. :- mode foldl_days(pred(in, mdi, muo) is det, in, in, mdi, muo) is det. :- mode foldl_days(pred(in, di, uo) is det, in, in, di, uo) is det. :- mode foldl_days(pred(in, in, out) is semidet, in, in, in, out) is semidet. :- mode foldl_days(pred(in, mdi, muo) is semidet, in, in, mdi, muo) is semidet. :- mode foldl_days(pred(in, di, uo) is semidet, in, in, di, uo) is semidet. % foldl2_days(Pred, Start, End, !Acc1, !Acc2): % As above, but with two accumulators. % :- pred foldl2_days(pred(date, A, A, B, B), date, date, A, A, B, B). :- mode foldl2_days(pred(in, in, out, in, out) is det, in, in, in, out, in, out) is det. :- mode foldl2_days(pred(in, in, out, mdi, muo) is det, in, in, in, out, mdi, muo) is det. :- mode foldl2_days(pred(in, in, out, di, uo) is det, in, in, in, out, di, uo) is det. :- mode foldl2_days(pred(in, in, out, in, out) is semidet, in, in, in, out, in, out) is semidet. :- mode foldl2_days(pred(in, in, out, mdi, muo) is semidet, in, in, in, out, mdi, muo) is semidet. :- mode foldl2_days(pred(in, in, out, di, uo) is semidet, in, in, in, out, di, uo) is semidet. % foldl3_days(Pred, Start, End, !Acc1, !Acc2, !Acc3): % As above, but with three accumulators. % :- pred foldl3_days(pred(date, A, A, B, B, C, C), date, date, A, A, B, B, C, C). :- mode foldl3_days(pred(in, in, out, in, out, in, out) is det, in, in, in, out, in, out, in, out) is det. :- mode foldl3_days(pred(in, in, out, in, out, mdi, muo) is det, in, in, in, out, in, out, mdi, muo) is det. :- mode foldl3_days(pred(in, in, out, in, out, di, uo) is det, in, in, in, out, in, out, di, uo) is det. :- mode foldl3_days(pred(in, in, out, in, out, in, out) is semidet, in, in, in, out, in, out, in, out) is semidet. :- mode foldl3_days(pred(in, in, out, in, out, mdi, muo) is semidet, in, in, in, out, in, out, mdi, muo) is semidet. :- mode foldl3_days(pred(in, in, out, in, out, di, uo) is semidet, in, in, in, out, in, out, di, uo) is semidet. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module char. :- import_module int. :- import_module list. :- import_module require. :- import_module string. :- import_module time. %---------------------------------------------------------------------------% :- type date ---> date( dt_year :: int, dt_month :: int, dt_day :: int, dt_hour :: int, dt_minute :: int, dt_second :: int, dt_microsecond :: int ). :- type duration ---> duration( % XXX I (zs) think that a duration should be expressed % purely in terms of units that have fixed length. % Seconds and microseconds qualify. Months do not, % since obviously different months have different lengths. % Even days do not have a fixed length in the presence of % leap seconds, though this module ignores those. dur_months :: int, dur_days :: int, dur_seconds :: int, dur_microseconds :: int ). %---------------------------------------------------------------------------% year(Date) = Date ^ dt_year. month(Date) = det_int_to_month(Date ^ dt_month). day_of_month(Date) = Date ^ dt_day. day_of_week(Date) = compute_day_of_week(Date). hour(Date) = Date ^ dt_hour. minute(Date) = Date ^ dt_minute. second(Date) = Date ^ dt_second. microsecond(Date) = Date ^ dt_microsecond. :- func compute_day_of_week(date) = day_of_week. compute_day_of_week(Date) = DayOfWeek :- % We compute the day of the week by working out the Julian day modulo 7. JDN = julian_day_number(Date), Mod = JDN mod 7, DayOfWeek = det_day_of_week_from_mod(Mod). :- func det_day_of_week_from_mod(int) = day_of_week. det_day_of_week_from_mod(Mod) = DayOfWeek :- ( if day_of_week_num(DayOfWeek0, Mod) then DayOfWeek = DayOfWeek0 else unexpected($pred, "invalid mod: " ++ int_to_string(Mod)) ). :- pred day_of_week_num(day_of_week, int). :- mode day_of_week_num(in, out) is det. :- mode day_of_week_num(out, in) is semidet. day_of_week_num(monday, 0). day_of_week_num(tuesday, 1). day_of_week_num(wednesday, 2). day_of_week_num(thursday, 3). day_of_week_num(friday, 4). day_of_week_num(saturday, 5). day_of_week_num(sunday, 6). int_to_month(1, january). int_to_month(2, february). int_to_month(3, march). int_to_month(4, april). int_to_month(5, may). int_to_month(6, june). int_to_month(7, july). int_to_month(8, august). int_to_month(9, september). int_to_month(10, october). int_to_month(11, november). int_to_month(12, december). det_int_to_month(Int) = ( if int_to_month(Int, Month) then Month else unexpected($pred, "invalid month: " ++ int_to_string(Int)) ). int0_to_month(Int, Month) :- int_to_month(Int + 1, Month). det_int0_to_month(Int) = ( if int0_to_month(Int, Month) then Month else unexpected($pred, "invalid month: " ++ int_to_string(Int)) ). month_to_int(Month) = Int :- int_to_month(Int, Month). month_to_int0(Month) = Int :- int0_to_month(Int, Month). %---------------------------------------------------------------------------% init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date) :- Day >= 1, Day =< max_day_in_month_for(Year, month_to_int(Month)), Hour < 24, Minute < 60, Second < 62, MicroSecond < 1000000, Date = date(Year, month_to_int(Month), Day, Hour, Minute, Second, MicroSecond). det_init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond) = Date :- ( if init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date0) then Date = Date0 else Msg = string.format("invalid date: %i-%i-%i %i:%i:%i", [i(Year), i(month_to_int(Month)), i(Day), i(Hour), i(Minute), i(Second)]), unexpected($pred, Msg) ). unpack_date(date(Year, Month, Day, Hour, Minute, Second, MicroSecond), Year, det_int_to_month(Month), Day, Hour, Minute, Second, MicroSecond). %---------------------------------------------------------------------------% date_from_string(Str, Date) :- some [!Chars] ( !:Chars = string.to_char_list(Str), ( if read_char((-), !.Chars, Rest1) then !:Chars = Rest1, read_int_and_num_chars(Year0, YearChars, !Chars), Year = -Year0 else read_int_and_num_chars(Year, YearChars, !Chars) ), YearChars >= 4, read_char((-), !Chars), read_int_and_num_chars(Month, 2, !Chars), Month >= 1, Month =< 12, read_char((-), !Chars), read_int_and_num_chars(Day, 2, !Chars), Day >= 1, Day =< max_day_in_month_for(Year, Month), read_char(' ', !Chars), read_int_and_num_chars(Hour, 2, !Chars), Hour >= 0, Hour =< 23, read_char((:), !Chars), read_int_and_num_chars(Minute, 2, !Chars), Minute >= 0, Minute =< 59, read_char((:), !Chars), read_int_and_num_chars(Second, 2, !Chars), Second < 62, read_microseconds(MicroSecond, !Chars), !.Chars = [], Date = date(Year, Month, Day, Hour, Minute, Second, MicroSecond) ). det_date_from_string(Str) = Date :- ( if date_from_string(Str, Date0) then Date = Date0 else unexpected($pred, "invalid date: " ++ Str) ). date_to_string(Date) = Str :- unpack_date(Date, Year0, Month, Day, Hour, Minute, Second, MicroSecond), ( if Year0 < 0 then SignStr = "-", Year = -Year0 else SignStr = "", Year = Year0 ), MicroSecondStr = microsecond_string(MicroSecond), Str = string.format("%s%04d-%02d-%02d %02d:%02d:%02d%s", [s(SignStr), i(Year), i(month_to_int(Month)), i(Day), i(Hour), i(Minute), i(Second), s(MicroSecondStr)]). %---------------------------------------------------------------------------% current_local_time(Now, !IO) :- time.time(TimeT, !IO), time.localtime(TimeT, TM, !IO), Now = tm_to_date(TM). current_utc_time(Now, !IO) :- time.time(TimeT, !IO), TM = time.gmtime(TimeT), Now = tm_to_date(TM). :- func tm_to_date(time.tm) = date. tm_to_date(TM) = Date :- TM = tm(TMYear, TMMonth, TMDay, TMHour, TMMinute, TMSecond, _, _, _), Year = 1900 + TMYear, Month = TMMonth + 1, Day = TMDay, Hour = TMHour, Minute = TMMinute, Second = TMSecond, Date = date(Year, Month, Day, Hour, Minute, Second, 0). julian_day_number(date(Year, Month, Day, _, _, _, _)) = JDN :- % The algorithm is described at % http://en.wikipedia.org/wiki/Julian_day. A = (14 - Month) div 12, Y = Year + 4800 - A, M = Month + 12 * A - 3, JDN = Day + ( 153 * M + 2 ) div 5 + 365 * Y + Y div 4 - Y div 100 + Y div 400 - 32045. unix_epoch = date(1970, 1, 1, 0, 0, 0, 0). same_date(A, B) :- A = date(Year, Month, Day, _, _, _, _), B = date(Year, Month, Day, _, _, _, _). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% years(Dur) = Dur ^ dur_months // 12. months(Dur) = Dur ^ dur_months rem 12. days(Dur) = Dur ^ dur_days. hours(Dur) = Dur ^ dur_seconds // 3600. minutes(Dur) = (Dur ^ dur_seconds rem 3600) // 60. seconds(Dur) = Dur ^ dur_seconds rem 60. microseconds(Dur) = Dur ^ dur_microseconds. init_duration(Years0, Months0, Days0, Hours0, Minutes0, Seconds0, MicroSeconds0) = Dur :- ( if ( Years0 >= 0, Months0 >= 0, Days0 >= 0, Hours0 >= 0, Minutes0 >= 0, Seconds0 >= 0, MicroSeconds0 >= 0 ; Years0 =< 0, Months0 =< 0, Days0 =< 0, Hours0 =< 0, Minutes0 =< 0, Seconds0 =< 0, MicroSeconds0 =< 0 ) then Months = Years0 * 12 + Months0, Seconds1 = Seconds0 + MicroSeconds0 // microseconds_per_second, MicroSeconds = MicroSeconds0 rem microseconds_per_second, Seconds2 = Seconds1 + Minutes0 * 60 + Hours0 * 3600, Days = Days0 + Seconds2 // seconds_per_day, Seconds = Seconds2 rem seconds_per_day, Dur = duration(Months, Days, Seconds, MicroSeconds) else unexpected($pred, "some components negative and some positive") ). :- func seconds_per_day = int. seconds_per_day = 86400. :- func microseconds_per_second = int. microseconds_per_second = 1000000. unpack_duration(Duration, years(Duration), months(Duration), days(Duration), hours(Duration), minutes(Duration), seconds(Duration), microseconds(Duration)). zero_duration = duration(0, 0, 0, 0). negate(duration(Months, Days, Seconds, MicroSeconds)) = duration(-Months, -Days, -Seconds, -MicroSeconds). %---------------------------------------------------------------------------% duration_from_string(Str, Duration) :- some [!Chars] ( !:Chars = string.to_char_list(Str), read_sign(Sign, !Chars), read_char('P', !Chars), read_years(Years, !Chars), read_months(Months, !Chars), read_days(Days, !Chars), ( if read_char('T', !.Chars, TimePart) then TimePart = [_ | _], read_hours(Hours, TimePart, !:Chars), read_minutes(Minutes, !Chars), read_seconds_and_microseconds(Seconds, MicroSeconds, !Chars), !.Chars = [], Duration = init_duration(Sign * Years, Sign * Months, Sign * Days, Sign * Hours, Sign * Minutes, Sign * Seconds, Sign * MicroSeconds) else !.Chars = [], Duration = init_duration(Sign * Years, Sign * Months, Sign * Days, 0, 0, 0, 0) ) ). det_duration_from_string(Str) = Duration :- ( if duration_from_string(Str, Duration0) then Duration = Duration0 else unexpected($pred, "invalid duration: " ++ Str) ). %---------------------------------------------------------------------------% duration_to_string(duration(Months, Days, Seconds, MicroSeconds) @ Duration) = Str :- ( if Months = 0, Days = 0, Seconds = 0, MicroSeconds = 0 then % At least one component must appear in the string. % The choice of days is arbitrary. Str = "P0D" else ( if Months >= 0, Days >= 0, Seconds >= 0, MicroSeconds >= 0 then Sign = 1, SignStr = "" else if Months =< 0, Days =< 0, Seconds =< 0, MicroSeconds =< 0 then Sign = -1, SignStr = "-" else unexpected($pred, "duration components have mixed signs") ), ( if Seconds = 0, MicroSeconds = 0 then TimePart = [] else TimePart = ["T", string_if_nonzero(Sign * hours(Duration), "H"), string_if_nonzero(Sign * minutes(Duration), "M"), seconds_duration_string(Sign * seconds(Duration), Sign * microseconds(Duration)) ] ), Str = string.append_list([ SignStr, "P", string_if_nonzero(Sign * years(Duration), "Y"), string_if_nonzero(Sign * months(Duration), "M"), string_if_nonzero(Sign * days(Duration), "D")] ++ TimePart) ). :- func string_if_nonzero(int, string) = string. string_if_nonzero(X, Suffix) = ( if X = 0 then "" else int_to_string(X) ++ Suffix ). :- func seconds_duration_string(seconds, microseconds) = string. seconds_duration_string(Seconds, MicroSeconds) = Str :- ( if Seconds = 0, MicroSeconds = 0 then Str = "" else Str = string.from_int(Seconds) ++ microsecond_string(MicroSeconds) ++ "S" ). :- func microsecond_string(microseconds) = string. microsecond_string(MicroSeconds) = Str :- ( if MicroSeconds > 0 then Str = rstrip_pred(unify('0'), string.format(".%06d", [i(MicroSeconds)])) else Str = "" ). %---------------------------------------------------------------------------% % % Adding durations to date times. % % The following is a fairly direct translation of the algorithm at % http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes. % add_duration(D, S, !:E) :- some [!Temp, !Carry] ( % Months !:Temp = S ^ dt_month + D ^ dur_months, EMonth = modulo(!.Temp, 1, 13), !:Carry = fquotient(!.Temp, 1, 13), % Years EYear = S ^ dt_year + !.Carry, % Microseconds !:Temp = S ^ dt_microsecond + D ^ dur_microseconds, EMicrosecond = modulo(!.Temp, microseconds_per_second), !:Carry = div(!.Temp, microseconds_per_second), % Seconds !:Temp = S ^ dt_second + D ^ dur_seconds + !.Carry, ESecond = modulo(!.Temp, 60), !:Carry = div(!.Temp, 60), % Minutes !:Temp = S ^ dt_minute + !.Carry, EMinute = int.mod(!.Temp, 60), !:Carry = int.div(!.Temp, 60), % Hours !:Temp = S ^ dt_hour + !.Carry, EHour = int.mod(!.Temp, 24), !:Carry = int.div(!.Temp, 24), % Days MaxDaysInMonth = max_day_in_month_for(EYear, EMonth), ( if S ^ dt_day > MaxDaysInMonth then TempDays = MaxDaysInMonth else if S ^ dt_day < 1 then TempDays = 1 else TempDays = S ^ dt_day ), EDay = TempDays + D ^ dur_days + !.Carry, !:E = date(EYear, EMonth, EDay, EHour, EMinute, ESecond, EMicrosecond), add_duration_loop(D, S, !E) ). :- pred add_duration_loop(duration::in, date::in, date::in, date::out) is det. add_duration_loop(D, S, !E) :- ( if !.E ^ dt_day < 1 then !E ^ dt_day := !.E ^ dt_day + max_day_in_month_for(!.E ^ dt_year, !.E ^ dt_month - 1), Carry = -1, Temp = !.E ^ dt_month + Carry, !E ^ dt_month := modulo(Temp, 1, 13), !E ^ dt_year := !.E ^ dt_year + fquotient(Temp, 1, 13), disable_warning [suspicious_recursion] ( add_duration_loop(D, S, !E) ) else if MaxDaysInMonth = max_day_in_month_for(!.E ^ dt_year, !.E ^ dt_month), !.E ^ dt_day > MaxDaysInMonth then !E ^ dt_day := !.E ^ dt_day - MaxDaysInMonth, Carry = 1, Temp = !.E ^ dt_month + Carry, !E ^ dt_month := modulo(Temp, 1, 13), !E ^ dt_year := !.E ^ dt_year + fquotient(Temp, 1, 13), disable_warning [suspicious_recursion] ( add_duration_loop(D, S, !E) ) else true ). :- func fquotient(int, int, int) = int. fquotient(A, Low, High) = int.div(A - Low, High - Low). :- func modulo(int, int) = int. modulo(A, B) = A - div(A, B) * B. :- func modulo(int, int, int) = int. modulo(A, Low, High) = modulo(A - Low, High - Low) + Low. :- func max_day_in_month_for(int, int) = int. max_day_in_month_for(YearValue, MonthValue) = Max :- M = int.mod(MonthValue - 1, 12) + 1, Y = YearValue + int.div(MonthValue - 1, 12), ( if ( ( M = 1 ; M = 3 ; M = 5 ; M = 7 ; M = 8 ; M = 10 ; M = 12 ), Max0 = 31 ; ( M = 4 ; M = 6 ; M = 9 ; M = 11 ), Max0 = 30 ; M = 2, ( if ( Y mod 400 = 0 ; ( Y mod 100 \= 0, Y mod 4 = 0 ) ) then Max0 = 29 else Max0 = 28 ) ) then Max = Max0 else % This should never happen. unexpected($pred, "unexpected value for M: " ++ string(M)) ). %---------------------------------------------------------------------------% duration_leq(DurA, DurB) :- % Partial relation on durations. This algorithm is described at % http://www.w3.org/TR/xmlschema-2/#duration. list.all_true( ( pred(TestDate::in) is semidet :- add_duration(DurA, TestDate, DateA), add_duration(DurB, TestDate, DateB), compare(CompRes, DateA, DateB), ( CompRes = (<) ; CompRes = (=) ) ), test_dates). % Returns dates used to compare durations. % :- func test_dates = list(date). test_dates = [ date(1696, 9, 1, 0, 0, 0, 0), date(1697, 2, 1, 0, 0, 0, 0), date(1903, 3, 1, 0, 0, 0, 0), date(1903, 7, 1, 0, 0, 0, 0) ]. local_time_offset(TZ, !IO) :- time.time(TimeT, !IO), time.localtime(TimeT, LocalTM, !IO), GMTM = time.gmtime(TimeT), LocalTime = tm_to_date(LocalTM), GMTime = tm_to_date(GMTM), TZ = duration(GMTime, LocalTime). %---------------------------------------------------------------------------% % % Computing the duration between two dates. % duration(DateA, DateB) = Duration :- compare(CompResult, DateB, DateA), ( CompResult = (<), greedy_subtract_descending(ascending, DateA, DateB, Duration0), Duration = negate(Duration0) ; CompResult = (=), Duration = zero_duration ; CompResult = (>), greedy_subtract_descending(descending, DateB, DateA, Duration) ). :- type order ---> ascending ; descending. % This predicate has the precondition that DateA < DateB. OriginalOrder is % the original order of the date arguments (descending means that in the % original call DateA < DateB, while ascending means that in the original % call DateA > DateB). This is needed to correctly compute the days % component of the resulting duration. The calculation is different % depending on the original order, because we want the invariant: % add_duration(duration(DateA, DateB), DateA, DateB) % to hold, and in the case where DateA > DateB, Duration will be negative. % :- pred greedy_subtract_descending(order::in, date::in, date::in, duration::out) is det. greedy_subtract_descending(OriginalOrder, DateA, DateB, Duration) :- some [!Borrow] ( MicroSecondA = DateA ^ dt_microsecond, MicroSecondB = DateB ^ dt_microsecond, subtract_ints_with_borrow(microseconds_per_second, MicroSecondA, MicroSecondB, MicroSeconds, !:Borrow), SecondA = DateA ^ dt_second - !.Borrow, SecondB = DateB ^ dt_second, subtract_ints_with_borrow(60, SecondA, SecondB, Seconds, !:Borrow), MinuteA = DateA ^ dt_minute - !.Borrow, MinuteB = DateB ^ dt_minute, subtract_ints_with_borrow(60, MinuteA, MinuteB, Minutes, !:Borrow), HourA = DateA ^ dt_hour - !.Borrow, HourB = DateB ^ dt_hour, subtract_ints_with_borrow(24, HourA, HourB, Hours, !:Borrow), ( OriginalOrder = descending, add_duration(duration(0, -1, 0, 0), DateA, DateAMinus1Month), DaysToBorrow = max_day_in_month_for(DateAMinus1Month ^ dt_year, DateAMinus1Month ^ dt_month), DateAEndOfMonth = max_day_in_month_for(DateA ^ dt_year, DateA ^ dt_month), DayA = DateA ^ dt_day - !.Borrow, DayB = int.min(DateB ^ dt_day, DateAEndOfMonth) ; OriginalOrder = ascending, DaysToBorrow = max_day_in_month_for(DateB ^ dt_year, DateB ^ dt_month), DateBEndOfMonth = max_day_in_month_for(DateB ^ dt_year, DateB ^ dt_month), DayA = int.min(DateA ^ dt_day - !.Borrow, DateBEndOfMonth), DayB = DateB ^ dt_day ), subtract_ints_with_borrow(DaysToBorrow, DayA, DayB, Days, !:Borrow), MonthA = DateA ^ dt_month - !.Borrow, MonthB = DateB ^ dt_month, subtract_ints_with_borrow(12, MonthA, MonthB, Months, !:Borrow), YearA = DateA ^ dt_year - !.Borrow, YearB = DateB ^ dt_year, ( if YearA >= YearB then Years = YearA - YearB else % If this happens, then DateA < DateB, which violates % a precondition of this predicate. unexpected($pred, "left over years") ), Duration = init_duration(Years, Months, Days, Hours, Minutes, Seconds, MicroSeconds) ). % subtract_ints_with_borrow(BorrowAmount, Val1, Val2, Val, Borrow): % Subtract Val2 from Val1, possibly borrowing BorrowAmount if Val1 < Val2. % If an amount is borrowed, then Borrow is set to 1, otherwise it is set % to 0. % :- pred subtract_ints_with_borrow(int::in, int::in, int::in, int::out, int::out) is det. subtract_ints_with_borrow(BorrowVal, Val1, Val2, Diff, Borrow) :- ( if Val1 >= Val2 then Borrow = 0, Diff = Val1 - Val2 else Borrow = 1, Diff = BorrowVal + Val1 - Val2 ). day_duration(DateA, DateB) = Duration :- builtin.compare(CompResult, DateB, DateA), ( CompResult = (<), Duration0 = do_day_duration(DateB, DateA), Duration = negate(Duration0) ; CompResult = (=), Duration = zero_duration ; CompResult = (>), Duration = do_day_duration(DateA, DateB) ). :- func do_day_duration(date, date) = duration. do_day_duration(DateA, DateB) = Duration :- some [!Borrow] ( MicroSecond1 = DateB ^ dt_microsecond, MicroSecond2 = DateA ^ dt_microsecond, subtract_ints_with_borrow(microseconds_per_second, MicroSecond1, MicroSecond2, MicroSeconds, !:Borrow), Second1 = DateB ^ dt_second - !.Borrow, Second2 = DateA ^ dt_second, subtract_ints_with_borrow(60, Second1, Second2, Seconds, !:Borrow), Minute1 = DateB ^ dt_minute - !.Borrow, Minute2 = DateA ^ dt_minute, subtract_ints_with_borrow(60, Minute1, Minute2, Minutes, !:Borrow), Hour1 = DateB ^ dt_hour - !.Borrow, Hour2 = DateA ^ dt_hour, subtract_ints_with_borrow(24, Hour1, Hour2, Hours, !:Borrow), JDN1 = julian_day_number(DateB), JDN2 = julian_day_number(DateA), Days = JDN1 - !.Borrow - JDN2, Duration = init_duration(0, 0, Days, Hours, Minutes, Seconds, MicroSeconds) ). %---------------------------------------------------------------------------% foldl_days(Pred, !.Curr, End, !Acc) :- compare(Res, !.Curr, End), ( ( Res = (<) ; Res = (=) ), Pred(!.Curr, !Acc), add_duration(init_duration(0, 0, 1, 0, 0, 0, 0), !Curr), disable_warning [suspicious_recursion] ( foldl_days(Pred, !.Curr, End, !Acc) ) ; Res = (>) ). foldl2_days(Pred, !.Curr, End, !Acc1, !Acc2) :- compare(Res, !.Curr, End), ( ( Res = (<) ; Res = (=) ), Pred(!.Curr, !Acc1, !Acc2), add_duration(init_duration(0, 0, 1, 0, 0, 0, 0), !Curr), disable_warning [suspicious_recursion] ( foldl2_days(Pred, !.Curr, End, !Acc1, !Acc2) ) ; Res = (>) ). foldl3_days(Pred, !.Curr, End, !Acc1, !Acc2, !Acc3) :- compare(Res, !.Curr, End), ( ( Res = (<) ; Res = (=) ), Pred(!.Curr, !Acc1, !Acc2, !Acc3), add_duration(init_duration(0, 0, 1, 0, 0, 0, 0), !Curr), disable_warning [suspicious_recursion] ( foldl3_days(Pred, !.Curr, End, !Acc1, !Acc2, !Acc3) ) ; Res = (>) ). %---------------------------------------------------------------------------% % % Parsing predicates. % :- pred read_microseconds(microseconds::out, list(char)::in, list(char)::out) is det. read_microseconds(MicroSeconds, !Chars) :- ( if read_char((.), !.Chars, Chars1), read_int_and_num_chars(Fraction, FractionDigits, Chars1, !:Chars), FractionDigits > 0, FractionDigits < 7 then MicroSeconds = int.pow(10, 6 - FractionDigits) * Fraction else MicroSeconds = 0 ). :- pred read_int_and_num_chars(int::out, int::out, list(char)::in, list(char)::out) is det. read_int_and_num_chars(Val, N, !Chars) :- read_int_and_num_chars_2(0, Val, 0, N, !Chars). :- pred read_int_and_num_chars_2(int::in, int::out, int::in, int::out, list(char)::in, list(char)::out) is det. read_int_and_num_chars_2(!Val, !N, !Chars) :- ( if !.Chars = [Char | Rest], decimal_digit_to_int(Char, Digit) then !:Val = !.Val * 10 + Digit, read_int_and_num_chars_2(!Val, !.N + 1, !:N, Rest, !:Chars) else true ). :- pred read_sign(int::out, list(char)::in, list(char)::out) is det. read_sign(Sign, !Chars) :- ( if !.Chars = [(-) | Rest] then !:Chars = Rest, Sign = -1 else Sign = 1 ). :- pred read_char(char::out, list(char)::in, list(char)::out) is semidet. read_char(Char, [Char | Rest], Rest). :- pred read_years(int::out, list(char)::in, list(char)::out) is det. read_years(Years, !Chars) :- read_int_and_char_or_zero(Years, 'Y', !Chars). :- pred read_months(int::out, list(char)::in, list(char)::out) is det. read_months(Months, !Chars) :- read_int_and_char_or_zero(Months, 'M', !Chars). :- pred read_days(int::out, list(char)::in, list(char)::out) is det. read_days(Days, !Chars) :- read_int_and_char_or_zero(Days, 'D', !Chars). :- pred read_hours(int::out, list(char)::in, list(char)::out) is det. read_hours(Hours, !Chars) :- read_int_and_char_or_zero(Hours, 'H', !Chars). :- pred read_minutes(int::out, list(char)::in, list(char)::out) is det. read_minutes(Minutes, !Chars) :- read_int_and_char_or_zero(Minutes, 'M', !Chars). :- pred read_seconds_and_microseconds(seconds::out, microseconds::out, list(char)::in, list(char)::out) is det. read_seconds_and_microseconds(Seconds, MicroSeconds, !Chars) :- ( if read_int(Seconds0, !.Chars, Chars1), read_microseconds(MicroSeconds0, Chars1, Chars2), read_char('S', Chars2, Chars3) then !:Chars = Chars3, Seconds = Seconds0, MicroSeconds = MicroSeconds0 else Seconds = 0, MicroSeconds = 0 ). :- pred read_int_and_char_or_zero(int::out, char::in, list(char)::in, list(char)::out) is det. read_int_and_char_or_zero(Int, Char, !Chars) :- ( if read_int(Int0, !.Chars, Chars1), Chars1 = [Char | Rest] then !:Chars = Rest, Int = Int0 else Int = 0 ). :- pred read_int(int::out, list(char)::in, list(char)::out) is det. read_int(Val, !Chars) :- read_int_2(0, Val, !Chars). :- pred read_int_2(int::in, int::out, list(char)::in, list(char)::out) is det. read_int_2(!Val, !Chars) :- ( if !.Chars = [Char | Rest], decimal_digit_to_int(Char, Digit) then !:Val = !.Val * 10 + Digit, read_int_2(!Val, Rest, !:Chars) else true ). %---------------------------------------------------------------------------% :- end_module calendar. %---------------------------------------------------------------------------%