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