PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/generic_ordered_set.adb

Text File | 1997-10-20 | 2.8 KB | 106 lines

-- generic_ordered.adb
--
-- Copyright (c) 1996 Cadre Technologies Inc, All Rights Reserved
--
-- This file contains the implementation of a simple, unoptimized, generic
-- ordered set package that is provided without any express or implied
-- warranties and is intended for interim use in order to allow the
-- compilation and linking of the generated Ada code.  This package should
-- ultimately be replaced by a production quality version such as from the
-- compiler vendor's program library.

with Unchecked_Deallocation;
package body Generic_Ordered_Set is

    procedure Free is new
    Unchecked_Deallocation(Ordered_Set_Item, Ordered_Set_Item_Acc);

    -- Add element E to set S; raises Already_Exists if E already exists in S
    procedure Add(S : in out Ordered_Set; E : Element) is
    Item : Ordered_Set_Item_Acc := S.First;
    Last : Ordered_Set_Item_Acc := null;
    begin
    while Item /= null loop
        if Item.Elem = E then
        raise Already_Exists;
        end if;
        Last := Item;
        Item := Item.Next;
    end loop;
    Item := new Ordered_Set_Item;
    if Last = null then
        S.First := Item;
    else
        Last.Next := Item;
    end if;
    Item.Elem := E;
    Item.Next := null;
    S.Count := S.Count + 1;
    end Add;

    -- Remove element E from set S; raises Does_Not_Exist if S doesn't have E
    procedure Remove(S : in out Ordered_Set; E : Element) is
    Item : Ordered_Set_Item_Acc := S.First;
    Last : Ordered_Set_Item_Acc := null;
    begin
    while Item /= null loop
        if Item.Elem = E then
        if Last = null then
            S.First := Item.Next;
        else
            Last.Next := Item.Next;
        end if;
        S.Count := S.Count - 1;
        return;
        end if;
        Last := Item;
        Item := Item.Next;
    end loop;
    raise Does_Not_Exist;
    end Remove;

    -- Remove all elements from set S
    procedure Remove_All(S : in out Ordered_Set) is
    Item : Ordered_Set_Item_Acc := S.First;
    Next : Ordered_Set_Item_Acc;
    begin
    while Item /= null loop
        Next := Item.Next;
        Free(Item);
        Item := Next;
    end loop;
    S.First := null;
    S.Count := 0;
    end Remove_All;

    -- Return whether or not set S contains element E
    function Has(S : Ordered_Set; E : Element) return Boolean is
    Item : Ordered_Set_Item_Acc := S.First;
    begin
    while Item /= null loop
        if Item.Elem = E then
        return True;
        end if;
        Item := Item.Next;
    end loop;
    return False;
    end Has;

    -- Return the number of elements in S
    function Count(S : Ordered_Set) return Natural is
    begin
    return S.Count;
    end Count;

    -- Iterator
    procedure Iterate(S : Ordered_Set) is
    Item : Ordered_Set_Item_Acc := S.First;
    begin
    while Item /= null loop
        Process(Item.Elem);
        Item := Item.Next;
    end loop;
    end Iterate;

end Generic_Ordered_Set;