-----------------------------------------------------------------------------
-- PACKAGE BODY:
--      List_Sets
-- AUTHOR:
--      Yoav Tzruya
-- IMPLEMENTATION NOTES:
--      The set here is implemented by a dynamic list of elements.
--      I use a controlled type to be in charge of the memory allocation for
--      the instantiations of this type.
-----------------------------------------------------------------------------
-- ** BODY IMPORTS **
with Ada.Unchecked_Deallocation;

package body List_Sets is

        type Set_Ptr is access Set;

        -- ** INTERNAL SUBPROGRAMS **

        -- discard obsolete node
        Procedure Discard is
                new Ada.Unchecked_Deallocation (
                        Object => node,
                        Name   => Access_node);

        -- check if element is in set
        function In_Set (
                        element_arg : in    Set_Element;
                        set_arg     : in    Set)
                 return boolean
        is
            next : access_node;
        begin -- In_Set
            if set_arg.head = null
            then
                return false;
            else
                next := set_arg.head;

                while next /= null
                loop
                    if next.elem = element_arg
                    then
                        return true;
                    else
                        next := next.next;
                    end if;
                end loop;

                return false;
            end if;
        end In_Set;

        -- add an element to the set
        procedure Add_to_Set (
                        set_arg     : in out Set;
                        element_arg : in     Set_Element)
        is
            new_node : access_node := new Node;
        begin -- Add_to_Set
            new_node.all := (
                next => null,
                elem => element_arg);

            if set_arg.head = null
            then
                set_arg.head := new_node;
            else
                new_node.next := set_arg.head;
                set_arg.head := new_node;
            end if;
        end Add_to_Set;

        -- ** EXPORTED SUBPROGRAMS **

        function Empty
                return Set
        is
		returned_set : set_ptr := new Set;
        begin -- Empty
            returned_set.all := (
                        Abstract_Set_Handling.Set with
                        head => null);
            return returned_set.all;
        end Empty;

        function Unit (
                        Element : in     Set_Element)
                return Set
        is
            returned_set : Set_ptr := new Set;
        begin -- Unit
            returned_set.all := Empty;
            Add_to_Set (
                element_arg => Element,
                set_arg     => returned_set.all);

            return returned_set.all;
        end Unit;
       
        function Union (
                        Left  : in    Set;
                        Right : in    Set)
                return Set
        is
            returned_set : Set_Ptr := new Set;
            node_ptr : access_node;
        begin -- Union
            returned_set.all := Empty;

            if Left.head /= null
            then
                node_ptr := Left.head;

                while node_ptr /= null
                loop
                    add_to_set (
                        set_arg     => returned_set.all,
                        element_arg => node_ptr.elem);  
                    node_ptr := node_ptr.next;
                end loop;
            end if;    

            if Right.head /= null
            then
                node_ptr := Right.head;

                while node_ptr /= null
                loop
                    if not in_set (
                                element_arg => node_ptr.elem,
                                set_arg     => returned_set.all)
                    then
                        add_to_set (
                            element_arg => node_ptr.elem,
                            set_arg     => returned_set.all);
                    end if;
                    node_ptr:=node_ptr.next;
                end loop;

            end if;

            return returned_set.all;     
        end Union;

        function Intersection (
                        Left  : in    Set;
                        Right : in    Set)
                return Set
        is
            returned_set : set_ptr := new Set;
            node_ptr     : access_node;
        begin -- Intersection
                        
            returned_set.all := Empty;

            if Left.head /= null and
               Right.head /= null
            then
                node_ptr := Left.head;

                while node_ptr /= null
                loop
                    if In_Set (
                        set_arg     => Right,
                        element_arg => node_ptr.elem)
                    then
                        Add_to_Set(
                            set_arg     => returned_set.all,
                            element_arg => node_ptr.elem);
                    end if;
                    node_ptr := node_ptr.next;
                end loop;
            end if;

            return returned_set.all;

        end Intersection;


        procedure Take (
                        From    : in out Set;
                        Element :    out Set_Element)
        is
        begin -- Take
            if From.head = null
            then
                raise set_is_empty_exception;
            else
                Element := From.head.elem;

                from.head := from.head.next;
            end if;
        end Take;

        function to_String (
                        set_arg : in    Set)
                return String
        is
        begin -- to_String
            return Abstract_Set_Handling.to_String (
                        set_arg => set_arg);
        end to_String;

        procedure Adjust     (Object : in out Set)
        is
            old_head : access_node;
        begin -- Adjust
            if Object.head = null
            then
                return;
            end if;

            old_head := Object.head;
            object.head := null;

            while old_head /= null
            loop
                add_to_set (
                    set_arg     => Object,
                    element_arg => old_head.elem);

                old_head := old_head.next;
            end loop;

        end Adjust;

        procedure Finalize   (Object : in out Set)
        is
            discarded_node,
            node_ptr         : access_node;
                
        begin -- Finalize
            node_ptr := Object.head;

            while node_ptr /= null
            loop
                discarded_node := node_ptr;
                node_ptr := node_ptr.next;
                Discard(discarded_node);
            end loop;
        end Finalize;

end List_Sets;