DataMuseum.dk

top - download

    Length: 6618 (0x19da)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Date;
with Unbounded_Array;

with Text_Io;

package body Class is

    Unknown_Class : constant String := "NO_NAME";

    type Object is access String;

    Null_Object : constant Object := null;


    type Instance_Array is array (Positive range <>) of Date.Reference;

    package Unbounded_Instance is
       new Unbounded_Array (Element => Date.Reference,
                            Content => Instance_Array);


    type Element is
        record  
            Name      : Object  := Null_Object;
            Is_Dated  : Boolean := False;
            Instances : Unbounded_Instance.Object;
        end record;


    subtype Array_Reference is Reference range 1 .. Max_Size;
    type    Classes         is array (Array_Reference) of Element;


    The_Classes    : Classes;
    Last_Reference : Reference := 0;


------------------------------------------------------------------------------
    function Create (With_Name : String; Is_Dated : Boolean := False)
                    return Class.Reference is
        The_Reference : Class.Reference := Class.Nothing;
    begin
        The_Reference := Value (With_Name);
        if The_Reference = Class.Nothing then
            Class.Last_Reference                  := Class.Last_Reference + 1;
            The_Classes (Last_Reference).Name     := new String'(With_Name);
            The_Classes (Last_Reference).Is_Dated := Is_Dated;
            The_Reference                         := Last_Reference;
        else
            Init_Dates (The_Reference);
            The_Classes (The_Reference).Is_Dated := Is_Dated;
        end if;
        return The_Reference;
    exception
        when Constraint_Error =>
            raise Class.Overflow;
    end Create;


------------------------------------------------------------------------------
    procedure Init_Dates (The_Class : Class.Reference) is
    begin  
        if The_Class > Class.Nothing and then
           The_Class <= Class.Max_Size and then The_Class <= Last_Reference then
            if The_Classes (The_Class).Is_Dated then
                Unbounded_Instance.Free (The_Classes (The_Class).Instances);
                -- else
                --     raise Not_Dated;
            end if;
        else
            raise Illegal_Access;
        end if;
    end Init_Dates;


------------------------------------------------------------------------------
    function Value (Of_Name : String) return Class.Reference is
        The_Reference : Class.Reference := Class.Nothing;
    begin
        for I in 1 .. Class.Last_Reference loop
            if The_Classes (I).Name.all = Of_Name then
                The_Reference := I;
                exit;
            end if;
        end loop;
        return The_Reference;
    end Value;


------------------------------------------------------------------------------
    function Image (Of_Reference : Class.Reference) return String is
    begin
        if Of_Reference <= Class.Last_Reference and
           Of_Reference <= Max_Size and Of_Reference > Class.Nothing then
            return The_Classes (Of_Reference).Name.all;
        else
            return Unknown_Class;
            -- raise Class.Illegal_Access;   --[???]
        end if;
    exception
        when Constraint_Error =>
            raise Class.Illegal_Access;
    end Image;



------------------------------------------------------------------------------
    procedure Add (In_Class     : Class.Reference;
                   The_Instance : Natural;
                   With_Date    : Date.Reference) is
    begin  
        if In_Class /= Class.Nothing and then
           In_Class <= Class.Max_Size and then In_Class <= Last_Reference then
            if The_Classes (In_Class).Is_Dated then
                The_Classes (In_Class).Instances :=
                   Unbounded_Instance."&"
                      (The_Classes (In_Class).Instances, With_Date);
                if Unbounded_Instance.Length
                      (The_Classes (In_Class).Instances) /= The_Instance then
                    raise Illegal_Instance;
                end if;
            else
                raise Not_Dated;
            end if;
        else
            raise Illegal_Access;
        end if;
    end Add;


------------------------------------------------------------------------------
    procedure Change (In_Class     : Class.Reference;
                      The_Instance : Natural;
                      With_Date    : Date.Reference) is
    begin  
        if In_Class /= Class.Nothing and then
           In_Class <= Class.Max_Size and then In_Class <= Last_Reference then
            if The_Classes (In_Class).Is_Dated then
                if The_Instance >= 1 and
                   The_Instance <= Unbounded_Instance.Length
                                      (The_Classes (In_Class).Instances) then
                    Unbounded_Instance.Set (In_Object    =>
                                               The_Classes (In_Class).Instances,
                                            The_Item     => The_Instance,
                                            With_Element => With_Date);
                else
                    raise Illegal_Instance;
                end if;
            else
                raise Not_Dated;
            end if;
        else
            raise Illegal_Access;
        end if;
    end Change;


------------------------------------------------------------------------------
    function Get (In_Class : Class.Reference; The_Instance : Natural)
                 return Date.Reference is
    begin  
        if In_Class /= Class.Nothing and then
           In_Class <= Class.Max_Size and then In_Class <= Last_Reference then
            if The_Classes (In_Class).Is_Dated then
                if The_Instance >= 1 and
                   The_Instance <= Unbounded_Instance.Length
                                      (The_Classes (In_Class).Instances) then
                    return Unbounded_Instance.Get
                              (In_Object => The_Classes (In_Class).Instances,
                               The_Item  => The_Instance);
                else
                    raise Illegal_Instance;
                end if;
            else
                raise Not_Dated;
            end if;
        else
            raise Illegal_Access;
        end if;
    end Get;


------------------------------------------------------------------------------

begin

    Class.Last_Reference := 0;
    for I in Array_Reference loop
        The_Classes (I).Name     := Null_Object;
        The_Classes (I).Is_Dated := False;
    end loop;

end Class;