(********************************************************************)
(*                                                                  *)
(*  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;