ranges.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 $RANGE{NTP < $CARDINAL{NTP}} < $ELT{NTP},
abstract class $RANGE{NTP < $CARDINAL{NTP}} < $ELT{NTP},
$IS_EQ,
$BINARY, $TEXT, $ANCHORED_FMT is
-- This abstraction embodies the concept of a numeric sub-range from
-- which values may be drawn and against which values may be tested. The
-- principal operations offered are tests for intersection, merging
-- (partially) intersecting ranges , etc.
-- Version 1.0 Sep 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 8 Sep 97 kh Original
empty : SAME ; -- The empty range!
is_empty : BOOL ; -- This routine returns true if and only if self is an empty range.
contains(val : NTP) : BOOL ;
-- This routine returns true iff val lies within the range.
offset(range_val : NTP) : NTP ;
-- This routine returns the value of range_val as an offset from zero,
-- taking into account the range low limit.
first : NTP ;
-- This routine returns the lowest value in the range provided that
-- the range is not empty.
last : NTP ;
-- This routine returns the highest value in the range provided that
-- the range is not empty.
is_disjoint(other : $RANGE{NTP}) : BOOL ;
-- This predicate returns true if and only if self and other do not
-- overlap.
is_intersecting(other : $RANGE{NTP}) : BOOL ;
-- This predicate returns true if and only if the ranges of other and
-- self have one or more common values.
is_adjacent(other : $RANGE{NTP}) : BOOL ;
-- This predicate returns true if and only if self and other are
-- adjacent or intersecting.
intersection(other : $RANGE{NTP}) : SAME ;
-- This feature returns the intersection of self and other unless they
-- are disjoint when the empty range is returned..
union(other : $RANGE{NTP}) : SAME ;
-- This feature returns the union of self and other provided that they
-- are not disjoint, when the empty range shall be returned.
merge(other : $RANGE{NTP}) : SAME ;
-- This routine returns the union of self and other providing they are
-- adjacent or intersecting, otherwise the empty range.
rev! : NTP ;
-- This iter feature yields all of the values of self from high - 1
-- down to and including low in turn.
end ; -- $RANGE
partial class RANGE{XTP} < $RANGE{XTP}
partial class RANGE{XTP} < $RANGE{XTP} is
-- This class embodies the notion of an inclusive range of values as,
-- for example, in code repertoires, for which it was originally designed.
--
-- NOTE The existence of a range necessarily implies that there is at least
-- one element. An empty range may therefore be represented by
-- a range having no elements.
-- Version 1.1 Nov 96. Copyright K Hopper,U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 11 May 96 kh Original
-- 12 Nov 96 kh Modified for portability.
include COMPARABLE ;
include BINARY ;
include RANGE_STR{XTP} ;
readonly attr low, high : XTP ; -- low = high implies 'empty'
invariant : BOOL is
return (high >= low)
end ;
empty : SAME is
-- This routine returns an empty range which is represented by having
-- low and high the same value -- irrespective of what that value may be!
return low(XTP::one).high(XTP::one) -- just so this is NOT void!
end ;
create(from,to : XTP) : SAME
pre (to >= from)
post (result.low = from) and (result.high = to + XTP::one)
is
-- This creation routine merely returns the compound object. Note that
-- the pre-condition implies that the range will NOT be empty.
return low(from).high(to + XTP::one)
end ;
build(index : BIN_CURSOR) : SAME
pre (index.remaining >= (XTP::zero.binstr.size + XTP::zero.binstr.size))
post true
is
-- This creation routine merely returns the compound object. Note that
-- the pre-condition implies that the range will NOT be void.
--#OUT+"RANGE::build\n";
loc_low : XTP := XTP::build(index) ;
loc_hi : XTP := XTP::build(index) ;
return low(loc_low).high(loc_hi)
end ;
binstr : BINSTR
pre ~is_empty
post create(result) = self
is
-- This routine returns self in the form of binary string representation.
return low.binstr + high.binstr
end ;
is_empty : BOOL is
-- This predicate returns true if and only if self is an empty range.
return void(self) or (low = high)
end ;
is_eq(other : SAME) : BOOL is
-- This predicate returns true if and only if the high and low values of
-- self and other are the same.
return (other.low = low) and
(other.high = high)
end ;
is_lt(other : SAME) : BOOL is
-- This predicate returns true if and only if the high value of self is
-- strictly less than the low value of other -- taking into account the fact
-- that the stored 'high' is one greater than the actual end of the range.
return (self.high <= other.low)
end ;
is_disjoint(other : SAME) : BOOL is
-- This predicate returns true if and only if self and other do not
-- overlap.
return is_empty
or other.is_empty
or (other.low >= high)
or (low >= other.high)
end ;
is_intersecting(other : SAME) : BOOL is
-- This predicate returns true if and only if the ranges of other and
-- self have one or more common values.
return ~is_disjoint(other)
end ;
is_adjacent(other : SAME) : BOOL is
-- This predicate returns true if and only if self and other are
-- adjacent or intersecting.
return (self.high = other.low)
or (other.high = self.low)
or is_intersecting(other)
end ;
contains(val : XTP) : BOOL is
-- This predicate returns true iff val lies in the range. Note the
-- assymetric test since high is always one greater than the high defined
-- when created, etc.
return (val >= low) and (val < high)
end ;
size : CARD
pre true
post result = (high - low).card
is
-- This routine returns the number of elements in the range. It is a
-- renaming of the range routine to satisfy the inheritance from $ELT.
return (high - low).card
end ;
offset(range_val : XTP) : XTP
pre contains(range_val)
post result = (range_val - low)
is
-- This routine returns the value of range_val as an offset from zero,
-- taking into account the range low limit.
return range_val - low
end ;
first : XTP
pre ~is_empty
post result = low
is
-- This routine returns the lowest value in the range provided that
-- the range is not empty.
return low
end ;
last : XTP
pre ~is_empty
post result = (high - XTP::one)
is
-- This routine returns the highest value in the range provided that
-- the range is not empty.
return high - XTP::one
end ;
intersection(other : SAME) : SAME
pre true
post ((low >= other.low)
and (result.low = low)
and (result.high = other.high))
or (is_disjoint(other)
and result.is_empty)
or ((result.low = other.low)
and (result.high = high))
is
-- This routine returns the intersection of self and other.
if is_disjoint(other) then
return empty
elsif low >= other.low then -- other is lower
return create(low, other.high - XTP::one)
else
return create(other.low, high - XTP::one)
end
end ;
union(other : SAME) : SAME
pre ~is_disjoint(other)
post ((low >= other.low)
and (result.low = other.low)
and (result.high = high))
or ((result.low = low)
and( result.high = other.high))
is
-- This routine returns the union of self and other.
if low >= other.low then
return create (other.low, high - XTP::one)
else
return create(low, other.high - XTP::one)
end
end ;
merge(other : SAME) : SAME
pre is_adjacent(other)
post (((low >= other.low)
and (result.low = other.low))
or (result.low = low))
and (((high >= other.high)
and (result.high = high))
or (result.high = other.high))
is
-- This routine returns the union of self and other providing they are
-- adjacent or intersecting.
loc_low : XTP ;
loc_high : XTP ;
if low >= other.low then
loc_low := other.low
else
loc_low := low
end ;
if high >= other.high then
loc_high := high
else
loc_high := other.high
end ;
return create(loc_low, loc_high - XTP::one)
end ;
elt! : XTP
pre ~is_empty
post true -- (result = low.upto!(high - T::one))
is
-- This iter yields all of the values from low up to (but not including)
-- high in turn.
val : XTP := low ;
loop
until!(val = high) ;
yield val ;
val := val + XTP::one
end
end ;
rev! : XTP
pre ~is_empty
post true -- (result = (high - 1 - T::zero.up!))
is
-- This iter yields all of the values of self from high - 1 down to and
-- including low in turn.
val : XTP := high ;
loop
until!(val = low) ;
val := val - XTP::one ;
yield val
end
end ;
private spread_extra!(once range : XTP,once cnt : CARD) : XTP
pre (cnt > 0) and (cnt < INT::maxval.card)
post true
is
-- This iter yields cnt successive values in the given range spreading
-- any remainder over the first values yielded.
quot : XTP := range / XTP::create(cnt) ;
rem : XTP := range % XTP::create(cnt) ;
if (rem = XTP::zero) then -- no remainder to spread
loop
cnt.times! ;
yield quot
end
else -- spread over rem yields
loop
rem.times! ;
yield (quot + XTP::one)
end ;
loop
(XTP::create(cnt) - rem).times! ;
yield quot
end
end
end ;
private lump_at_end!(once range : XTP,once cnt : CARD) : XTP is
-- This iter yields the size of cnt successive sub-ranges of range,
-- placing any remainder of an uneven division in the last sub-range.
quot : XTP := range / XTP::create(cnt) ;
rem : XTP := range % XTP::create(cnt) ;
loop
(cnt - 1).times! ;
yield quot
end ;
yield quot + rem
end ;
end ; -- RANGE{XTP}
immutable class RANGE
immutable class RANGE is
-- This class embodies the notion of an inclusive range of values as,
-- for example, in code repertoires, for which it was originally designed.
-- Version 1.2 Sep 97. Copright K Hopper,U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 11 May 96 kh Original
-- 12 Nov 96 kh Modified for portability.
-- 8 Sep 97 kh Developed into abstraction and partial class!
include RANGE{CARD} ;
aget(index : CARD) : CARD
pre ~is_empty
post result = low + index
is
-- This 'array' operation permits the range to be treated as a read-only
-- array which may be indexed from 0.
return low + index
end ;
shift_up(by : CARD) : SAME
pre ~is_empty
post (result.low = low + by)
and (result.high = high + by)
is
-- This routine returns a range of the same size as self but offset to
-- a higher numeric value.
return create(low + by,high + by - 1)
end ;
shift_down(by : CARD) : SAME
pre ~is_empty
and (by <= low)
post (result.low = low - by)
and (result.high = high - by)
is
-- This routine returns a range of the same size as self but offset to
-- a lower numeric value.
return create(low - by,high - by - 1)
end ;
equally!(once cnt : CARD) : SAME
pre ~is_empty and (cnt > 0)
post true
is
-- This iter yields cnt sub-ranges of self divided equally if
-- possible. If there is a remainder then it is spread evenly over the
-- first 'remainder' sub-ranges.
loc_low : CARD := low ;
loc_end : CARD := low ;
loop
loc_end := loc_end + spread_extra!(high - low,cnt) ;
yield create(loc_low,loc_end - CARD::one) ;
loc_low := loc_end
end
end ;
partition!(once cnt : CARD) : SAME
pre ~is_empty
and (cnt > 0)
post true
is
-- This iter distributes the range self into cnt sub-ranges, all equal
-- except for the last which contains any remainder items.
loc_low : CARD := low ;
loc_end : CARD := low ;
loop
loc_end := loc_end + lump_at_end!(high - low,cnt) ;
yield create(loc_low,loc_end - 1) ;
loc_low := loc_end
end
end ;
end ; -- RANGE
immutable class INT_RANGE
immutable class INT_RANGE is
-- This class implements an integer range for which either component may
-- be negative, providing only that the invariant is retained.
-- Version 1.0 Sep 97. Copright K Hopper,U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 8 Sep 97 kh Developed from Sather dist I_INTERVAL class
include RANGE{INT} ;
aget(index : CARD) : INT
pre ~is_empty
post result = low + index.int
is
-- This 'array' operation permits the range to be treated as a read-only
-- array which may be indexed from 0.
return low + index.int
end ;
shift_up(by : CARD) : SAME
pre ~is_empty
post (result.low = low + by.int)
and (result.high = high + by.int)
is
-- This routine returns a range of the same size as self but offset to
-- a higher numeric value.
return create(low + by.int,high + by.int - INT::one)
end ;
shift_down(by : CARD) : SAME
pre ~is_empty
and (by.int <= low)
post (result.low = low - by.int)
and (result.high = high - by.int)
is
-- This routine returns a range of the same size as self but offset to
-- a lower numeric value.
return create(low - by.int,high - by.int - INT::one)
end ;
equally!(once cnt : CARD) : SAME
pre ~is_empty
and (cnt > 0)
post true
is
-- This iter yields cnt sub-ranges of self divided equally if
-- possible. If there is a remainder then it is spread evenly over the
-- first 'remainder' sub-ranges.
loc_low : INT := low ;
loc_end : INT := low ;
loop
loc_end := loc_end + spread_extra!((high - low),cnt).int ;
yield create(loc_low,loc_end - 1.int) ;
loc_low := loc_end
end
end ;
partition!(once cnt : CARD) : SAME
pre ~is_empty
and (cnt > 0)
post true
is
-- This iter distributes the range self into cnt sub-ranges, all equal
-- except for the last which contains any remainder items.
loc_low : INT := low ;
loc_end : INT := low ;
loop
loc_end := loc_end + lump_at_end!((high - low),cnt).int ;
yield create(loc_low,loc_end - 1.int) ;
loc_low := loc_end
end
end ;
end ; -- INT_RANGE