[m-rev.] for review: new calendar standard library module
Ian MacLarty
maclarty at csse.unimelb.edu.au
Mon Feb 2 13:26:02 AEDT 2009
Here is a new version of the calendar module for review.
Julien, it turned out that char.int_to_digit did not do what I wanted,
because it succeeds for non-decimal digits too.
Paul, I decided to include days in the internal representation of
durations simply because this allows more range. If we represent
days using the seconds component only, then we can only represent up to around
23000 days on a 32 bit machine.
The interdiff is at the end of this email.
Ian.
===================================================================
Estimated hours taken: 4
Branches: main
Add a new standard library module for working with the Gregorian
calendar.
NEWS:
Mention the new module.
library/calendar.m:
The new module.
library/library.m:
Add the new module to the list of standard library modules.
tests/hard_coded/Mmakefile:
tests/hard_coded/calendar_test.exp:
tests/hard_coded/calendar_test.m:
Test the new module.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.499
diff -u -r1.499 NEWS
--- NEWS 12 Jan 2009 02:28:45 -0000 1.499
+++ NEWS 2 Feb 2009 01:54:13 -0000
@@ -235,6 +235,9 @@
map.from_sorted_assoc_list now also constructs the tree directly, so now
it requires its input list to be duplicate-free.
+* We have added a calendar module to the standard library. This module
+ contains utilities for working with the Gregorian calendar.
+
Changes to the Mercury compiler:
* We have added support for trail segments, which allow programs to grow
Index: library/calendar.m
===================================================================
RCS file: library/calendar.m
diff -N library/calendar.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/calendar.m 2 Feb 2009 02:21:57 -0000
@@ -0,0 +1,1093 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2009 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% 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.
+
+ % 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.
+
+ % 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 aborts 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 aborts 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.
+
+ % 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.
+
+ % Retrive 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 aborts 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 occured 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 occured 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.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char.
+:- import_module float.
+:- 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(
+ dur_months :: int,
+ dur_days :: int,
+ dur_seconds :: int,
+ dur_microseconds :: int
+ ).
+
+%-----------------------------------------------------------------------------%
+% Parsing.
+%
+
+date_from_string(Str, Date) :-
+ some [!Chars] (
+ !:Chars = string.to_char_list(Str),
+ ( read_char((-), !.Chars, Rest1) ->
+ !:Chars = Rest1,
+ read_int_and_num_chars(Year0, YearChars, !Chars),
+ Year = -Year0
+ ;
+ read_int_and_num_chars(Year, YearChars, !Chars)
+ ),
+ YearChars >= 4,
+ Year \= 0,
+ 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)
+ ).
+
+:- pred read_microseconds(microseconds::out, list(char)::in, list(char)::out)
+ is det.
+
+read_microseconds(MicroSeconds, !Chars) :-
+ (
+ read_char((.), !.Chars, Chars1),
+ read_int_and_num_chars(Fraction, FractionDigits, Chars1, !:Chars),
+ FractionDigits > 0,
+ FractionDigits < 7
+ ->
+ MicroSeconds = int.pow(10, 6 - FractionDigits) * Fraction
+ ;
+ 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) :-
+ (
+ !.Chars = [Char | Rest],
+ char_to_digit(Char, Digit)
+ ->
+ !:Val = !.Val * 10 + Digit,
+ read_int_and_num_chars_2(!Val, !.N + 1, !:N, Rest, !:Chars)
+ ;
+ true
+ ).
+
+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),
+ ( read_char('T', !.Chars, TimePart) ->
+ 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)
+ ;
+ !.Chars = [],
+ Duration = init_duration(Sign * Years, Sign * Months, Sign * Days,
+ 0, 0, 0, 0)
+ )
+ ).
+
+:- pred read_sign(int::out, list(char)::in, list(char)::out) is det.
+
+read_sign(Sign, !Chars) :-
+ ( !.Chars = [(-) | Rest] ->
+ !:Chars = Rest,
+ Sign = -1
+ ;
+ 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) :-
+ (
+ read_int(Seconds0, !.Chars, Chars1),
+ read_microseconds(MicroSeconds0, Chars1, Chars2),
+ read_char('S', Chars2, Chars3)
+ ->
+ !:Chars = Chars3,
+ Seconds = Seconds0,
+ MicroSeconds = MicroSeconds0
+ ;
+ 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) :-
+ (
+ read_int(Int0, !.Chars, Chars1),
+ Chars1 = [Char | Rest]
+ ->
+ !:Chars = Rest,
+ Int = Int0
+ ;
+ 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) :-
+ (
+ !.Chars = [Char | Rest],
+ char_to_digit(Char, Digit)
+ ->
+ !:Val = !.Val * 10 + Digit,
+ read_int_2(!Val, Rest, !:Chars)
+ ;
+ true
+ ).
+
+init_duration(Years0, Months0, Days0, Hours0, Minutes0, Seconds0,
+ MicroSeconds0) =
+ duration(Months, Days, Seconds, MicroSeconds) :-
+ (
+ (
+ 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
+ )
+ ->
+ 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
+ ;
+ error("init_duration: 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)).
+
+det_date_from_string(Str) = Date :-
+ ( date_from_string(Str, Date0) ->
+ Date = Date0
+ ;
+ error("det_date_from_string: invalid date: " ++
+ Str)
+ ).
+
+det_duration_from_string(Str) = Duration :-
+ ( duration_from_string(Str, Duration0) ->
+ Duration = Duration0
+ ;
+ error("det_duration_from_string: invalid duration: " ++
+ Str)
+ ).
+
+%-----------------------------------------------------------------------------%
+% Serialization.
+%
+
+date_to_string(Date) = Str :-
+ unpack_date(Date, Year0, Month, Day, Hour, Minute, Second, MicroSecond),
+ ( Year0 < 0 ->
+ SignStr = "-",
+ Year = -Year0
+ ;
+ SignStr = "",
+ Year = Year0
+ ),
+ MicroSecondStr = microsecond_string(MicroSecond),
+ Str = string.format("%s%04d-%02d-%02d %02d:%02d:%02d%s",
+ [s(SignStr), i(Year), i(month_num(Month)), i(Day), i(Hour), i(Minute),
+ i(Second), s(MicroSecondStr)]).
+
+:- func microsecond_string(microseconds) = string.
+
+microsecond_string(MicroSeconds) = Str :-
+ ( MicroSeconds > 0 ->
+ Str = rstrip_pred(unify('0'),
+ string.format(".%06d", [i(MicroSeconds)]))
+ ;
+ Str = ""
+ ).
+
+duration_to_string(duration(Months, Days, Seconds, MicroSeconds) @ Duration)
+ = Str :-
+ (
+ Months = 0,
+ Days = 0,
+ Seconds = 0,
+ MicroSeconds = 0
+ ->
+ % At least one component must appear in the string. The choice
+ % of days is arbitrary.
+ Str = "P0D"
+ ;
+ (
+ Months >= 0,
+ Days >= 0,
+ Seconds >= 0,
+ MicroSeconds >= 0
+ ->
+ Sign = 1,
+ SignStr = ""
+ ;
+ Months =< 0,
+ Days =< 0,
+ Seconds =< 0,
+ MicroSeconds =< 0
+ ->
+ Sign = -1,
+ SignStr = "-"
+ ;
+ error("duration_to_string: " ++
+ "duration components have mixed signs")
+ ),
+ (
+ Seconds = 0,
+ MicroSeconds = 0
+ ->
+ TimePart = []
+ ;
+ 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) =
+ ( X = 0 ->
+ ""
+ ;
+ int_to_string(X) ++ Suffix
+ ).
+
+:- func seconds_duration_string(seconds, microseconds) = string.
+
+seconds_duration_string(Seconds, MicroSeconds) = Str :-
+ ( Seconds = 0, MicroSeconds = 0 ->
+ Str = ""
+ ;
+ Str = string.append_list([
+ string.from_int(Seconds),
+ microsecond_string(MicroSeconds),
+ "S"])
+ ).
+
+%-----------------------------------------------------------------------------%
+% Partial relation on durations. This algorithm is described at
+% http://www.w3.org/TR/xmlschema-2/#duration.
+%
+
+duration_leq(DurA, DurB) :-
+ 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)
+].
+
+%-----------------------------------------------------------------------------%
+% 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.
+%
+
+:- 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),
+ (
+ ( ( 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,
+ ( ( Y mod 400 = 0 ; ( Y mod 100 \= 0, Y mod 4 = 0 ) ) ->
+ Max0 = 29
+ ;
+ Max0 = 28
+ )
+ )
+ ->
+ Max = Max0
+ ;
+ % This should never happen.
+ error("max_day_in_month_for: unexpected value for M: " ++
+ string(M))
+ ).
+
+add_duration(D, S, E) :-
+ some [!Temp, !Carry, !E] (
+ !:E = date(0, 0, 0, 0, 0, 0, 0),
+ % Months
+ !:Temp = S ^ dt_month + D ^ dur_months,
+ !E ^ dt_month := modulo(!.Temp, 1, 13),
+ !:Carry = fquotient(!.Temp, 1, 13),
+ % Years
+ !E ^ dt_year := S ^ dt_year + !.Carry,
+ % Microseconds
+ !:Temp = S ^ dt_microsecond + D ^ dur_microseconds,
+ !E ^ dt_microsecond := modulo(!.Temp, microseconds_per_second),
+ !:Carry = div(!.Temp, microseconds_per_second),
+ % Seconds
+ !:Temp = S ^ dt_second + D ^ dur_seconds + !.Carry,
+ !E ^ dt_second := modulo(!.Temp, 60),
+ !:Carry = div(!.Temp, 60),
+ % Minutes
+ !:Temp = S ^ dt_minute + !.Carry,
+ !E ^ dt_minute := int.mod(!.Temp, 60),
+ !:Carry = int.div(!.Temp, 60),
+ % Hours
+ !:Temp = S ^ dt_hour + !.Carry,
+ !E ^ dt_hour := int.mod(!.Temp, 24),
+ !:Carry = int.div(!.Temp, 24),
+ % Days
+ MaxDaysInMonth = max_day_in_month_for(!.E ^ dt_year, !.E ^ dt_month),
+ ( S ^ dt_day > MaxDaysInMonth ->
+ TempDays = MaxDaysInMonth
+ ; S ^ dt_day < 1 ->
+ TempDays = 1
+ ;
+ TempDays = S ^ dt_day
+ ),
+ !E ^ dt_day := TempDays + D ^ dur_days + !.Carry,
+ add_duration_loop(D, S, !E),
+ E = !.E
+ ).
+
+:- pred add_duration_loop(duration::in, date::in, date::in, date::out) is det.
+
+add_duration_loop(D, S, !E) :-
+ ( !.E ^ dt_day < 1 ->
+ !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),
+ add_duration_loop(D, S, !E)
+ ;
+ MaxDaysInMonth = max_day_in_month_for(!.E ^ dt_year, !.E ^ dt_month),
+ !.E ^ dt_day > MaxDaysInMonth
+ ->
+ !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),
+ add_duration_loop(D, S, !E)
+ ;
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+% Computing duration between dates.
+%
+
+day_duration(DateA, DateB) = Duration :-
+ builtin.compare(CompResult, DateB, DateA),
+ ( CompResult = (<),
+ Duration0 = day_duration(DateB, DateA),
+ Duration = negate(Duration0)
+ ; CompResult = (=),
+ Duration = zero_duration
+ ; CompResult = (>),
+ 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(DateB ^ dt_year, DateB ^ dt_month,
+ DateB ^ dt_day),
+ JDN2 = julian_day(DateA ^ dt_year, DateA ^ dt_month,
+ DateA ^ dt_day),
+ Days = JDN1 - !.Borrow - JDN2,
+ Duration = init_duration(0, 0, Days, Hours, Minutes, Seconds,
+ MicroSeconds)
+ )
+ ).
+
+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.
+
+:- pred greedy_subtract_descending(order::in, date::in, date::in,
+ duration::out) is det.
+
+ % 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 invarient:
+ % add_duration(duration(DateA, DateB), DateA, DateB)
+ % to hold, and in the case where DateA > DateB, Duration will be negative.
+ %
+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,
+ ( YearA >= YearB ->
+ Years = YearA - YearB
+ ;
+ % If this happens then DateA < DateB which violates a precondition
+ % of this predicate.
+ error("greedy_subtract_descending: " ++
+ "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) :-
+ ( Val1 >= Val2 ->
+ Borrow = 0,
+ Diff = Val1 - Val2
+ ;
+ Borrow = 1,
+ Diff = BorrowVal + Val1 - Val2
+ ).
+
+%-----------------------------------------------------------------------------%
+% The day of the week is computed by working out the Julian day modulo 7.
+% The algorithm is described at
+% http://en.wikipedia.org/wiki/Julian_day.
+%
+
+day_of_week(Date) = DayOfWeek :-
+ JDN = julian_day(Date ^ dt_year, Date ^ dt_month, Date ^ dt_day),
+ Mod = JDN mod 7,
+ DayOfWeek = det_day_of_week_from_mod(Mod).
+
+:- func julian_day(int, int, int) = int.
+
+julian_day(Year, Month, Day) = JDN :-
+ A = (14 - Month) // 12,
+ Y = Year + 4800 - A,
+ M = Month + 12 * A - 3,
+ JDN = Day + ( 153 * M + 2 ) // 5 + 365 * Y + Y // 4 - Y // 100 + Y // 400
+ - 32045.
+
+:- func det_day_of_week_from_mod(int) = day_of_week.
+
+det_day_of_week_from_mod(Mod) = DayOfWeek :-
+ ( day_of_week_num(DayOfWeek0, Mod) ->
+ DayOfWeek = DayOfWeek0
+ ;
+ error("det_day_of_week_from_mod: invalid mod: " ++
+ int_to_string(Mod))
+ ).
+
+%-----------------------------------------------------------------------------%
+% Misc
+%
+
+year(Date) = Date ^ dt_year.
+month(Date) = det_month(Date ^ dt_month).
+day_of_month(Date) = Date ^ dt_day.
+hour(Date) = Date ^ dt_hour.
+minute(Date) = Date ^ dt_minute.
+second(Date) = Date ^ dt_second.
+microsecond(Date) = Date ^ dt_microsecond.
+
+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_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date) :-
+ Day >= 1,
+ Day =< max_day_in_month_for(Year, month_num(Month)),
+ Hour < 24,
+ Minute < 60,
+ Second < 62,
+ MicroSecond < 1000000,
+ Date = date(Year, month_num(Month), Day, Hour, Minute, Second,
+ MicroSecond).
+
+det_init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond) = Date
+ :-
+ (
+ init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date0)
+ ->
+ Date = Date0
+ ;
+ error(string.format("calendar.det_init_date: invalid date: " ++
+ "%i-%i-%i %i:%i:%i", [i(Year), i(month_num(Month)), i(Day), i(Hour),
+ i(Minute), i(Second)]))
+ ).
+
+unpack_date(date(Year, Month, Day, Hour, Minute, Second, MicroSecond),
+ Year, det_month(Month), Day, Hour, Minute, Second, MicroSecond).
+
+current_local_time(Now, !IO) :-
+ time.time(TimeT, !IO),
+ TM = time.localtime(TimeT),
+ 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).
+
+local_time_offset(TZ, !IO) :-
+ time.time(TimeT, !IO),
+ LocalTM = time.localtime(TimeT),
+ GMTM = time.gmtime(TimeT),
+ LocalTime = tm_to_date(LocalTM),
+ GMTime = tm_to_date(GMTM),
+ TZ = duration(GMTime, LocalTime).
+
+negate(duration(Months, Days, Seconds, MicroSeconds)) =
+ duration(-Months, -Days, -Seconds, -MicroSeconds).
+
+zero_duration = duration(0, 0, 0, 0).
+
+:- func det_month(int) = month.
+
+det_month(N) = Month :-
+ ( num_to_month(N, Month0) ->
+ Month = Month0
+ ;
+ error("det_month: invalid month: " ++ int_to_string(N))
+ ).
+
+:- func month_num(month) = int.
+
+month_num(Month) = N :- num_to_month(N, Month).
+
+:- pred num_to_month(int, month).
+:- mode num_to_month(in, out) is semidet.
+:- mode num_to_month(out, in) is det.
+
+num_to_month(1, january).
+num_to_month(2, february).
+num_to_month(3, march).
+num_to_month(4, april).
+num_to_month(5, may).
+num_to_month(6, june).
+num_to_month(7, july).
+num_to_month(8, august).
+num_to_month(9, september).
+num_to_month(10, october).
+num_to_month(11, november).
+num_to_month(12, december).
+
+:- pred char_to_digit(char::in, int::out) is semidet.
+
+char_to_digit('0', 0).
+char_to_digit('1', 1).
+char_to_digit('2', 2).
+char_to_digit('3', 3).
+char_to_digit('4', 4).
+char_to_digit('5', 5).
+char_to_digit('6', 6).
+char_to_digit('7', 7).
+char_to_digit('8', 8).
+char_to_digit('9', 9).
+
+:- 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).
+
+%-----------------------------------------------------------------------------%
+:- end_module calendar.
+%-----------------------------------------------------------------------------%
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.120
diff -u -r1.120 library.m
--- library/library.m 9 Mar 2008 09:39:24 -0000 1.120
+++ library/library.m 27 Jan 2009 00:57:06 -0000
@@ -59,6 +59,7 @@
:- import_module bool.
:- import_module bt_array.
:- import_module builtin.
+:- import_module calendar.
:- import_module char.
:- import_module construct.
:- import_module cord.
@@ -229,6 +230,7 @@
mercury_std_library_module("bool").
mercury_std_library_module("bt_array").
mercury_std_library_module("builtin").
+mercury_std_library_module("calendar").
mercury_std_library_module("char").
mercury_std_library_module("construct").
mercury_std_library_module("cord").
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.362
diff -u -r1.362 Mmakefile
--- tests/hard_coded/Mmakefile 2 Jan 2009 03:12:09 -0000 1.362
+++ tests/hard_coded/Mmakefile 1 Feb 2009 10:26:28 -0000
@@ -16,6 +16,7 @@
brace \
builtin_inst_rename \
c_write_string \
+ calendar_test \
cc_and_non_cc_test \
cc_multi_bug \
cc_nondet_disj \
@@ -274,6 +275,7 @@
address_of_builtins \
brace \
c_write_string \
+ calendar_test \
compare_spec \
constant_prop_2 \
contains_char \
Index: tests/hard_coded/calendar_test.exp
===================================================================
RCS file: tests/hard_coded/calendar_test.exp
diff -N tests/hard_coded/calendar_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/calendar_test.exp 2 Feb 2009 01:18:12 -0000
@@ -0,0 +1,100 @@
+Partial order on durations:
+P1M <> P30D
+P1M =< P32D
+P3M =< P92D
+P1Y >= PT31535000S
+P11M =< P1Y
+P12M == P1Y
+P1D == PT24H
+PT1S =< PT1M1S
+PT1S =< PT1.0001S
+-PT1S >= -PT1.0001S
+
+Adding durations to date-times:
+1901-12-31 00:00:00 + P1D = 1902-01-01 00:00:00
+1901-12-31 00:00:00 + P1M = 1902-01-31 00:00:00
+1901-12-31 00:00:00 + P1Y = 1902-12-31 00:00:00
+1901-12-31 00:00:00 + PT1H = 1901-12-31 01:00:00
+1901-12-31 00:00:00 + PT1M = 1901-12-31 00:01:00
+1901-12-31 00:00:00 + PT1S = 1901-12-31 00:00:01
+2000-02-28 00:00:00 + P1D = 2000-02-29 00:00:00
+2001-01-30 00:00:00 + P1M = 2001-02-28 00:00:00
+2000-01-30 00:00:00 + P1M = 2000-02-29 00:00:00
+2007-01-01 00:00:00 + PT31536000S = 2008-01-01 00:00:00
+2008-01-01 00:00:00 + PT31536000S = 2008-12-31 00:00:00
+2008-03-31 00:00:00 + -P1M = 2008-02-29 00:00:00
+2007-03-31 00:00:00 + -P1M = 2007-02-28 00:00:00
+1000-01-01 00:00:00 + -PT1M = 0999-12-31 23:59:00
+2000-03-01 00:00:00 + -PT1H = 2000-02-29 23:00:00
+-0001-01-01 00:00:00 + -PT1S = -0002-12-31 23:59:59
+-0001-01-01 00:00:00.123 + -PT1.123S = -0002-12-31 23:59:59
+2009-02-28 23:59:59.99 + PT0.01S = 2009-03-01 00:00:00
+2009-02-28 23:59:59.99 + P1MT0.02S = 2009-03-29 00:00:00.01
+
+Computing durations:
+G: 2008-01-01 00:00:00 -> 2200-04-04 04:04:04 = P192Y3M3DT4H4M4S checked ok
+G: 2200-04-04 04:04:04 -> 2008-01-01 00:00:00 = -P192Y3M3DT4H4M4S checked ok
+D: 2008-01-01 00:00:00 -> 2200-04-04 04:04:04 = P70220DT4H4M4S checked ok
+D: 2200-04-04 04:04:04 -> 2008-01-01 00:00:00 = -P70220DT4H4M4S checked ok
+
+G: 2008-01-31 00:00:00 -> 2008-02-29 10:00:00 = P1MT10H checked ok
+G: 2008-02-29 10:00:00 -> 2008-01-31 00:00:00 = -P29DT10H checked ok
+D: 2008-01-31 00:00:00 -> 2008-02-29 10:00:00 = P29DT10H checked ok
+D: 2008-02-29 10:00:00 -> 2008-01-31 00:00:00 = -P29DT10H checked ok
+
+G: 2000-01-31 00:00:00 -> 2001-01-29 00:00:00 = P11M29D checked ok
+G: 2001-01-29 00:00:00 -> 2000-01-31 00:00:00 = -P11M29D checked ok
+D: 2000-01-31 00:00:00 -> 2001-01-29 00:00:00 = P364D checked ok
+D: 2001-01-29 00:00:00 -> 2000-01-31 00:00:00 = -P364D checked ok
+
+G: 2000-02-29 00:00:00 -> 2001-01-31 00:00:00 = P11M2D checked ok
+G: 2001-01-31 00:00:00 -> 2000-02-29 00:00:00 = -P11M checked ok
+D: 2000-02-29 00:00:00 -> 2001-01-31 00:00:00 = P337D checked ok
+D: 2001-01-31 00:00:00 -> 2000-02-29 00:00:00 = -P337D checked ok
+
+G: 2000-02-29 22:58:58 -> 2001-01-31 23:59:59 = P11M2DT1H1M1S checked ok
+G: 2001-01-31 23:59:59 -> 2000-02-29 22:58:58 = -P11MT1H1M1S checked ok
+D: 2000-02-29 22:58:58 -> 2001-01-31 23:59:59 = P337DT1H1M1S checked ok
+D: 2001-01-31 23:59:59 -> 2000-02-29 22:58:58 = -P337DT1H1M1S checked ok
+
+G: 2001-02-28 00:00:00 -> 2001-03-29 00:00:00 = P1M1D checked ok
+G: 2001-03-29 00:00:00 -> 2001-02-28 00:00:00 = -P1M checked ok
+D: 2001-02-28 00:00:00 -> 2001-03-29 00:00:00 = P29D checked ok
+D: 2001-03-29 00:00:00 -> 2001-02-28 00:00:00 = -P29D checked ok
+
+G: 2001-02-27 00:00:00 -> 2001-03-29 00:00:00 = P1M2D checked ok
+G: 2001-03-29 00:00:00 -> 2001-02-27 00:00:00 = -P1M1D checked ok
+D: 2001-02-27 00:00:00 -> 2001-03-29 00:00:00 = P30D checked ok
+D: 2001-03-29 00:00:00 -> 2001-02-27 00:00:00 = -P30D checked ok
+
+G: 1975-06-05 12:00:00 -> 1977-10-09 12:00:00 = P2Y4M4D checked ok
+G: 1977-10-09 12:00:00 -> 1975-06-05 12:00:00 = -P2Y4M4D checked ok
+D: 1975-06-05 12:00:00 -> 1977-10-09 12:00:00 = P857D checked ok
+D: 1977-10-09 12:00:00 -> 1975-06-05 12:00:00 = -P857D checked ok
+
+G: 1977-10-09 12:00:00 -> 1980-01-05 11:11:11 = P2Y2M26DT23H11M11S checked ok
+G: 1980-01-05 11:11:11 -> 1977-10-09 12:00:00 = -P2Y2M26DT23H11M11S checked ok
+D: 1977-10-09 12:00:00 -> 1980-01-05 11:11:11 = P817DT23H11M11S checked ok
+D: 1980-01-05 11:11:11 -> 1977-10-09 12:00:00 = -P817DT23H11M11S checked ok
+
+G: 1977-10-09 12:00:00 -> 1980-03-01 12:00:00 = P2Y4M21D checked ok
+G: 1980-03-01 12:00:00 -> 1977-10-09 12:00:00 = -P2Y4M23D checked ok
+D: 1977-10-09 12:00:00 -> 1980-03-01 12:00:00 = P874D checked ok
+D: 1980-03-01 12:00:00 -> 1977-10-09 12:00:00 = -P874D checked ok
+
+G: 1977-10-09 12:00:00 -> 1980-03-01 13:01:01.000007 = P2Y4M21DT1H1M1.000007S checked ok
+G: 1980-03-01 13:01:01.000007 -> 1977-10-09 12:00:00 = -P2Y4M23DT1H1M1.000007S checked ok
+D: 1977-10-09 12:00:00 -> 1980-03-01 13:01:01.000007 = P874DT1H1M1.000007S checked ok
+D: 1980-03-01 13:01:01.000007 -> 1977-10-09 12:00:00 = -P874DT1H1M1.000007S checked ok
+
+
+Day of the week:
+2008-01-15 23:59:00 : tuesday
+2008-01-16 19:08:00 : wednesday
+1360-04-14 00:00:00 : monday
+1865-02-27 00:00:00 : monday
+1886-02-08 00:00:00 : monday
+1929-10-28 00:00:00 : monday
+
+Parse test:
+P2Y6M100DT10H16M30.0003S
Index: tests/hard_coded/calendar_test.m
===================================================================
RCS file: tests/hard_coded/calendar_test.m
diff -N tests/hard_coded/calendar_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/calendar_test.m 2 Feb 2009 01:16:10 -0000
@@ -0,0 +1,151 @@
+:- module calendar_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module calendar.
+
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ io.write_string("Partial order on durations:\n", !IO),
+ test_dur_leq("P1M", "P30D", !IO), % <>
+ test_dur_leq("P1M", "P32D", !IO), % =<
+ test_dur_leq("P3M", "P92D", !IO), % =<
+ test_dur_leq("P1Y", "PT31535000S", !IO), % >=
+ test_dur_leq("P11M", "P1Y", !IO), % =<
+ test_dur_leq("P12M", "P1Y", !IO), % ==
+ test_dur_leq("P1D", "PT24H", !IO), % ==
+ test_dur_leq("PT1S", "PT1M1S", !IO), % =<
+ test_dur_leq("PT1S", "PT1.0001S", !IO), % =<
+ test_dur_leq("-PT1S", "-PT1.0001S", !IO), % >=
+ io.nl(!IO),
+ io.write_string("Adding durations to date-times:\n", !IO),
+ test_add_dur("1901-12-31 00:00:00", "P1D", !IO),
+ test_add_dur("1901-12-31 00:00:00", "P1M", !IO),
+ test_add_dur("1901-12-31 00:00:00", "P1Y", !IO),
+ test_add_dur("1901-12-31 00:00:00", "PT1H", !IO),
+ test_add_dur("1901-12-31 00:00:00", "PT1M", !IO),
+ test_add_dur("1901-12-31 00:00:00", "PT1S", !IO),
+ test_add_dur("2000-02-28 00:00:00", "P1D", !IO),
+ test_add_dur("2001-01-30 00:00:00", "P1M", !IO),
+ test_add_dur("2000-01-30 00:00:00", "P1M", !IO),
+ test_add_dur("2007-01-01 00:00:00", "PT31536000S", !IO),
+ test_add_dur("2008-01-01 00:00:00", "PT31536000S", !IO),
+ test_add_dur("2008-03-31 00:00:00", "-P1M", !IO),
+ test_add_dur("2007-03-31 00:00:00", "-P1M", !IO),
+ test_add_dur("1000-01-01 00:00:00", "-PT1M", !IO),
+ test_add_dur("2000-03-01 00:00:00", "-PT1H", !IO),
+ test_add_dur("-0001-01-01 00:00:00", "-PT1S", !IO),
+ test_add_dur("-0001-01-01 00:00:00.123", "-PT1.123S", !IO),
+ test_add_dur("2009-02-28 23:59:59.99", "PT0.01S", !IO),
+ test_add_dur("2009-02-28 23:59:59.99", "P1MT0.02S", !IO),
+ io.nl(!IO),
+ io.write_string("Computing durations:\n", !IO),
+ test_diff("2008-01-01 00:00:00", "2200-04-04 04:04:04", !IO),
+ test_diff("2008-01-31 00:00:00", "2008-02-29 10:00:00", !IO),
+ test_diff("2000-01-31 00:00:00", "2001-01-29 00:00:00", !IO),
+ test_diff("2000-02-29 00:00:00", "2001-01-31 00:00:00", !IO),
+ test_diff("2000-02-29 22:58:58", "2001-01-31 23:59:59", !IO),
+ test_diff("2001-02-28 00:00:00", "2001-03-29 00:00:00", !IO),
+ test_diff("2001-02-27 00:00:00", "2001-03-29 00:00:00", !IO),
+ test_diff("1975-06-05 12:00:00", "1977-10-09 12:00:00", !IO),
+ test_diff("1977-10-09 12:00:00", "1980-01-05 11:11:11", !IO),
+ test_diff("1977-10-09 12:00:00", "1980-03-01 12:00:00", !IO),
+ test_diff("1977-10-09 12:00:00", "1980-03-01 13:01:01.000007", !IO),
+ io.nl(!IO),
+ io.write_string("Day of the week:\n", !IO),
+ test_day_of_week("2008-01-15 23:59:00", !IO),
+ test_day_of_week("2008-01-16 19:08:00", !IO),
+ test_day_of_week("1360-04-14 00:00:00", !IO),
+ test_day_of_week("1865-02-27 00:00:00", !IO),
+ test_day_of_week("1886-02-08 00:00:00", !IO),
+ test_day_of_week("1929-10-28 00:00:00", !IO),
+ io.nl(!IO),
+ io.write_string("Parse test:\n", !IO),
+ io.write_string(duration_to_string(
+ det_duration_from_string("P1Y18M100DT10H15M90.0003S")), !IO),
+ io.nl(!IO).
+
+:- pred test_dur_leq(string::in, string::in, io::di, io::uo) is det.
+
+test_dur_leq(Str1, Str2, !IO) :-
+ Dur1 = det_duration_from_string(Str1),
+ Dur2 = det_duration_from_string(Str2),
+ ( duration_leq(Dur1, Dur2), duration_leq(Dur2, Dur1) ->
+ RelationStr = " == "
+ ; duration_leq(Dur1, Dur2) ->
+ RelationStr = " =< "
+ ; duration_leq(Dur2, Dur1) ->
+ RelationStr = " >= "
+ ;
+ RelationStr = " <> "
+ ),
+ io.format("%s %s %s\n", [s(Str1), s(RelationStr), s(Str2)], !IO).
+
+:- pred test_add_dur(string::in, string::in, io::di, io::uo) is det.
+
+test_add_dur(Date0Str, DurStr, !IO) :-
+ Date0 = det_date_from_string(Date0Str),
+ Dur = det_duration_from_string(DurStr),
+ add_duration(Dur, Date0, Date),
+ DateStr = date_to_string(Date),
+ io.format("%s + %s = %s\n", [s(Date0Str), s(DurStr), s(DateStr)], !IO).
+
+:- pred test_diff(string::in, string::in, io::di, io::uo) is det.
+
+test_diff(Date1, Date2, !IO) :-
+ io.write_string("G: ", !IO),
+ test_greedy_diff(Date1, Date2, !IO),
+ io.write_string("G: ", !IO),
+ test_greedy_diff(Date2, Date1, !IO),
+ io.write_string("D: ", !IO),
+ test_days_diff(Date1, Date2, !IO),
+ io.write_string("D: ", !IO),
+ test_days_diff(Date2, Date1, !IO),
+ io.nl(!IO).
+
+:- pred test_greedy_diff(string::in, string::in, io::di, io::uo) is det.
+
+test_greedy_diff(Date1Str, Date2Str, !IO) :-
+ Date1 = det_date_from_string(Date1Str),
+ Date2 = det_date_from_string(Date2Str),
+ duration(Date1, Date2) = Dur,
+ DurStr = duration_to_string(Dur),
+ io.format("%s -> %s = %s", [s(Date1Str), s(Date2Str), s(DurStr)], !IO),
+ add_duration(Dur, Date1, Date3),
+ ( Date2 = Date3 ->
+ io.write_string(" checked ok\n", !IO)
+ ;
+ io.write_string(" error: " ++ date_to_string(Date3) ++
+ "\n", !IO)
+ ).
+
+:- pred test_days_diff(string::in, string::in, io::di, io::uo) is det.
+
+test_days_diff(Date1Str, Date2Str, !IO) :-
+ Date1 = det_date_from_string(Date1Str),
+ Date2 = det_date_from_string(Date2Str),
+ Dur = day_duration(Date1, Date2),
+ DurStr = duration_to_string(Dur),
+ io.format("%s -> %s = %s", [s(Date1Str), s(Date2Str), s(DurStr)], !IO),
+ add_duration(Dur, Date1, Date3),
+ ( Date2 = Date3 ->
+ io.write_string(" checked ok\n", !IO)
+ ;
+ io.write_string(" error: " ++ date_to_string(Date3) ++
+ "\n", !IO)
+ ).
+
+:- pred test_day_of_week(string::in, io::di, io::uo) is det.
+
+test_day_of_week(DateStr, !IO) :-
+ io.write_string(DateStr ++ " : ", !IO),
+ io.write(day_of_week(det_date_from_string(DateStr)), !IO),
+ io.nl(!IO).
INTERDIFF:
diff -u library/calendar.m library/calendar.m
--- library/calendar.m 27 Jan 2009 03:51:25 -0000
+++ library/calendar.m 2 Feb 2009 02:21:57 -0000
@@ -11,6 +11,14 @@
% 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.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -22,14 +30,18 @@
%-----------------------------------------------------------------------------%
- % A point on the Proleptic Gregorian calendar, to the nearest second.
+ % A point on the Proleptic Gregorian calendar, to the nearest microsecond.
%
:- type date.
- % A period of time measured in years, months, days, hours, minutes and
- % seconds.
+ % Date components.
%
-:- type duration.
+:- 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
@@ -44,33 +56,15 @@
; october
; november
; december.
-
- % 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 day_of_week
- ---> sunday
- ; monday
+ ---> monday
; tuesday
; wednesday
; thursday
; friday
- ; saturday.
-
- % Duration components.
- %
-:- type years == int.
-:- type months == int.
-:- type days == int.
-:- type hours == int.
-:- type minutes == int.
-:- type seconds == int.
+ ; saturday
+ ; sunday.
% Functions to retrieve the components of a date.
%
@@ -81,19 +75,27 @@
:- func hour(date) = hour.
:- func minute(date) = minute.
:- func second(date) = second.
+:- func microsecond(date) = microsecond.
- % init_date(Year, Month, Day, Hour, Minute, Second) = DT.
+ % 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, date::out) is semidet.
+ minute::in, second::in, microsecond::in, date::out) is semidet.
% Same as above, but aborts if the date is invalid.
%
-:- func det_init_date(year, month, day_of_month, hour, minute, second) =
- date.
+:- func det_init_date(year, month, day_of_month, hour, minute, second,
+ microsecond) = date.
- % Convert a string of the form "YYYY-MM-DD HH:MI:SS" to a 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.
@@ -101,35 +103,130 @@
%
:- func det_date_from_string(string) = date.
- % Convert a date to a string of the form "YYYY-MM-DD HH:MI:SS".
+ % 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.
- % Parse a duration string conforming to the representation
- % described at http://www.w3.org/TR/xmlschema-2/#duration.
+ % 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.
+
+ % 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.
+
+ % Retrive 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 aborts if the string does not represent
- % a valid duration.
+ % Same as above, but aborts if the duration string is invalid.
%
:- func det_duration_from_string(string) = duration.
- % Convert a duration to the string representation
- % described at http://www.w3.org/TR/xmlschema-2/#duration.
+ % Convert a duration to a string using the same representation
+ % parsed by duration_from_string.
%
:- func duration_to_string(duration) = string.
- % Get the current local time.
+ % Add a duration to a date.
%
-:- pred current_local_time(date::out, io::di, io::uo) is det.
+ % 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.
- % Get the current UTC time.
+ % 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 current_utc_time(date::out, io::di, io::uo) is det.
+:- pred duration_leq(duration::in, duration::in) is semidet.
- % Get the difference between the local time and utc time
- % as a duration.
+ % 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),
@@ -137,78 +234,48 @@
% except that it is as if the calls to current_utc_time and
% current_local_time occured at the same instant.
%
-:- pred local_time_offset(duration::out, io::di, io::uo) is det.
-
- % Functions to retrieve duration components.
+ % 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.
%
-:- func years(duration) = years.
-:- func months(duration) = months.
-:- func days(duration) = days.
-:- func hours(duration) = hours.
-:- func minutes(duration) = minutes.
-:- func seconds(duration) = seconds.
+:- pred local_time_offset(duration::out, io::di, io::uo) is det.
- % duration(Date1, Date2) = Duration.
+ % 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.
- % The returned duration is positive if Date2 is after Date1 and negative
- % if Date2 is before Date1.
+ % 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 occured between the two dates are ignored.
- %
- % If the seconds components of Date1 and Date2 are < 60 then
- % add_duration(Date1, duration(Date1, Date2), Date2) will hold, but
- % add_duration(Date2, negate(duration(Date1, Date2)), Date1) may not
+ % 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:
- % Date1 = 2001-01-31
- % Date2 = 2001-02-28
+ % DateA = 2001-01-31
+ % DateB = 2001-02-28
% Duration = 1 month
% then the following holds:
- % add_duration(duration(Date1, Date2), Date1, Date2)
+ % add_duration(duration(DateA, DateB), DateA, DateB)
% but the following does not:
- % add_duration(negate(duration(Date1, Date2), Date2, Date1)
+ % 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 and seconds only.
+ % in terms of days, hours, minutes, seconds and microseconds only.
%
:- func day_duration(date, date) = duration.
- % 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 months and years values to change again.
- % The algorithm used is described in detail at
- % http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes.
- %
-:- pred add_duration(duration::in, date::in, date::out) is det.
-
- % This predicate implements a partial order relation on durations.
- % The algorithm it uses is described at
- % http://www.w3.org/TR/xmlschema-2/#duration.
- % Note that if duration_leq(X, Y) fails, then this does NOT imply
- % that duration_leq(Y, X) is true. For example a duration of 30 days
- % is not comparable to a duration of 1 month, so duration_leq will
- % fail if these are given as inputs in any order.
- %
-:- pred duration_leq(duration::in, duration::in) is semidet.
-
- % init_{positive|negative}_duration(Years, Months, Days, Hours, Minutes,
- % Seconds)
- % Create a new positive or negative duration. All the supplied dimensions
- % should be non-negative. If they are not the function aborts.
- %
-:- func init_positive_duration(years, months, days, hours, minutes, seconds) =
- duration.
-:- func init_negative_duration(years, months, days, hours, minutes, seconds) =
- duration.
-
+%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
:- implementation.
@@ -225,22 +292,21 @@
:- type date
---> date(
- dt_year :: int,
- dt_month :: int,
- dt_day :: int,
- dt_hour :: int,
- dt_minute :: int,
- dt_second :: int
+ dt_year :: int,
+ dt_month :: int,
+ dt_day :: int,
+ dt_hour :: int,
+ dt_minute :: int,
+ dt_second :: int,
+ dt_microsecond :: int
).
:- type duration
---> duration(
- dur_years :: int,
- dur_months :: int,
- dur_days :: int,
- dur_hours :: int,
- dur_minutes :: int,
- dur_seconds :: int
+ dur_months :: int,
+ dur_days :: int,
+ dur_seconds :: int,
+ dur_microseconds :: int
).
%-----------------------------------------------------------------------------%
@@ -276,15 +342,28 @@
Minute >= 0,
Minute =< 59,
read_char((:), !Chars),
- % Make sure there are two digits for the whole number part of the
- % second field.
- read_int_and_num_chars(_, 2, !.Chars, _),
- read_int(Second, !Chars),
+ read_int_and_num_chars(Second, 2, !Chars),
Second < 62,
+ read_microseconds(MicroSecond, !Chars),
!.Chars = [],
- Date = date(Year, Month, Day, Hour, Minute, Second)
+ Date = date(Year, Month, Day, Hour, Minute, Second, MicroSecond)
).
+:- pred read_microseconds(microseconds::out, list(char)::in, list(char)::out)
+ is det.
+
+read_microseconds(MicroSeconds, !Chars) :-
+ (
+ read_char((.), !.Chars, Chars1),
+ read_int_and_num_chars(Fraction, FractionDigits, Chars1, !:Chars),
+ FractionDigits > 0,
+ FractionDigits < 7
+ ->
+ MicroSeconds = int.pow(10, 6 - FractionDigits) * Fraction
+ ;
+ MicroSeconds = 0
+ ).
+
:- pred read_int_and_num_chars(int::out, int::out,
list(char)::in, list(char)::out) is det.
@@ -297,7 +376,7 @@
read_int_and_num_chars_2(!Val, !N, !Chars) :-
(
!.Chars = [Char | Rest],
- is_digit(Char, Digit)
+ char_to_digit(Char, Digit)
->
!:Val = !.Val * 10 + Digit,
read_int_and_num_chars_2(!Val, !.N + 1, !:N, Rest, !:Chars)
@@ -317,29 +396,26 @@
TimePart = [_ | _],
read_hours(Hours, TimePart, !:Chars),
read_minutes(Minutes, !Chars),
- read_seconds(Seconds, !Chars),
+ read_seconds_and_microseconds(Seconds, MicroSeconds, !Chars),
!.Chars = [],
- Duration = make_duration_with_sign(Sign, Years, Months, Days,
- Hours, Minutes, Seconds)
+ Duration = init_duration(Sign * Years, Sign * Months,
+ Sign * Days, Sign * Hours, Sign * Minutes, Sign * Seconds,
+ Sign * MicroSeconds)
;
!.Chars = [],
- Duration = make_duration_with_sign(Sign, Years, Months, Days,
- 0, 0, 0)
+ Duration = init_duration(Sign * Years, Sign * Months, Sign * Days,
+ 0, 0, 0, 0)
)
).
-:- type sign
- ---> positive
- ; negative.
-
-:- pred read_sign(sign::out, list(char)::in, list(char)::out) is det.
+:- pred read_sign(int::out, list(char)::in, list(char)::out) is det.
read_sign(Sign, !Chars) :-
( !.Chars = [(-) | Rest] ->
!:Chars = Rest,
- Sign = negative
+ Sign = -1
;
- Sign = positive
+ Sign = 1
).
:- pred read_char(char::out, list(char)::in, list(char)::out) is semidet.
@@ -371,10 +447,22 @@
read_minutes(Minutes, !Chars) :-
read_int_and_char_or_zero(Minutes, 'M', !Chars).
-:- pred read_seconds(int::out, list(char)::in, list(char)::out) is det.
+:- pred read_seconds_and_microseconds(seconds::out, microseconds::out,
+ list(char)::in, list(char)::out) is det.
-read_seconds(Seconds, !Chars) :-
- read_int_and_char_or_zero(Seconds, 'S', !Chars).
+read_seconds_and_microseconds(Seconds, MicroSeconds, !Chars) :-
+ (
+ read_int(Seconds0, !.Chars, Chars1),
+ read_microseconds(MicroSeconds0, Chars1, Chars2),
+ read_char('S', Chars2, Chars3)
+ ->
+ !:Chars = Chars3,
+ Seconds = Seconds0,
+ MicroSeconds = MicroSeconds0
+ ;
+ Seconds = 0,
+ MicroSeconds = 0
+ ).
:- pred read_int_and_char_or_zero(int::out, char::in,
list(char)::in, list(char)::out) is det.
@@ -400,7 +488,7 @@
read_int_2(!Val, !Chars) :-
(
!.Chars = [Char | Rest],
- is_digit(Char, Digit)
+ char_to_digit(Char, Digit)
->
!:Val = !.Val * 10 + Digit,
read_int_2(!Val, Rest, !:Chars)
@@ -408,28 +496,49 @@
true
).
-:- pred is_digit(char::in, int::out) is semidet.
+init_duration(Years0, Months0, Days0, Hours0, Minutes0, Seconds0,
+ MicroSeconds0) =
+ duration(Months, Days, Seconds, MicroSeconds) :-
+ (
+ (
+ 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
+ )
+ ->
+ 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
+ ;
+ error("init_duration: some components negative and some positive")
+ ).
+
+:- func seconds_per_day = int.
+
+seconds_per_day = 86400.
+
+:- func microseconds_per_second = int.
+
+microseconds_per_second = 1000000.
-is_digit('0', 0).
-is_digit('1', 1).
-is_digit('2', 2).
-is_digit('3', 3).
-is_digit('4', 4).
-is_digit('5', 5).
-is_digit('6', 6).
-is_digit('7', 7).
-is_digit('8', 8).
-is_digit('9', 9).
-
-:- func make_duration_with_sign(sign, int, int, int, int, int, int)
- = duration.
-
-make_duration_with_sign(positive, Years, Months, Days, Hours, Minutes,
- Seconds) =
- init_positive_duration(Years, Months, Days, Hours, Minutes, Seconds).
-make_duration_with_sign(negative, Years, Months, Days, Hours, Minutes,
- Seconds) =
- init_negative_duration(Years, Months, Days, Hours, Minutes, Seconds).
+unpack_duration(Duration,
+ years(Duration), months(Duration), days(Duration), hours(Duration),
+ minutes(Duration), seconds(Duration), microseconds(Duration)).
det_date_from_string(Str) = Date :-
( date_from_string(Str, Date0) ->
@@ -452,7 +561,7 @@
%
date_to_string(Date) = Str :-
- Date = date(Year0, Month, Day, Hour, Minute, Second),
+ unpack_date(Date, Year0, Month, Day, Hour, Minute, Second, MicroSecond),
( Year0 < 0 ->
SignStr = "-",
Year = -Year0
@@ -460,41 +569,46 @@
SignStr = "",
Year = Year0
),
- Str = string.format("%s%04d-%02d-%02d %02d:%02d:%02d",
- [s(SignStr), i(Year), i(Month), i(Day), i(Hour), i(Minute),
- i(Second)]).
+ MicroSecondStr = microsecond_string(MicroSecond),
+ Str = string.format("%s%04d-%02d-%02d %02d:%02d:%02d%s",
+ [s(SignStr), i(Year), i(month_num(Month)), i(Day), i(Hour), i(Minute),
+ i(Second), s(MicroSecondStr)]).
+
+:- func microsecond_string(microseconds) = string.
+
+microsecond_string(MicroSeconds) = Str :-
+ ( MicroSeconds > 0 ->
+ Str = rstrip_pred(unify('0'),
+ string.format(".%06d", [i(MicroSeconds)]))
+ ;
+ Str = ""
+ ).
-duration_to_string(duration(Years, Months, Days, Hours, Minutes, Seconds))
+duration_to_string(duration(Months, Days, Seconds, MicroSeconds) @ Duration)
= Str :-
(
- Years = 0,
Months = 0,
Days = 0,
- Hours = 0,
- Minutes = 0,
- Seconds = 0
+ Seconds = 0,
+ MicroSeconds = 0
->
- % At least one dimension must appear in the string. The choice
+ % At least one component must appear in the string. The choice
% of days is arbitrary.
Str = "P0D"
;
(
- Years >= 0,
Months >= 0,
Days >= 0,
- Hours >= 0,
- Minutes >= 0,
- Seconds >= 0
+ Seconds >= 0,
+ MicroSeconds >= 0
->
Sign = 1,
SignStr = ""
;
- Years =< 0,
Months =< 0,
Days =< 0,
- Hours =< 0,
- Minutes =< 0,
- Seconds =< 0
+ Seconds =< 0,
+ MicroSeconds =< 0
->
Sign = -1,
SignStr = "-"
@@ -503,23 +617,23 @@
"duration components have mixed signs")
),
(
- Hours = 0,
- Minutes = 0,
- Seconds = 0
+ Seconds = 0,
+ MicroSeconds = 0
->
TimePart = []
;
TimePart = ["T",
- string_if_nonzero(Sign * Hours, "H"),
- string_if_nonzero(Sign * Minutes, "M"),
- string_if_nonzero(Sign * Seconds, "S")
+ 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, "Y"),
- string_if_nonzero(Sign * Months, "M"),
- string_if_nonzero(Sign * Days, "D")] ++ TimePart)
+ 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.
@@ -531,14 +645,29 @@
int_to_string(X) ++ Suffix
).
+:- func seconds_duration_string(seconds, microseconds) = string.
+
+seconds_duration_string(Seconds, MicroSeconds) = Str :-
+ ( Seconds = 0, MicroSeconds = 0 ->
+ Str = ""
+ ;
+ Str = string.append_list([
+ string.from_int(Seconds),
+ microsecond_string(MicroSeconds),
+ "S"])
+ ).
+
%-----------------------------------------------------------------------------%
+% Partial relation on durations. This algorithm is described at
+% http://www.w3.org/TR/xmlschema-2/#duration.
+%
-duration_leq(Dur1, Dur2) :-
+duration_leq(DurA, DurB) :-
list.all_true(
( pred(TestDate::in) is semidet :-
- add_duration(Dur1, TestDate, Date1),
- add_duration(Dur2, TestDate, Date2),
- compare(CompRes, Date1, Date2),
+ add_duration(DurA, TestDate, DateA),
+ add_duration(DurB, TestDate, DateB),
+ compare(CompRes, DateA, DateB),
( CompRes = (<) ; CompRes = (=) )
), test_dates).
@@ -547,10 +676,10 @@
:- func test_dates = list(date).
test_dates = [
- date(1696, 9, 1, 0, 0, 0),
- date(1697, 2, 1, 0, 0, 0),
- date(1903, 3, 1, 0, 0, 0),
- date(1903, 7, 1, 0, 0, 0)
+ 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)
].
%-----------------------------------------------------------------------------%
@@ -599,23 +728,27 @@
add_duration(D, S, E) :-
some [!Temp, !Carry, !E] (
- !:E = date(0, 0, 0, 0, 0, 0),
+ !:E = date(0, 0, 0, 0, 0, 0, 0),
% Months
!:Temp = S ^ dt_month + D ^ dur_months,
!E ^ dt_month := modulo(!.Temp, 1, 13),
!:Carry = fquotient(!.Temp, 1, 13),
% Years
- !E ^ dt_year := S ^ dt_year + D ^ dur_years + !.Carry,
+ !E ^ dt_year := S ^ dt_year + !.Carry,
+ % Microseconds
+ !:Temp = S ^ dt_microsecond + D ^ dur_microseconds,
+ !E ^ dt_microsecond := modulo(!.Temp, microseconds_per_second),
+ !:Carry = div(!.Temp, microseconds_per_second),
% Seconds
- !:Temp = S ^ dt_second + D ^ dur_seconds,
+ !:Temp = S ^ dt_second + D ^ dur_seconds + !.Carry,
!E ^ dt_second := modulo(!.Temp, 60),
!:Carry = div(!.Temp, 60),
% Minutes
- !:Temp = S ^ dt_minute + D ^ dur_minutes + !.Carry,
+ !:Temp = S ^ dt_minute + !.Carry,
!E ^ dt_minute := int.mod(!.Temp, 60),
!:Carry = int.div(!.Temp, 60),
% Hours
- !:Temp = S ^ dt_hour + D ^ dur_hours + !.Carry,
+ !:Temp = S ^ dt_hour + !.Carry,
!E ^ dt_hour := int.mod(!.Temp, 24),
!:Carry = int.div(!.Temp, 24),
% Days
@@ -661,44 +794,49 @@
% Computing duration between dates.
%
-day_duration(Date2, Date1) = Duration :-
- builtin.compare(CompResult, Date1, Date2),
+day_duration(DateA, DateB) = Duration :-
+ builtin.compare(CompResult, DateB, DateA),
( CompResult = (<),
- Duration0 = day_duration(Date1, Date2),
+ Duration0 = day_duration(DateB, DateA),
Duration = negate(Duration0)
; CompResult = (=),
Duration = zero_duration
; CompResult = (>),
some [!Borrow] (
- Second1 = Date1 ^ dt_second,
- Second2 = Date2 ^ dt_second,
+ 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 = Date1 ^ dt_minute - !.Borrow,
- Minute2 = Date2 ^ dt_minute,
+ Minute1 = DateB ^ dt_minute - !.Borrow,
+ Minute2 = DateA ^ dt_minute,
subtract_ints_with_borrow(60, Minute1, Minute2, Minutes,
!:Borrow),
- Hour1 = Date1 ^ dt_hour - !.Borrow,
- Hour2 = Date2 ^ dt_hour,
+ Hour1 = DateB ^ dt_hour - !.Borrow,
+ Hour2 = DateA ^ dt_hour,
subtract_ints_with_borrow(24, Hour1, Hour2, Hours, !:Borrow),
- JDN1 = julian_day(Date1 ^ dt_year, Date1 ^ dt_month,
- Date1 ^ dt_day),
- JDN2 = julian_day(Date2 ^ dt_year, Date2 ^ dt_month,
- Date2 ^ dt_day),
+ JDN1 = julian_day(DateB ^ dt_year, DateB ^ dt_month,
+ DateB ^ dt_day),
+ JDN2 = julian_day(DateA ^ dt_year, DateA ^ dt_month,
+ DateA ^ dt_day),
Days = JDN1 - !.Borrow - JDN2,
- Duration = duration(0, 0, Days, Hours, Minutes, Seconds)
+ Duration = init_duration(0, 0, Days, Hours, Minutes, Seconds,
+ MicroSeconds)
)
).
-duration(Date2, Date1) = Duration :-
- compare(CompResult, Date1, Date2),
+duration(DateA, DateB) = Duration :-
+ compare(CompResult, DateB, DateA),
( CompResult = (<),
- greedy_subtract_descending(ascending, Date2, Date1, Duration0),
+ greedy_subtract_descending(ascending, DateA, DateB, Duration0),
Duration = negate(Duration0)
; CompResult = (=),
Duration = zero_duration
; CompResult = (>),
- greedy_subtract_descending(descending, Date1, Date2, Duration)
+ greedy_subtract_descending(descending, DateB, DateA, Duration)
).
:- type order
@@ -708,59 +846,64 @@
:- pred greedy_subtract_descending(order::in, date::in, date::in,
duration::out) is det.
- % This predicate has the precondition that Date1 < Date2. OriginalOrder is
+ % This predicate has the precondition that DateA < DateB. OriginalOrder is
% the original order of the date arguments (descending means that in the
- % original call Date1 < Date2, while ascending means that in the original
- % call Date1 > Date2). This is needed to correctly compute the days
- % dimension of the resulting duration. The calculation is different
+ % 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 invarient:
- % add_duration(duration(Date1, Date2), Date1, Date2)
- % to hold, and in the case where Date1 > Date2, Duration will be negative.
+ % add_duration(duration(DateA, DateB), DateA, DateB)
+ % to hold, and in the case where DateA > DateB, Duration will be negative.
%
-greedy_subtract_descending(OriginalOrder, Date1, Date2, Duration) :-
+greedy_subtract_descending(OriginalOrder, DateA, DateB, Duration) :-
some [!Borrow] (
- Second1 = Date1 ^ dt_second,
- Second2 = Date2 ^ dt_second,
- subtract_ints_with_borrow(60, Second1, Second2, Seconds,
+ 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),
- Minute1 = Date1 ^ dt_minute - !.Borrow,
- Minute2 = Date2 ^ dt_minute,
- subtract_ints_with_borrow(60, Minute1, Minute2, Minutes, !:Borrow),
- Hour1 = Date1 ^ dt_hour - !.Borrow,
- Hour2 = Date2 ^ dt_hour,
- subtract_ints_with_borrow(24, Hour1, Hour2, Hours, !: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, 0, 0), Date1,
- Date1Minus1Month),
- DaysToBorrow = max_day_in_month_for(Date1Minus1Month ^ dt_year,
- Date1Minus1Month ^ dt_month),
- Date1EndOfMonth = max_day_in_month_for(Date1 ^ dt_year,
- Date1 ^ dt_month),
- Day1 = Date1 ^ dt_day - !.Borrow,
- Day2 = int.min(Date2 ^ dt_day, Date1EndOfMonth)
+ 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(Date2 ^ dt_year,
- Date2 ^ dt_month),
- Date2EndOfMonth = max_day_in_month_for(Date2 ^ dt_year,
- Date2 ^ dt_month),
- Day1 = int.min(Date1 ^ dt_day - !.Borrow, Date2EndOfMonth),
- Day2 = Date2 ^ dt_day
+ 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, Day1, Day2, Days, !:Borrow),
- Month1 = Date1 ^ dt_month - !.Borrow,
- Month2 = Date2 ^ dt_month,
- subtract_ints_with_borrow(12, Month1, Month2, Months, !:Borrow),
- Year1 = Date1 ^ dt_year - !.Borrow,
- Year2 = Date2 ^ dt_year,
- ( Year1 >= Year2 ->
- Years = Year1 - Year2
+ 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,
+ ( YearA >= YearB ->
+ Years = YearA - YearB
;
- % If this happens then Date1 < Date2 which violates a precondition
+ % If this happens then DateA < DateB which violates a precondition
% of this predicate.
error("greedy_subtract_descending: " ++
"left over years")
),
- Duration = duration(Years, Months, Days, Hours, Minutes, Seconds)
+ Duration = init_duration(Years, Months, Days, Hours, Minutes, Seconds,
+ MicroSeconds)
).
% subtract_ints_with_borrow(BorrowAmount, Val1, Val2, Val, Borrow)
@@ -781,48 +924,69 @@
).
%-----------------------------------------------------------------------------%
-% Misc
+% The day of the week is computed by working out the Julian day modulo 7.
+% The algorithm is described at
+% http://en.wikipedia.org/wiki/Julian_day.
%
+day_of_week(Date) = DayOfWeek :-
+ JDN = julian_day(Date ^ dt_year, Date ^ dt_month, Date ^ dt_day),
+ Mod = JDN mod 7,
+ DayOfWeek = det_day_of_week_from_mod(Mod).
+
:- func julian_day(int, int, int) = int.
julian_day(Year, Month, Day) = JDN :-
- %
- % The following calculation comes from
- % http://en.wikipedia.org/wiki/Julian_day.
- %
A = (14 - Month) // 12,
Y = Year + 4800 - A,
M = Month + 12 * A - 3,
JDN = Day + ( 153 * M + 2 ) // 5 + 365 * Y + Y // 4 - Y // 100 + Y // 400
- 32045.
+:- func det_day_of_week_from_mod(int) = day_of_week.
+
+det_day_of_week_from_mod(Mod) = DayOfWeek :-
+ ( day_of_week_num(DayOfWeek0, Mod) ->
+ DayOfWeek = DayOfWeek0
+ ;
+ error("det_day_of_week_from_mod: invalid mod: " ++
+ int_to_string(Mod))
+ ).
+
+%-----------------------------------------------------------------------------%
+% Misc
+%
+
year(Date) = Date ^ dt_year.
month(Date) = det_month(Date ^ dt_month).
day_of_month(Date) = Date ^ dt_day.
hour(Date) = Date ^ dt_hour.
minute(Date) = Date ^ dt_minute.
second(Date) = Date ^ dt_second.
+microsecond(Date) = Date ^ dt_microsecond.
-years(Dur) = Dur ^ dur_years.
-months(Dur) = Dur ^ dur_months.
+years(Dur) = Dur ^ dur_months // 12.
+months(Dur) = Dur ^ dur_months rem 12.
days(Dur) = Dur ^ dur_days.
-hours(Dur) = Dur ^ dur_hours.
-minutes(Dur) = Dur ^ dur_minutes.
-seconds(Dur) = Dur ^ dur_seconds.
+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_date(Year, Month, Day, Hour, Minute, Second, Date) :-
+init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date) :-
Day >= 1,
Day =< max_day_in_month_for(Year, month_num(Month)),
Hour < 24,
Minute < 60,
Second < 62,
- Date = date(Year, month_num(Month), Day, Hour, Minute, Second).
+ MicroSecond < 1000000,
+ Date = date(Year, month_num(Month), Day, Hour, Minute, Second,
+ MicroSecond).
-det_init_date(Year, Month, Day, Hour, Minute, Second) = Date
+det_init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond) = Date
:-
(
- init_date(Year, Month, Day, Hour, Minute, Second, Date0)
+ init_date(Year, Month, Day, Hour, Minute, Second, MicroSecond, Date0)
->
Date = Date0
;
@@ -831,6 +995,9 @@
i(Minute), i(Second)]))
).
+unpack_date(date(Year, Month, Day, Hour, Minute, Second, MicroSecond),
+ Year, det_month(Month), Day, Hour, Minute, Second, MicroSecond).
+
current_local_time(Now, !IO) :-
time.time(TimeT, !IO),
TM = time.localtime(TimeT),
@@ -851,7 +1018,7 @@
Hour = TMHour,
Minute = TMMinute,
Second = TMSecond,
- Date = date(Year, Month, Day, Hour, Minute, Second).
+ Date = date(Year, Month, Day, Hour, Minute, Second, 0).
local_time_offset(TZ, !IO) :-
time.time(TimeT, !IO),
@@ -861,43 +1028,10 @@
GMTime = tm_to_date(GMTM),
TZ = duration(GMTime, LocalTime).
-init_positive_duration(Years, Months, Days, Hours, Minutes, Seconds) =
- ( all_non_negative(Years, Months, Days, Hours, Minutes, Seconds) ->
- duration(Years, Months, Days, Hours, Minutes, Seconds)
- ;
- func_error(string.format("init_positive_duration: some dimensions " ++
- "are negative: %iY%iM%iDT%iH%iM%iS", [i(Years), i(Months), i(Days),
- i(Hours), i(Minutes), i(Seconds)]))
- ).
-
-init_negative_duration(Years, Months, Days, Hours, Minutes, Seconds) =
- ( all_non_negative(Years, Months, Days, Hours, Minutes, Seconds) ->
- duration(-Years, -Months, -Days, -Hours, -Minutes, -Seconds)
- ;
- func_error(string.format("init_negative_duration: some dimensions " ++
- "are negative: %iY%iM%iDT%iH%iM%fS", [i(Years), i(Months), i(Days),
- i(Hours), i(Minutes), i(Seconds)]))
- ).
-
-:- pred all_non_negative(years::in, months::in, days::in, hours::in,
- minutes::in, seconds::in) is semidet.
-
-all_non_negative(Years, Months, Days, Hours, Minutes, Seconds) :-
- Years >= 0,
- Months >= 0,
- Days >= 0,
- Hours >= 0,
- Minutes >= 0,
- Seconds >= 0.
-
-:- func negate(duration) = duration.
+negate(duration(Months, Days, Seconds, MicroSeconds)) =
+ duration(-Months, -Days, -Seconds, -MicroSeconds).
-negate(duration(Years, Months, Days, Hours, Minutes, Seconds)) =
- duration(-Years, -Months, -Days, -Hours, -Minutes, -Seconds).
-
-:- func zero_duration = duration.
-
-zero_duration = duration(0, 0, 0, 0, 0, 0).
+zero_duration = duration(0, 0, 0, 0).
:- func det_month(int) = month.
@@ -929,20 +1063,18 @@
num_to_month(11, november).
num_to_month(12, december).
-day_of_week(Date) = DayOfWeek :-
- JDN = julian_day(Date ^ dt_year, Date ^ dt_month, Date ^ dt_day),
- Mod = JDN mod 7,
- DayOfWeek = det_day_of_week_from_mod(Mod).
-
-:- func det_day_of_week_from_mod(int) = day_of_week.
+:- pred char_to_digit(char::in, int::out) is semidet.
-det_day_of_week_from_mod(Mod) = DayOfWeek :-
- ( day_of_week_num(DayOfWeek0, Mod) ->
- DayOfWeek = DayOfWeek0
- ;
- error("det_day_of_week_from_mod: invalid mod: " ++
- int_to_string(Mod))
- ).
+char_to_digit('0', 0).
+char_to_digit('1', 1).
+char_to_digit('2', 2).
+char_to_digit('3', 3).
+char_to_digit('4', 4).
+char_to_digit('5', 5).
+char_to_digit('6', 6).
+char_to_digit('7', 7).
+char_to_digit('8', 8).
+char_to_digit('9', 9).
:- pred day_of_week_num(day_of_week, int).
:- mode day_of_week_num(in, out) is det.
diff -u tests/hard_coded/calendar_test.exp tests/hard_coded/calendar_test.exp
--- tests/hard_coded/calendar_test.exp 27 Jan 2009 03:38:06 -0000
+++ tests/hard_coded/calendar_test.exp 2 Feb 2009 01:18:12 -0000
@@ -7,6 +7,8 @@
P12M == P1Y
P1D == PT24H
PT1S =< PT1M1S
+PT1S =< PT1.0001S
+-PT1S >= -PT1.0001S
Adding durations to date-times:
1901-12-31 00:00:00 + P1D = 1902-01-01 00:00:00
@@ -25,6 +27,9 @@
1000-01-01 00:00:00 + -PT1M = 0999-12-31 23:59:00
2000-03-01 00:00:00 + -PT1H = 2000-02-29 23:00:00
-0001-01-01 00:00:00 + -PT1S = -0002-12-31 23:59:59
+-0001-01-01 00:00:00.123 + -PT1.123S = -0002-12-31 23:59:59
+2009-02-28 23:59:59.99 + PT0.01S = 2009-03-01 00:00:00
+2009-02-28 23:59:59.99 + P1MT0.02S = 2009-03-29 00:00:00.01
Computing durations:
G: 2008-01-01 00:00:00 -> 2200-04-04 04:04:04 = P192Y3M3DT4H4M4S checked ok
@@ -77,6 +82,11 @@
D: 1977-10-09 12:00:00 -> 1980-03-01 12:00:00 = P874D checked ok
D: 1980-03-01 12:00:00 -> 1977-10-09 12:00:00 = -P874D checked ok
+G: 1977-10-09 12:00:00 -> 1980-03-01 13:01:01.000007 = P2Y4M21DT1H1M1.000007S checked ok
+G: 1980-03-01 13:01:01.000007 -> 1977-10-09 12:00:00 = -P2Y4M23DT1H1M1.000007S checked ok
+D: 1977-10-09 12:00:00 -> 1980-03-01 13:01:01.000007 = P874DT1H1M1.000007S checked ok
+D: 1980-03-01 13:01:01.000007 -> 1977-10-09 12:00:00 = -P874DT1H1M1.000007S checked ok
+
Day of the week:
2008-01-15 23:59:00 : tuesday
@@ -87,0 +98,3 @@
+
+Parse test:
+P2Y6M100DT10H16M30.0003S
diff -u tests/hard_coded/calendar_test.m tests/hard_coded/calendar_test.m
--- tests/hard_coded/calendar_test.m 27 Jan 2009 03:29:06 -0000
+++ tests/hard_coded/calendar_test.m 2 Feb 2009 01:16:10 -0000
@@ -23,6 +23,8 @@
test_dur_leq("P12M", "P1Y", !IO), % ==
test_dur_leq("P1D", "PT24H", !IO), % ==
test_dur_leq("PT1S", "PT1M1S", !IO), % =<
+ test_dur_leq("PT1S", "PT1.0001S", !IO), % =<
+ test_dur_leq("-PT1S", "-PT1.0001S", !IO), % >=
io.nl(!IO),
io.write_string("Adding durations to date-times:\n", !IO),
test_add_dur("1901-12-31 00:00:00", "P1D", !IO),
@@ -41,6 +43,9 @@
test_add_dur("1000-01-01 00:00:00", "-PT1M", !IO),
test_add_dur("2000-03-01 00:00:00", "-PT1H", !IO),
test_add_dur("-0001-01-01 00:00:00", "-PT1S", !IO),
+ test_add_dur("-0001-01-01 00:00:00.123", "-PT1.123S", !IO),
+ test_add_dur("2009-02-28 23:59:59.99", "PT0.01S", !IO),
+ test_add_dur("2009-02-28 23:59:59.99", "P1MT0.02S", !IO),
io.nl(!IO),
io.write_string("Computing durations:\n", !IO),
test_diff("2008-01-01 00:00:00", "2200-04-04 04:04:04", !IO),
@@ -53,6 +58,7 @@
test_diff("1975-06-05 12:00:00", "1977-10-09 12:00:00", !IO),
test_diff("1977-10-09 12:00:00", "1980-01-05 11:11:11", !IO),
test_diff("1977-10-09 12:00:00", "1980-03-01 12:00:00", !IO),
+ test_diff("1977-10-09 12:00:00", "1980-03-01 13:01:01.000007", !IO),
io.nl(!IO),
io.write_string("Day of the week:\n", !IO),
test_day_of_week("2008-01-15 23:59:00", !IO),
@@ -60,7 +66,12 @@
test_day_of_week("1360-04-14 00:00:00", !IO),
test_day_of_week("1865-02-27 00:00:00", !IO),
test_day_of_week("1886-02-08 00:00:00", !IO),
- test_day_of_week("1929-10-28 00:00:00", !IO).
+ test_day_of_week("1929-10-28 00:00:00", !IO),
+ io.nl(!IO),
+ io.write_string("Parse test:\n", !IO),
+ io.write_string(duration_to_string(
+ det_duration_from_string("P1Y18M100DT10H15M90.0003S")), !IO),
+ io.nl(!IO).
:- pred test_dur_leq(string::in, string::in, io::di, io::uo) is det.
only in patch2:
unchanged:
--- NEWS 12 Jan 2009 02:28:45 -0000 1.499
+++ NEWS 2 Feb 2009 01:54:13 -0000
@@ -235,6 +235,9 @@
map.from_sorted_assoc_list now also constructs the tree directly, so now
it requires its input list to be duplicate-free.
+* We have added a calendar module to the standard library. This module
+ contains utilities for working with the Gregorian calendar.
+
Changes to the Mercury compiler:
* We have added support for trail segments, which allow programs to grow
only in patch2:
unchanged:
--- tests/hard_coded/Mmakefile 2 Jan 2009 03:12:09 -0000 1.362
+++ tests/hard_coded/Mmakefile 1 Feb 2009 10:26:28 -0000
@@ -16,6 +16,7 @@
brace \
builtin_inst_rename \
c_write_string \
+ calendar_test \
cc_and_non_cc_test \
cc_multi_bug \
cc_nondet_disj \
@@ -274,6 +275,7 @@
address_of_builtins \
brace \
c_write_string \
+ calendar_test \
compare_spec \
constant_prop_2 \
contains_char \
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list