dates.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
abstract class $DATES{TYP} < $ORDERED{TYP}, $HASH, $BINARY, $TEXT,
abstract class $DATES{TYP} < $ORDERED{TYP}, $HASH, $BINARY, $TEXT,
$ANCHORED_FMT is
-- This abstraction is necessary because cultures may adopt a calendar
-- which is not the Gregorian one used in Europe and other countries. All
-- variants must, however, provide the properties indicated in this class.
-- Version 1.0 Jun 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 16 Jun 97 kh Original
create(
time_stamp : TIME_STAMP
) : SAME ;
-- This routine returns the date component of the given time_stamp
today : SAME ;
-- This routine returns the current date as a value of UTC date/time,
-- as indicated by the computer system clock
create(
str : STR
) : SAME ;
-- This routine attempts to convert a string in str into a valid date.
-- The string is assumed to be a representation of a UTC date.
count : CARD ;
-- This procedure returns the number of days since the base date.
plus(
num : ELAPSED
) : SAME ;
-- This returns the result of adding a number of days to the date.
minus(
num : ELAPSED
) : SAME ;
-- This returns the effect of subtracting a number of days from the date
-- provided that this still yields a positive date! Otherwise an exception
-- is raised.
minus(
other : TYP
) : ELAPSED ;
-- This returns the difference between self and other as an elapsed
-- number of days. This is always positive irrespective of whether self
-- is greater than other or not.
year : CARD ;
-- This routine returns the number of years in self since the beginning
-- of the current era.
day_in_year : CARD ;
-- This routine returns the number in the range 1 to 366 giving the
-- day component of a Julian date for self.
week_in_year : CARD ;
-- This routine returns the number in the range 1 to 53 giving the
-- week in the current year.
month_number : CARD ;
-- This routine returns the number of the month in the current year
-- in self.
date : CARD ;
-- This routine returns the day in the current month represented by self.
day_of_week : CARD ;
-- This routine returns the day of the week represented by self.
weekday : WEEKDAYS ;
-- This routine returns the day of the week represented by self as
-- an enumerated value.
end ; -- $DATES{TYP}
immutable class DATES < $DATES{DATES}
immutable class DATES < $DATES{DATES} is
-- This class provides the ability to find, check and manipulate dates
-- alone -- ie not including the time aspects of OS_TIME.
--
-- NOTE 1. All dates are assumed to be in the same time zone. If time zone
-- conversions are to be made then a time stamp should be used (see the
-- class TIME_STAMP).
--
-- 2. If no conversions are needed then it is possible to use a date
-- as a local one. However, use of the today feature will always
-- produce a date in UTC time!!
-- Version 1.4 Oct 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 3 Jun 96 kh Original from Modula-2 library.
-- 8 Apr 97 kh Modified for ISO/IEC 14652.
-- 15 Jun 97 kh Base everything around TIME_STAMP
-- 1 Oct 98 kh Factored out conversions, added binary.
-- 29 Oct 98 kh Refined, added pre/post conditions.
-- 28 Oct 99 kh Added time zone refinements
include COMPARABLE ;
include BINARY ;
include DATE_STR ;
private attr val : CARD ;
const Years_in_Century : CARD := 100 ;
private const Leap_Cycle : CARD := 4 ;
const Days_in_Week : CARD := 7 ;
const Months_in_Year : CARD := 12 ;
private const Days_in_Year : CARD := 365 ; -- in an ordinary year anyway!
private const Base_Year : CARD := OS_TIME::Base_Year ;
private const Base_Wday : WEEKDAYS := OS_TIME::Base_Wday ;
-- The base date is the first day of the base year and is day ZERO!
private const February : CARD := 2 ;
private const Month_Max : ARRAY{CARD} := | 0, 31, 28, 31, 30, 31, 30,
31, 31, 30, 31, 30, 31 | ;
-- NOTE The above array has a dummy entry at the beginning!
null : SAME is
-- This routine returns the null (base) date.
return val(0)
end ;
nil : SAME is
-- This routine returns the null (base) date.
return val(CARD::nil)
end ;
build(
cursor : BIN_CURSOR
) : SAME
pre ~void(cursor)
and ~cursor.is_done
post true
is
-- This routine builds a date value from the binary string indicated.
-- Care should be taken that the time-zone is also known - the preferred
-- standard being UTC.
base : CARD := CARD::build(cursor) ;
offset : CARD := CARD::build(cursor) ;
if base = Base_Year then
return val(offset)
else -- need to do some arithmetic!
if base > Base_Year then
return val(offset - days_in_years(base))
else -- its less!
loop
count : CARD := (Base_Year - 1).downto!(year) ;
if is_leap_year(count) then
offset := offset + Days_in_Year + 1
else
offset := offset + Days_in_Year
end
end ;
return val(offset)
end
end
end ;
create(
time_stamp : TIME_STAMP
) : SAME
pre ~(time_stamp = TIME_STAMP::create(0,0))
post (result.val = time_stamp.num_days)
is
-- This routine returns the date component of the given time_stamp.
-- Use of this should be restricted to the UTC time if mixed with
-- values produced by the today feature below.
return val(time_stamp.num_days)
end ;
from_days(
days : CARD
) : SAME
pre true
post (result.val = days)
is
-- This routine creates a new date which has the given number of days
-- after the day preceding the base date!
return val(days)
end ;
today : SAME
pre true
post (result.val > 0) -- since base date is some time in the past!
is
-- This routine returns the current date as indicated by the computer
-- system clock in UTC time.
sys : OS_TIME := OS_TIME::time_stamp ;
return val(sys.days)
end ;
private days_in_years(
year : CARD
) : CARD
pre (year >= Base_Year)
post true
is
-- This routine returns the number of days since the base date up to
-- the beginning of the year indicated.
leap_days : CARD := 0 ;
loop
loc_year : CARD := Base_Year.upto!(year - 1) ;
if is_leap_year(loc_year) then
leap_days := leap_days + 1
end
end ;
return (year - Base_Year) * Days_in_Year + leap_days
end ;
private days_in_months(
months : CARD,
leap : BOOL
) : CARD
pre (months > 0)
and (months <= Months_in_Year)
post true
is
-- This routine returns the number of days in the year up to the
-- beginning of the given month, taking account of the fact that the year is
-- (or is not) a leap year.
res : CARD := 0 ;
if (months > February)
and leap then
res := 1
end ;
loop
index : CARD := 1.upto!(months - 1) ;
res := res + Month_Max[index]
end ;
return res
end ;
create(
days : CARD,
months : CARD,
year : CARD
) : SAME
pre (months > 0)
and (months <= Months_in_Year)
and (days > 0)
and ((days <= Month_Max[months])
or (is_leap_year(year)
and (months = February)
and (days = (Month_Max[February] + 1))))
post true
is
-- This routine returns the date given the three components which must,
-- of course, form a valid Gregorian date.
return val(days_in_years(year) +
days_in_months(months,is_leap_year(year)) + (days - 1))
end ;
create(
julian_days : CARD,
year : CARD
) : SAME
pre (julian_days <= Days_in_Year)
or (is_leap_year(year)
and (julian_days = Days_in_Year + 1))
post true
is
-- This routine returns the date given the date in ONE-based Julian for
-- with the day in year and year arguments.
return val(days_in_years(year) + (julian_days - 1))
end ;
binstr : BINSTR
pre true
post val.binstr = result
is
-- This routine returns a binary string form representation of the date
-- indicated by self.
return Base_Year.binstr + val.binstr
end ;
is_leap_year(
yr : CARD
) : BOOL is
-- This predicate returns true if and only if the year value supplied is
-- a leap year, otherwise false.
if (yr.mod(Years_in_Century) = 0) then
return (yr.mod(Years_in_Century * Leap_Cycle) = 0)
else
return (yr.mod(Leap_Cycle) = 0)
end
end ;
is_eq(
other : SAME
) : BOOL is
-- This predicate returns true iff other and same represent the same
-- date.
return val = other.val
end ;
is_lt(
other : SAME
) : BOOL is
-- This predicate returns true iff self is earlier than other.
return val < other.val
end ;
is_nil : BOOL is
-- This predicate returns true iff other and same represent the same
-- date.
return val = CARD::nil
end ;
count : CARD
pre true
post result = self.val
is
-- This routine returns the number of days since the base date --
-- ie it merely returns self!
return val
end ;
plus(
num : ELAPSED
) : SAME
pre (CARD::maxval - num.days) >= val
post (result.val = count + num.days)
is
-- This routine returns the date which is the result of adding a number
-- of days to self.
return val(count + num.days)
end ;
minus(
num : ELAPSED
) : SAME
pre (num.days >= val)
post (result.val = (count - num.days))
is
-- This returns the effect of subtracting a number of days from the date
-- provided that this yields a date not earlier than the operating system
-- dependent base date.
return val(count - num.days)
end ;
minus(
other : SAME
) : ELAPSED
pre true
post ((val < other.val)
and (result.days = (other.count - count)))
or (result.days = (count - other.count))
is
-- This returns the difference between self and other as an elapsed
-- number of days. This is always positive irrespective of whether self
-- is greater than other or not.
if val < other.val then
return ELAPSED::create(other.val - val, 0) -- NO milliseconds
else
return ELAPSED::create(val - other.val, 0)
end
end ;
-- The following group of routines are private auxiliaries
-- used in determining some date component for use when
-- carrying out date manipulations.
private year_count(
days : CARD,
out days_left : CARD
) : CARD
pre true
post (days_left <= (Days_in_Year + 1))
is
-- This routine returns the number of years since the base year
-- represented by the days argument and sets days-left to be the number of
-- days into the current year!
loc_yr : CARD := Base_Year ; -- initialise loop!
loc_length : CARD := Days_in_Year ; -- Assume not a leap year
loc_days : CARD := days ;
loop
if is_leap_year(loc_yr) then
loc_length := loc_length + 1
end ;
if loc_days < loc_length then
break!
end ;
loc_days := loc_days - loc_length ;
loc_yr := loc_yr + 1 ;
loc_length := Days_in_Year
end ;
days_left := loc_days ;
return loc_yr - Base_Year
end ;
private find_month(
day_in_year : CARD, -- from end of previous year.
leap : BOOL, -- this year is a leap year
out date : CARD -- in current month.
) : CARD
pre (leap
and (day_in_year <= Days_in_Year))
or (~leap
and (day_in_year <= (Days_in_Year + 1)))
post (date > 0)
and (result > 0)
and (result <= Months_in_Year)
and (((result = February)
and (date <= (Month_Max[February] + 1)))
or (date <= Month_Max[result]))
is
-- This routine returns the month in the year in the range 1 to 12 and
-- sets date to be the date in that month, given the zero-based day in year.
loc_month : CARD := 1 ; -- initialise loop!
loc_length : CARD := Month_Max[loc_month] ; -- January
loc_days : CARD := day_in_year ;
loop
if (loc_month = February)
and leap then
loc_length := loc_length + 1
end ;
if loc_days < loc_length then
break!
end ;
loc_days := loc_days - loc_length ;
loc_month := loc_month + 1 ;
loc_length := Month_Max[loc_month]
end ;
date := loc_days + 1 ;
return loc_month
end ;
-- The following pairs of routines are provided for use when
-- providing an individual date component value.
private year(
days : CARD
) : CARD
pre true -- since result is always less than CARD::maxval
post ((result - Base_Year) * Days_in_Year) <= days
is
-- This private routine returns the whole number of years of the date
-- represented by days since the beginning of the current era.
loc_days : CARD ;
return year_count(days,out loc_days) + Base_Year
end ;
year : CARD
pre true -- since result is always less than CARD::maxval
post ((result - Base_Year) * Days_in_Year) <= val
is
-- This routine returns the number of years in self since the beginning
-- of the current era.
return year(val)
end ;
private century(
days : CARD
) : CARD
pre true
post (result = (year(days) / Years_in_Century))
is
-- This private routine returns the current century of the date
-- represented by days in the current era.
return year(days) / Years_in_Century
end ;
century : CARD
pre true
post (result = (year(val) / Years_in_Century))
is
-- This routine returns the current century in the date represented by
-- self in the current era.
return century(val)
end ;
private year_this_century(
days : CARD
) : CARD
pre true
post (result = (year(days) % Years_in_Century))
is
-- This routine returns the whole number of years in days in the current
-- century, taking account of leap years.
return year(days) % Years_in_Century
end ;
year_this_century : CARD
pre true
post (result = (year(val) % Years_in_Century))
is
-- This routine returns the number of years in self since the beginning
-- of the current century.
return year_this_century(val)
end ;
private day_in_year(
days : CARD
) : CARD
pre true
post (result > 0)
and ((is_leap_year(year(days))
and (result <= (Days_in_Year + 1)))
or (result <= Days_in_Year))
is
-- This routine returns the number in the range 1 to 366 giving the
-- day component of a Julian date for days.
days_left : CARD ;
loc_year : CARD := year_count(days,out days_left) ;
return days_left + 1
end ;
day_in_year : CARD
pre true
post (result > 0)
and ((is_leap_year(year)
and (result <= (Days_in_Year + 1)))
or (result <= Days_in_Year))
is
-- This routine returns the number in the range 1 to 366 giving the
-- day component of a Julian date for self.
return day_in_year(val)
end ;
private year_start_day(
days : CARD
) : WEEKDAYS
pre true
post ~result.is_nil
is
-- This routine returns the day of the week for the first day in the
-- year deduced from the given number of days after the base date.
loc_offset : CARD ; -- for days in this year!
dummy : CARD := year_count(days,out loc_offset) ;
loc_offset := (days - loc_offset) % Days_in_Week ;
res : WEEKDAYS := Base_Wday ; -- initial guess!
loop
loc_offset.times! ;
res := res.next
end ;
return res
end ;
year_start_day : WEEKDAYS
pre true
post ~result.is_nil
is
-- This routine returns the day of the week for the first day in the
-- year.
return year_start_day(val)
end ;
private week_in_year(
days : CARD
) : CARD
pre true
post ((result * Days_in_Week) >= (day_in_year(days) - 1 + Base_Wday.card))
is
-- This routine returns the number in the range 1 to 53 given the
-- number of days since the base date.
loc_day : CARD := day_in_year(days) - 1 + Base_Wday.card ;
res : CARD := loc_day / Days_in_Week ;
if loc_day % Days_in_Week > 0 then
res := res + 1
end ;
return res
end ;
week_in_year : CARD
pre true
post ((result * Days_in_Week) >= (day_in_year(val) - 1 + Base_Wday.card))
is
-- This routine returns the number in the range 1 to 53 corresponding
-- to the number of weeks in the year represented by self.
return week_in_year(val)
end ;
private month_number(
days : CARD
) : CARD
pre true
post (result > 0)
and (result <= Months_in_Year) -- could be expanded!
is
-- This routine returns the month in the current year, counting the
-- first month as 1.
loc_temp : CARD ;
days_left : CARD ;
loc_year : CARD := year_count(days,out days_left) ;
res : CARD := find_month(days_left,
is_leap_year(loc_year + Base_Year),out loc_temp) ;
return res
end ;
month_number : CARD
pre true
post (result > 0)
and (result <= Months_in_Year) -- could be expanded!
is
-- This routine returns the number of the month in the current year
-- in self.
return month_number(val)
end ;
private month(
days : CARD
) : MONTHS
pre true
post (result.card = days)
is
-- This routine returns the month in the current year, counting the
-- first month as 1.
return MONTHS::create(days)
end ;
month : MONTHS
pre true
post (result.card = month_number)
is
-- This routine returns the month in the current year represented by
-- self.
return month(month_number)
end ;
private date(
days : CARD
) : CARD
pre true
post (is_leap_year(year(days))
and (month_number(days) = February)
and (result <= Month_Max[February] + 1))
or (result <= Month_Max[month_number(days)])
is
-- This routine returns the date in the current month represented by
-- the given number of days after the base date.
res : CARD ;
days_left : CARD ;
loc_year : CARD := year_count(days,out days_left) ;
dummy : CARD := find_month(days_left,
is_leap_year(loc_year + Base_Year),out res) ;
return res
end ;
date : CARD
pre true
post (is_leap_year(year(val))
and (month_number(val) = February)
and (result <= Month_Max[February] + 1))
or (result <= Month_Max[month_number(val)])
is
-- This routine returns the day in the current month represented by self.
return date(val)
end ;
private day_of_week(
days : CARD
) : CARD
pre true
post true
is
-- This routine returns the day of the week represented by days, Sunday
-- being day ONE.
loc_offset : CARD := days % Days_in_Week ;
res : WEEKDAYS := Base_Wday ; -- initial guess!
loop
loc_offset.times! ;
res := res.next
end ;
return res.card
end ;
day_of_week : CARD
pre true
post true
is
-- This routine returns the day of the week represented by self.
return day_of_week(val)
end ;
private weekday(
days : CARD
) : WEEKDAYS
pre true
post (result = WEEKDAYS::create(day_of_week(days)))
is
-- This routine returns the day of the week as enumerated value.
#ERR + "weekday of " + days.str + "\n" ;
return WEEKDAYS::create(day_of_week(days))
end ;
weekday : WEEKDAYS
pre true
post (result = WEEKDAYS::create(day_of_week))
is
-- This routine returns the day of the week represented by self as
-- an enumerated value.
return WEEKDAYS::create(day_of_week)
end ;
hash : CARD
pre true -- irrespective of date
post true -- irrespective of hash value!
is
-- This routine is provided to enable the establishment of date based
-- ueues/lists.
return val.hash
end ;
end ; -- DATES