DataMuseum.dk

top - download

    Length: 5340 (0x14dc)
    Types: TextFile
    Names: »B«

└─⟦5829e5ed5⟧ Bits:30000534 8mm tape, Rational 1000, RCI 2_0_5
    └─ ⟦c9a165082⟧ »DATA« 
        └─⟦2162db02b⟧ 
            └─⟦this⟧ 

TextFile

with String_Utilities;
with Unchecked_Conversion;

package body String_Table is


    function Item_To_Integer is new Unchecked_Conversion (Item, Integer);

    package Util renames String_Utilities;

    type Sym_Rec is
        record
            Value : Item;
            Next : Sym_Pointer;
        end record;

    type Table_Storage is array (Element_Index range <>) of Sym_Pointer;

    function Nil return Item is
    begin
        return null;
    end Nil;

    function Hash_Code (S : String; Hash_Size : Positive)
                       return Element_Index is
    begin
        return Element_Index (abs (Util.Hash_String (S) mod Hash_Size));
    end Hash_Code;
    pragma Inline (Hash_Code);

    function New_Table (Minimum_Table_Size : Natural := 127) return Table is
    begin
        return new Table_Storage (0 .. Minimum_Table_Size);
    end New_Table;

    function Unique (Source : String;
                     In_Table : Table;
                     Ignore_Case : Boolean := True) return Item is
        Bucket : Sym_Pointer renames In_Table
                                        (Hash_Code (Source, In_Table'Length));
        Chain : Sym_Pointer := Bucket;
    begin
        if Source'Length = 0 then
            return null;
        end if;
        if Ignore_Case then
            declare
                S : constant String := Util.Upper_Case (Source);
            begin
                while Chain /= null loop
                    if Util.Upper_Case (Chain.Value.all) = S then
                        return Chain.Value;
                    end if;
                    Chain := Chain.Next;
                end loop;
            end;
        else
            while Chain /= null loop
                if Chain.Value.all = Source then
                    return Chain.Value;
                end if;
                Chain := Chain.Next;
            end loop;
        end if;

        Chain := new Sym_Rec;
        Chain.Value := new String'(Source);
        Chain.Next := Bucket;
        Bucket := Chain;
        return Chain.Value;
    end Unique;

    function Find (Source : String;
                   In_Table : Table;
                   Ignore_Case : Boolean := True) return Item is
        Chain : Sym_Pointer := In_Table (Hash_Code (Source, In_Table'Length));
    begin
        if Source'Length = 0 then
            return null;
        end if;
        if Ignore_Case then
            declare
                S : constant String := Util.Upper_Case (Source);
            begin
                while Chain /= null loop
                    if Util.Upper_Case (Chain.Value.all) = S then
                        return Chain.Value;
                    end if;
                    Chain := Chain.Next;
                end loop;
            end;
        else
            while Chain /= null loop
                if Chain.Value.all = Source then
                    return Chain.Value;
                end if;
                Chain := Chain.Next;
            end loop;
        end if;
        return null;
    end Find;

    function Allocate (Source : String; In_Table : Table) return Item is
    begin
        if Source'Length > 0 then
            return new String'(Source);
        else
            return Nil;
        end if;
    end Allocate;


    function Equal (L, R : Item) return Boolean is
    begin
        return L = R or else
                  ((L /= Nil and then R /= Nil) and then L.all = R.all);
    end Equal;

    function Unique_Index (U : Item) return Integer is
    begin
        return Item_To_Integer (U);
    end Unique_Index;

    function Char_At (Source : Item; At_Pos : Natural) return Character is
    begin
        return Source (At_Pos - 1 + Source'First);
    end Char_At;


    function Image (Source : Item) return String is
    begin
        if Source = Nil then
            return "";
        else
            return Source.all;
        end if;
    end Image;

    function Length (Source : Item) return Natural is
    begin
        if Source = Nil then
            return 0;
        else
            return Source.all'Length;
        end if;
    end Length;

    function Is_Nil (Source : Item) return Boolean is
    begin
        return Source = Nil;
    end Is_Nil;

    procedure Incr (Iter : in out Iterator) is
    begin
        loop
            Iter.Member := Long_Sym_Pointer (Iter.The_Table (Iter.Bucket));
            exit when Iter.Member /= null or else
                         Iter.Bucket = Iter.The_Table'Last;
            Iter.Bucket := Iter.Bucket + 1;
        end loop;
    end Incr;

    procedure Init (Iter : out Iterator; The_Table : Table) is
        The_Iter : Iterator;
    begin
        The_Iter.The_Table := The_Table;
        The_Iter.Bucket := 0;
        Incr (The_Iter);
        Iter := The_Iter;
    end Init;

    procedure Next (Iter : in out Iterator) is
    begin
        Iter.Member := Long_Sym_Pointer (Iter.Member.Next);
        if Iter.Member = null and then Iter.Bucket /= Iter.The_Table'Last then
            Iter.Bucket := Iter.Bucket + 1;
            Incr (Iter);
        end if;
    end Next;

    function Value (Iter : Iterator) return Item is
    begin
        return Iter.Member.Value;
    end Value;

    function Done (Iter : Iterator) return Boolean is
    begin
        return Iter.Member = null;
    end Done;

end String_Table;