DataMuseum.dk

top - download

    Length: 5097 (0x13e9)
    Types: TextFile
    Names: »B«

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

TextFile

with Message_Interchange;
with Text_Io;

use Text_Io;
package body Signature is

    Sep : Character renames Message_Interchange.Separator;

    First : Boolean;
    -- used to build images like  blah#blah#blah
    -- instead of                #blah#blah#blah

    Prototyping_Stub : exception;

    function Create return Signature.Object is
    begin
        return Object'(others => Parameter.Null_Parameter);
    end Create;


    procedure Add (To_Signature : in out Signature.Object;
                   The_Parameter : Parameter.Object;
                   At_Position : Position) is
    begin
        To_Signature (At_Position) := The_Parameter;
    end Add;


    function I (Sig : Object; Pos : Iterator_Range) return String is
    begin  
        if Pos = Iterator_Range'Last then
            return ""; -- fin de la recursivite
        elsif Parameter.Is_Null (Sig (Position (Pos))) then
            --return I (Sig, Pos + 1);
            return ""; -- fin de la recursivite
        elsif First then  
            First := False;
            return (Parameter.Image (Sig (Position (Pos))) & I (Sig, Pos + 1));
        else
            return (Sep & Parameter.Image (Sig (Position (Pos))) &
                    I (Sig, Pos + 1));
        end if;
    end I;


    function Image (Of_Signature : Signature.Object) return String is
    begin
        First := True;
        return I (Of_Signature, Iterator_Range (Position'First));
    end Image;


    function Value (Of_String : String) return Signature.Object is
        S : String renames Of_String;

        Name : Positive := S'First;
        Next_Name : Positive := S'First;
        Class : Positive := S'First;
        Value : Positive := S'First;
        Current : Positive := S'First;

        Param_Pos : Positive := 1;

        Sig : Signature.Object := Signature.Create;
    begin
        while Current <= S'Last loop

            Locate_Name:
                loop
                    exit when S (Class) = Sep;
                    Class := Class + 1;
                    Current := Current + 1;
                end loop Locate_Name;
            Current := Current + 1; -- to point after the sep
            Value := Current;

            Locate_Class:
                loop
                    exit when S (Value) = Sep;
                    Value := Value + 1;
                    Current := Current + 1;
                end loop Locate_Class;
            Current := Current + 1; -- to point after the sep
            Next_Name := Current;

            Locate_Value:
                loop
                    exit when S (Next_Name) = Sep or Next_Name = S'Last;
                    Next_Name := Next_Name + 1;
                    Current := Current + 1;
                end loop Locate_Value;
            Current := Current + 1; -- to point after the sep

            if S (Next_Name) = Sep then
                Next_Name := Next_Name - 1;
                --[cheat]
                -- a parameter is always in the range name .. next_name
                -- this is required because there is no sep at the
                -- end of the signature
            end if;


            Signature.Add (To_Signature => Sig,
                           The_Parameter => Parameter.Value
                                               (S (Name .. Next_Name)),
                           At_Position => Param_Pos);


            Param_Pos := Param_Pos + 1;
            Name := Next_Name + 1 + 1;
            -- name is incremented twice see [cheat]

            Class := Name;
            Value := Name;
            Next_Name := Name;

        end loop;

        return Sig;

    end Value;


    procedure Init (Iter : in out Iterator;
                    Signature : Standard.Signature.Object) is
    begin
        Iter.Position := Iterator_Range (Signature'First);
        Iter.Signature := Signature;
    end Init;


    procedure Next (Iter : in out Iterator) is
    begin
        Iter.Position := Iter.Position + 1;
    end Next;


    function Is_Done (Iter : Iterator) return Boolean is
    begin
        return Iter.Position = Iterator_Range'Last;
    end Is_Done;


    function Value (Iter : Iterator) return Parameter.Object is
    begin
        return Iter.Signature (Positive (Iter.Position));
    end Value;


    procedure Reset (Signature : in out Standard.Signature.Object) is
    begin
        for I in Signature'Range loop
            Signature (I) := Parameter.Null_Parameter;
        end loop;
    end Reset;


    function Is_Equal (Left, Right : Signature.Object) return Boolean is
    begin
        for I in Left'Range loop
            if not Parameter.Is_Equal (Left (I), Right (I)) then
                return False;
            end if;  
        end loop;
        return True;
    end Is_Equal;


    function Is_Compatible (Left, Right : Signature.Object) return Boolean is
    begin
        for I in Left'Range loop
            if not Parameter.Is_Compatible (Left (I), Right (I)) then
                return False;
            end if;  
        end loop;
        return True;
    end Is_Compatible;
end Signature;