-- Generic set handling package.

    GENERIC

        TYPE elem IS ( <> ) ; -- discrete generic type

    PACKAGE set_handler IS

-- Package Types :

    TYPE set IS PRIVATE ; -- private type

    TYPE elem_list IS ARRAY ( NATURAL RANGE <> ) OF elem ;

-- Package Constants :

    empty_set : CONSTANT set ; -- deferred constants
    full_set  : CONSTANT set ;

-- Package Functions :

-- tests on contents
    FUNCTION set_is_empty ( s : set ) RETURN BOOLEAN ;
    FUNCTION set_is_full  ( s : set ) RETURN BOOLEAN ;

-- union
    FUNCTION "+" ( s1 : set ;       s2 : set       ) RETURN set ;
    FUNCTION "+" ( s  : set ;       el : elem_list ) RETURN set ;
    FUNCTION "+" ( el : elem_list ; s  : set       ) RETURN set ;
    FUNCTION "+" ( s  : set ;       e  : elem      ) RETURN set ;
    FUNCTION "+" ( e  : elem ;      s  : set       ) RETURN set ;

-- relative complement
    FUNCTION "-" ( s1 : set ; s2 : set       ) RETURN set ;
    FUNCTION "-" ( s  : set ; el : elem_list ) RETURN set ;
    FUNCTION "-" ( s  : set ; e  : elem      ) RETURN set ;

-- intersection
    FUNCTION "*" ( s1 : set ; s2 : set ) RETURN set ;

-- inclusion
    FUNCTION "<=" ( s1 : set ;       s2 : set ) RETURN BOOLEAN ;
    FUNCTION "<=" ( el : elem_list ; s  : set ) RETURN BOOLEAN ;
    FUNCTION "<=" ( e  : elem ;      s  : set ) RETURN BOOLEAN ;

    FUNCTION ">=" ( s1 : set ; s2 : set       ) RETURN BOOLEAN ;
    FUNCTION ">=" ( s  : set ; el : elem_list ) RETURN BOOLEAN ;
    FUNCTION ">=" ( s  : set ; e  : elem      ) RETURN BOOLEAN ;

-- set creation
    FUNCTION new_set ( el : elem_list ) RETURN set ;
    FUNCTION new_set ( e  : elem      ) RETURN set ;

    PRIVATE -- hidden part

-- Definitions of Private Types & Deferred Constants :

    TYPE set IS ARRAY ( elem ) OF BOOLEAN ;

    empty_set : CONSTANT set := ( OTHERS => FALSE ) ;
    full_set  : CONSTANT set := ( OTHERS => TRUE  ) ;

    END set_handler ; --------------------------------------------------

    PACKAGE BODY set_handler IS

-- set_is_empty => Set contains no elements ?
    FUNCTION set_is_empty ( s : set ) RETURN BOOLEAN IS

    BEGIN -- set_is_empty

    RETURN s = empty_set ;

    END set_is_empty ; -------------------------------------------------

-- set_is_full => Set contains all possible elements ?
    FUNCTION set_is_full ( s : set ) RETURN BOOLEAN IS

    BEGIN -- set_is_full

    RETURN s = full_set ;

    END set_is_full ; --------------------------------------------------

-- "+" => Union of sets s1 and s2.
    FUNCTION "+" ( s1 : set ; s2 : set ) RETURN set IS

    BEGIN -- "+"

    RETURN s1 OR s2 ;

    END "+" ; ----------------------------------------------------------

-- "+" => Union of a set and a list of elements.
    FUNCTION "+" ( s : set ; el : elem_list ) RETURN set IS

-- Local Variables :

    union : set ; -- local storage for result

    BEGIN -- "+"

    union := s ;                        -- copy givenm set
    FOR index IN el'RANGE LOOP          -- insert elements on given list
       union ( el ( index ) ) := TRUE ;
    END LOOP ;
    RETURN union ;                      -- return result

    END "+" ; ----------------------------------------------------------

-- "+" => Union of a list of elements and a set.
    FUNCTION "+" ( el : elem_list ; s : set ) RETURN set IS

-- Local Variables :

    union : set ; -- local storage for result

    BEGIN -- "+"

    union := s ;                        -- copy given set
    FOR index IN el'RANGE LOOP          -- insert elements on given list
       union ( el ( index ) ) := TRUE ;
    END LOOP ;
    RETURN union ;                      -- return result

    END "+" ; ----------------------------------------------------------

-- "+" => Add an element to a set ( set given first ).
    FUNCTION "+" ( s : set ; e : elem ) RETURN set IS

-- Local Variables :

    union : set ; -- local storage for result

    BEGIN -- "+"

    union := s ;          -- copy given set
    union ( e ) := TRUE ; -- add given element
    RETURN union ;        -- return result

    END "+" ; ----------------------------------------------------------

-- "+" => Add an element to a set ( set given last ).
    FUNCTION "+" ( e : elem ; s : set ) RETURN set IS

-- Local Variables :

    union : set ; -- local storage for result

    BEGIN -- "+"

    union := s ;          -- copy given set
    union ( e ) := TRUE ; -- add given element
    RETURN union ;        -- return result

    END "+" ; ----------------------------------------------------------

-- "-" => Relative complement of sets s1 and s2.
    FUNCTION "-" ( s1 : set ; s2 : set ) RETURN set IS

    BEGIN -- "-"

    RETURN s1 AND ( NOT s2 ) ;

    END "-" ; ----------------------------------------------------------

-- "-" => Remove a list of elements from a set.
    FUNCTION "-" ( s : set ; el : elem_list ) RETURN set IS

-- Local Variables :

    result : set ; -- local storage for result

    BEGIN -- "-"

    result := s ;                         -- copy given set
    FOR index IN el'RANGE LOOP            -- remove all elements on list
       result ( el ( index ) ) := FALSE ;
    END LOOP ;
    RETURN result ;                       -- return result

    END "-" ; ----------------------------------------------------------

-- "-" => Remove an element from a set.
    FUNCTION "-" ( s : set ; e : elem ) RETURN set IS

-- Local Variables :

    result : set ; -- local storage for result

    BEGIN -- "-"

    result := s ;           -- copy given set
    result ( e ) := FALSE ; -- remove given element
    RETURN result ;         -- return result

    END "-" ; ----------------------------------------------------------

-- "*" => Intersection of sets s1 and s2.
    FUNCTION "*" ( s1 : set ; s2 : set ) RETURN set IS

    BEGIN -- "*"

    RETURN s1 AND s2 ;

    END "*" ; ----------------------------------------------------------

-- "<=" => Is s1 included in s2 ?
    FUNCTION "<=" ( s1 : set ; s2 : set ) RETURN BOOLEAN IS

-- Local Variables :

    intersection : set ; -- intersection of given sets

    BEGIN -- "<="

-- get intersection of sets s1 & s2
    intersection := s1 * s2 ;

-- s1 will be included by s2 if the intersection is the same as s1
    RETURN intersection = s1 ;

    END "<=" ; ---------------------------------------------------------

-- "<=" => Are all elements on list included in given set ?
    FUNCTION "<=" ( el : elem_list ; s : set ) RETURN BOOLEAN IS

-- Local Variables :

    included : BOOLEAN := TRUE ; -- local storage for result

    BEGIN -- "<="

    FOR index IN el'RANGE LOOP          -- check whole list
       included := s ( el ( index ) ) ; -- is this element included ?
       EXIT WHEN NOT included ;         -- if not, dont check further
    END LOOP ;
    RETURN included ;                   -- return result

    END "<=" ; ---------------------------------------------------------

-- "<=" => Is given element included in given set ?
    FUNCTION "<=" ( e : elem ; s : set ) RETURN BOOLEAN IS

    BEGIN -- "<="

    RETURN s ( e ) ; -- will return TRUE if e is in s

    END "<=" ; ---------------------------------------------------------

-- ">=" => Does s1 include s2 ?
    FUNCTION ">=" ( s1 : set ; s2 : set ) RETURN BOOLEAN IS

-- Local Variables :

    intersection : set ; -- intersection of given sets

    BEGIN -- ">="

-- get intersection of sets s1 & s2
    intersection := s1 * s2 ;

-- s1 includes s2 if the intersection is the same as s2
    RETURN intersection = s2 ;

    END ">=" ; ---------------------------------------------------------

-- ">=" => Does given set include all elements on given list ?
    FUNCTION ">=" ( s : set ; el : elem_list ) RETURN BOOLEAN IS

-- Local Variables :

    included : BOOLEAN := TRUE ; -- local storage for result

    BEGIN -- ">="

    FOR index IN el'RANGE LOOP          -- check whole list
       included := s ( el ( index ) ) ; -- is this element included ?
       EXIT WHEN NOT included ;         -- if not, dont check further
    END LOOP ;
    RETURN included ;                   -- return result

    END ">=" ; ---------------------------------------------------------

-- ">=" => Does given set include given element ?
    FUNCTION ">=" ( s : set ; e : elem ) RETURN BOOLEAN IS

    BEGIN -- ">="

    RETURN s ( e ) ; -- will be TRUE if e is included in s

    END ">=" ; ---------------------------------------------------------

-- new_set => Create a new set of given elements.
    FUNCTION new_set ( el : elem_list ) RETURN set IS

-- Local Variables :

    s : set := empty_set ; -- local storage for result

    BEGIN -- new_set

-- loop through given element list including each element in the set
    FOR index IN el'RANGE LOOP
        s ( el ( index ) ) := TRUE ;
    END LOOP ;

-- return result
    RETURN s ;

    END new_set ; ------------------------------------------------------

-- new_set => Create a new set containing a single given element.
    FUNCTION new_set ( e : elem ) RETURN set IS

-- Local Variables :

    s : set := empty_set ; -- local storage for result

    BEGIN -- new_set

-- just include given element in set & return it
    s ( e ) := TRUE ;
    RETURN s ;

    END new_set ; ------------------------------------------------------

    END set_handler ; --------------------------------------------------