DataMuseum.dk

top - metrics - download

    Length: 2556 (0x9fc)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Unchecked_Deallocation;

package body Stack_Pkg is

    --| Overview:
    --| Implementation scheme is totally described by the statements of the
    --| representation invariants and abstraction function that appears in
    --| the package specification.  The implementation is so trivial that
    --| further documentation is unnecessary.

    use Elem_List_Pkg;


    -- Constructors:

    function Create return Stack is
    begin
        return new Stack_Rec'(Size => 0, Elts => Create);
    end Create;

    procedure Push (S : in out Stack; E : in Elem_Type) is
    begin
        S.Size := S.Size + 1;
        S.Elts := Attach (E, S.Elts);
    exception
        when Constraint_Error =>
            raise Uninitialized_Stack;
    end Push;

    procedure Pop (S : in out Stack) is
    begin
        Deletehead (S.Elts);
        S.Size := S.Size - 1;
    exception
        when Emptylist =>
            raise Empty_Stack;
        when Constraint_Error =>
            raise Uninitialized_Stack;
    end Pop;

    procedure Pop (S : in out Stack; E : out Elem_Type) is
    begin
        E := Firstvalue (S.Elts);
        Deletehead (S.Elts);
        S.Size := S.Size - 1;
    exception
        when Emptylist =>
            raise Empty_Stack;
        when Constraint_Error =>
            raise Uninitialized_Stack;
    end Pop;

    function Copy (S : in Stack) return Stack is
    begin
        if S = null then
            raise Uninitialized_Stack;
        end if;

        return new Stack_Rec'(Size => S.Size, Elts => Copy (S.Elts));
    end Copy;


    -- Queries:

    function Top (S : in Stack) return Elem_Type is
    begin
        return Firstvalue (S.Elts);
    exception
        when Emptylist =>
            raise Empty_Stack;
        when Constraint_Error =>
            raise Uninitialized_Stack;
    end Top;

    function Size (S : in Stack) return Natural is
    begin
        return S.Size;
    exception
        when Constraint_Error =>
            raise Uninitialized_Stack;
    end Size;

    function Is_Empty (S : in Stack) return Boolean is
    begin
        return S.Size = 0;
    exception
        when Constraint_Error =>
            raise Uninitialized_Stack;
    end Is_Empty;


    -- Heap Management:

    procedure Destroy (S : in out Stack) is
        procedure Free_Stack is new Unchecked_Deallocation (Stack_Rec, Stack);
    begin
        Destroy (S.Elts);
        Free_Stack (S);
    exception
        when Constraint_Error =>

            -- stack is null
            return;
    end Destroy;

end Stack_Pkg;