DataMuseum.dk

top - download

    Length: 6885 (0x1ae5)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with String_Utilities;
with Object;
with Error_Broadcaster;
with Bounded_String;
with String_Class;
package body String_Class is
    type Unary_Message is (Talongueur, Entexte);
    type Binary_Message is (Plus, Equal, Less, Greater, Different);

    procedure Init (Iter : out Iterator; Coll : in Collection) is
    begin
        Iter := Iterator'First;
    end Init;

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

    function Done (Iter : in Iterator) return Boolean is
    begin
        return (Iterator'Last = Iter);
    end Done;

    function Value (Iter : in Iterator) return Index is
    begin
        return Iter;
    end Value;  
    function Create (Value : Object.Message) return Object.Reference is
    begin
        Next (String_Collection.Iter);
        Bounded_String.Copy
           (String_Collection.Table (String_Collection.Iter), Value);

        return (Object.Tiny_String, String_Collection.Iter);  
    end Create;
    function Translate_To_Binary_Message
                (The_Message : Object.Message) return Binary_Message is

    begin

        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "=", True) then
            return (Equal);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "<", True) then
            return (Less);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), ">", True) then
            return (Greater);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "<>", True) then
            return (Different);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "+", True) then
            return (Plus);
        end if;

        if True then
            raise Error_Broadcaster.Unknown_Binary_Message;
        end if;
    end Translate_To_Binary_Message;
    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return String is
        Message : Unary_Message;
        Respons : Object.Message;
    begin
        Message := Unary_Message'Value (Bounded_String.Image (The_Message));
        case Message is
            when Entexte =>
                Bounded_String.Free (Respons);
                Bounded_String.Insert (Respons, 1, '"', 2);  
                Bounded_String.Insert (Respons, 2, String_Collection.Table
                                                      (To_Object.Identity));
                return Bounded_String.Image (Respons);
            when Talongueur =>
                return "";
        end case;
    end Send;
    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return Object.Reference is
        Message : Unary_Message;
        Obj : Object.Reference;
    begin
        Message := Unary_Message'Value (Bounded_String.Image (The_Message));
        case Message is
            when Talongueur =>
                Obj.Identity := Bounded_String.Length (String_Collection.Table
                                                          (To_Object.Identity));
                Obj.Class := Object.Tiny_Integer;
            when Entexte =>
                Obj.Identity := To_Object.Identity;
                Obj := To_Object;

        end case;  
        return (Obj);
    exception
        when Constraint_Error =>
            raise Error_Broadcaster.Unknown_Unary_Message;
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Object.Message;
                   The_Argument : Object.Reference) return Object.Reference is
        Message : Binary_Message;
        Obj : Object.Reference;

    begin
        if Object.Class_Id'Pos (The_Argument.Class) =
           Object.Class_Id'Pos (Object.Tiny_String) then
            Message := Translate_To_Binary_Message (The_Message);
            case Message is
                when Plus =>
                    Obj := To_Object;
                    Bounded_String.Append
                       (String_Collection.Table (To_Object.Identity),
                        String_Collection.Table (The_Argument.Identity));
                when Equal =>
                    Obj.Class := Object.Tiny_Boolean;
                    if String_Utilities.Equal
                          (Bounded_String.Image
                              (String_Collection.Table (To_Object.Identity)),
                           Bounded_String.Image
                              (String_Collection.Table
                                  (The_Argument.Identity))) then
                        Obj.Identity := 1;
                    else
                        Obj.Identity := 0;
                    end if;
                when Less =>
                    Obj.Class := Object.Tiny_Boolean;
                    if String_Utilities.Less_Than
                          (Bounded_String.Image
                              (String_Collection.Table (To_Object.Identity)),
                           Bounded_String.Image
                              (String_Collection.Table
                                  (The_Argument.Identity))) then
                        Obj.Identity := 1;
                    else
                        Obj.Identity := 0;
                    end if;
                when Greater =>
                    Obj.Class := Object.Tiny_Boolean;
                    if String_Utilities.Greater_Than
                          (Bounded_String.Image
                              (String_Collection.Table (To_Object.Identity)),
                           Bounded_String.Image
                              (String_Collection.Table
                                  (The_Argument.Identity))) then
                        Obj.Identity := 1;
                    else
                        Obj.Identity := 0;
                    end if;
                when Different =>
                    Obj.Class := Object.Tiny_Boolean;
                    if String_Utilities.Equal
                          (Bounded_String.Image
                              (String_Collection.Table (To_Object.Identity)),
                           Bounded_String.Image
                              (String_Collection.Table
                                  (The_Argument.Identity))) then
                        Obj.Identity := 0;
                    else
                        Obj.Identity := 1;
                    end if;
            end case;
        else


            raise Error_Broadcaster.String_Bad_Type;
        end if;
        return Obj;
    exception
        when Error_Broadcaster.Unknown_Binary_Message =>
            raise Error_Broadcaster.String_Bad_Type;  
        when Constraint_Error =>
            raise Error_Broadcaster.Tiny_String_Overflow;
    end Send;
end String_Class;