(********************************************************************) (* *) (* bitsetof.s7i Support for bitsets of a base type *) (* Copyright (C) 1989 - 2012 Thomas Mertes *) (* *) (* This file is part of the Seed7 Runtime Library. *) (* *) (* The Seed7 Runtime Library is free software; you can *) (* redistribute it and/or modify it under the terms of the GNU *) (* Lesser General Public License as published by the Free Software *) (* Foundation; either version 2.1 of the License, or (at your *) (* option) any later version. *) (* *) (* The Seed7 Runtime 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 the GNU Lesser General Public License for more *) (* details. *) (* *) (* You should have received a copy of the GNU Lesser General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 51 Franklin Street, *) (* Fifth Floor, Boston, MA 02110-1301, USA. *) (* *) (********************************************************************) (** * Abstract data type, describing sets of ''baseType'' values. * This abstract data type assumes that ''baseType'' values can be * mapped to [[integer]] with the ''ord'' function. * Sets of [[integer]] numbers are described with [[bitset]]. *) const func type: bitset (in type: baseType) is func result var type: setType is void; local var type: tupleType is void; var type: array_type is void; begin setType := get_type(getfunc(bitset(attr baseType))); if setType = void then global setType := newtype; IN_PARAM_IS_REFERENCE(setType); const boolean: isSetType (attr setType) is TRUE; const type: bitset (attr baseType) is setType; const type: base_type (attr setType) is baseType; const proc: (ref setType: dest) ::= (in setType: source) is action "SET_CREATE"; const proc: destroy (ref setType: aValue) is action "SET_DESTR"; const proc: (inout setType: dest) := (in setType: source) is action "SET_CPY"; const boolean: isBitset (attr setType) is TRUE; const func bitset: bitset (in setType: aSet) is action "SET_CONV1"; const func bitset: (attr bitset) conv (in setType: aSet) is action "SET_CONV3"; const varfunc bitset: (attr bitset) varConv (inout setType: aSet) is action "TYP_VARCONV"; const func setType: (attr setType) conv (in bitset: aSet) is action "SET_CONV3"; const setType: (attr setType) . EMPTY_SET is setType conv EMPTY_SET; (** * Default value of ''setType'' ({}). *) const setType: (attr setType) . value is setType conv EMPTY_SET; (** * Union of two sets. * {'a', 'b'} | {'a', 'c'} returns {'a', 'b', 'c'} * @return the union of the two sets. * @exception MEMORY_ERROR Not enough memory for the result. *) const func setType: (in setType: set1) | (in setType: set2) is action "SET_UNION"; (** * Intersection of two sets. * {'a', 'b'} & {'a', 'c'} returns {'a'} * @return the intersection of the two sets. * @exception MEMORY_ERROR Not enough memory for the result. *) const func setType: (in setType: set1) & (in setType: set2) is action "SET_INTERSECT"; (** * Symmetric difference of two sets. * {'a', 'b'} >< {'a', 'c'} returns {'b', 'c'} * @return the symmetric difference of the two sets. * @exception MEMORY_ERROR Not enough memory for the result. *) const func setType: (in setType: set1) >< (in setType: set2) is action "SET_SYMDIFF"; (** * Difference of two sets. * {'a', 'b'} - {'a', 'c'} returns {'b'} * @return the difference of the two sets. * @exception MEMORY_ERROR Not enough memory for the result. *) const func setType: (in setType: set1) - (in setType: set2) is action "SET_DIFF"; (** * Assign the union of ''dest'' and ''set2'' to ''dest''. * @exception MEMORY_ERROR Not enough memory to create ''dest''. *) const proc: (inout setType: dest) |:= (in setType: set2) is action "SET_UNION_ASSIGN"; (** * Assign the intersection of ''dest'' and ''set2'' to ''dest''. * @exception MEMORY_ERROR Not enough memory to create ''dest''. *) const proc: (inout setType: dest) &:= (in setType: set2) is action "SET_INTERSECT_ASSIGN"; (** * Assign the difference of ''dest'' and ''set2'' to ''dest''. * @exception MEMORY_ERROR Not enough memory to create ''dest''. *) const proc: (inout setType: dest) -:= (in setType: set2) is action "SET_DIFF_ASSIGN"; (** * Check if two sets are equal. * @return TRUE if the two sets are equal, * FALSE otherwise. *) const func boolean: (in setType: set1) = (in setType: set2) is action "SET_EQ"; (** * Check if two sets are not equal. * @return FALSE if the two sets are equal, * TRUE otherwise. *) const func boolean: (in setType: set1) <> (in setType: set2) is action "SET_NE"; (** * Determine if ''set1'' is a proper subset of ''set2''. * ''set1'' is a proper subset of ''set2'' if * set1 <= set2 and set1 <> set2 * holds. * @return TRUE if ''set1'' is a proper subset of ''set2'', * FALSE otherwise. *) const func boolean: (in setType: set1) < (in setType: set2) is action "SET_LT"; (** * Determine if ''set1'' is a proper superset of ''set2''. * ''set1'' is a proper superset of ''set2'' if * set1 >= set2 and set1 <> set2 * holds. * @return TRUE if ''set1'' is a proper superset of ''set2'', * FALSE otherwise. *) const func boolean: (in setType: set1) > (in setType: set2) is action "SET_GT"; (** * Determine if ''set1'' is a subset of ''set2''. * ''set1'' is a subset of ''set2'' if no element X exists for which * X in set1 and X not in set2 * holds. * @return TRUE if ''set1'' is a subset of ''set2'', * FALSE otherwise. *) const func boolean: (in setType: set1) <= (in setType: set2) is action "SET_LE"; (** * Determine if ''set1'' is a superset of ''set2''. * ''set1'' is a superset of ''set2'' if no element X exists for which * X in set2 and X not in set1 * holds. * @return TRUE if ''set1'' is a superset of ''set2'', * FALSE otherwise. *) const func boolean: (in setType: set1) >= (in setType: set2) is action "SET_GE"; (** * Compares two sets to make them useable as key in a hash table. * The sets are compared by determining the biggest element that is * not present or absent in both sets. The set in which this element * is not present is the smaller one. Note that the set comparison * is not related to the concepts of subset or superset. With the * comparison function ''compare'' it is possible to sort an array of * sets or to use sets as key in a hash table. * @return -1, 0 or 1 if the first argument is considered to be * respectively less than, equal to, or greater than the * second. *) const func integer: compare (in setType: set1, in setType: set2) is action "SET_CMP"; (** * Compute the hash value of a bitset. * @return the hash value. *) const func integer: hashCode (in setType: aSet) is action "SET_HASHCODE"; (** * Set membership test. * Determine if ''aValue'' is a member of the set ''aSet''. * 'a' in {'a', 'c', 'd'} returns TRUE * 'b' in {'a', 'c', 'd'} returns FALSE * @return TRUE If ''aValue'' is a member of ''aSet'', * FALSE otherwise. *) const func boolean: (in baseType: aValue) in (in setType: aSet) is return ord(aValue) in bitset(aSet); (** * Negated set membership test. * Determine if ''aValue'' is not a member of the set ''aSet''. * 'a' not in {'a', 'c', 'd'} returns FALSE * 'b' not in {'a', 'c', 'd'} returns TRUE * @return FALSE If ''aValue'' is a member of ''aSet'', * TRUE otherwise. *) const func boolean: (in baseType: aValue) not in (in setType: aSet) is return ord(aValue) not in bitset(aSet); (** * Add ''aValue'' to the set ''aSet''. * If ''aValue'' is already in ''aSet'' then ''aSet'' stays unchanged. * @exception MEMORY_ERROR If there is not enough memory. *) const proc: incl (inout setType: aSet, in baseType: aValue) is func begin incl(bitset varConv aSet, ord(aValue)); end func; (** * Remove ''aValue'' from the set ''aSet''. * If ''aValue'' is not element of ''aSet'' then ''aSet'' stays unchanged. *) const proc: excl (inout setType: aSet, in baseType: aValue) is func begin excl(bitset varConv aSet, ord(aValue)); end func; (** * Add or remove ''aValue'' to respectively from ''sSet''. * Adding an existing value or remove a non-existing value * leaves ''aSet'' unchanged. * @exception MEMORY_ERROR If there is not enough memory. *) const proc: (inout setType: aSet) @:= [ (in baseType: aValue) ] (in boolean: isElement) is func begin if isElement then incl(bitset varConv aSet, ord(aValue)); else excl(bitset varConv aSet, ord(aValue)); end if; end func; (** * Compute the cardinality of a set. * card({'a', 'b', 'c'}) returns 3 * @return the number of elements in ''aSet''. * @exception RANGE_ERROR Result does not fit into an integer. *) const func integer: card (in setType: aSet) is action "SET_CARD"; (** * Compute pseudo-random element from ''aSet''. * The random values are uniform distributed. * @return a random element such that rand(aSet) in aSet holds. * @exception RANGE_ERROR If ''aSet'' is empty. *) const func baseType: rand (in setType: aSet) is return baseType conv rand(bitset(aSet)); (** * Minimum element of a set. * Delivers the element from ''aSet'' for which the following condition holds: * element <= X * for all X which are in the set. * min({'a', 'b', 'c'}) returns 'a' * @return the minimum element of ''aSet''. * @exception RANGE_ERROR If ''aSet'' is the empty set. *) const func baseType: min (in setType: aSet) is return baseType conv min(bitset(aSet)); (** * Maximum element of a set. * Delivers the element from ''aSet'' for which the following condition holds: * element >= X * for all X which are in the set. * max({'a', 'b', 'c'}) returns 'c' * @return the maximum element of ''aSet''. * @exception RANGE_ERROR If ''aSet'' is the empty set. *) const func baseType: max (in setType: aSet) is return baseType conv max(bitset(aSet)); (** * Minimum element of ''aSet'' that is larger than ''number''. * next({'a', 'b', 'd', 'f', 'j'}, 'a') returns 'b' * next({'a', 'b', 'd', 'f', 'j'}, 'b') returns 'd' * next({'a', 'b', 'd', 'f', 'j'}, 'f') returns 'j' * next({'a', 'b', 'd', 'f', 'j'}, 'j') raises RANGE_ERROR * @return the minimum element of ''aSet'' that is larger than ''number''. * @exception RANGE_ERROR If ''aSet'' has no element larger than ''number''. *) const func baseType: next (in setType: aSet, in baseType: number) is return baseType conv next(bitset(aSet), ord(number)); const func setType: { (in baseType: value) } is return setType conv ( { ord(value) } ); tupleType := tuple baseType; array_type := array baseType; const func setType: { (in tupleType: value) } is func result var setType: aSet is setType.EMPTY_SET; local var integer: number is 0; begin for number range 1 to length([] value) do incl(aSet, ([] value)[number]); end for; end func; const func setType: { (in baseType: lowValue) .. (in baseType: highValue) } is return setType conv ( { ord(lowValue) .. ord(highValue) } ); (** * For-loop where ''variable'' loops over the elements of the set ''aSet''. *) const proc: for (inout baseType: variable) range (in setType: aSet) do (in proc: statements) end for is func local var baseType: upperBound is baseType.value; var boolean: leave is FALSE; begin if aSet <> setType.EMPTY_SET then variable := min(aSet); upperBound := max(aSet); repeat statements; if variable = upperBound then leave := TRUE; else variable := next(aSet, variable); end if; until leave; end if; end func; const proc: for (inout baseType: forVar) range (in setType: aSet) until (ref func boolean: condition) do (in proc: statements) end for is func local var baseType: upperBound is baseType.value; var boolean: leave is FALSE; begin if aSet <> setType.EMPTY_SET then forVar := min(aSet); upperBound := max(aSet); leave := condition; while not leave do statements; if forVar = upperBound then leave := TRUE; else forVar := next(aSet, forVar); leave := condition; end if; end while; end if; end func; const proc: for (inout baseType: forVar) range (in setType: aSet) until (ref boolean: condition) do (in proc: statements) end for is func begin for forVar range aSet until condition = TRUE do statements; end for; end func; (** * Obtain an array containing all the values in ''aSet''. * toArray({'a', 'b', 'c'}) returns []('a', 'b', 'c') * @return all the values from ''aSet''. *) const func array baseType: toArray (in setType: aSet) is func result var array baseType: values is 0 times baseType.value; local var baseType: aValue is baseType.value; var baseType: upperBound is baseType.value; var integer: index is 1; var boolean: leave is FALSE; begin if aSet <> setType.EMPTY_SET then values := card(aSet) times baseType.value; aValue := min(aSet); upperBound := max(aSet); repeat values[index] := aValue; if aValue = upperBound then leave := TRUE; else aValue := next(aSet, aValue); incr(index); end if; until leave; end if; end func; if getobj(str(ref baseType: setElement)) <> NIL then (** * Convert a set to a [[string]]. * @return the string result of the conversion. * @exception MEMORY_ERROR Not enough memory to represent the result. *) const func string: str (in setType: aSet) is func result var string: stri is "{"; local var baseType: setElement is baseType.value; begin for setElement range aSet do if stri <> "{" then stri &:= ", "; end if; stri &:= str(setElement); end for; stri &:= "}"; end func; end if; end global; end if; end func;