DataMuseum.dk

top - download

    Length: 7552 (0x1d80)
    Types: TextFile
    Names: »B«

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

TextFile

with Boolean_Class;
with Bounded_String;
with Errors;
with Integer_Class;
with String_Utilities;

package body String_Class is

    Iterator : Natural := 0;
    type Unary_Message is (Nul, En_Texte, Chaine_Vide, Longueur);
    type Binary_Message is (Nul, Plus, Plus_Ada, Egal, Sup, Inf, Different);

    function Convert_To_Unary
                (The_Message : Scanner.Lexeme) return Unary_Message is
    begin
        if Bounded_String.Image (The_Message) = "EN_TEXTE" then
            return En_Texte;
        elsif Bounded_String.Image (The_Message) = "CHAINE_VIDE" then
            return Chaine_Vide;
        elsif Bounded_String.Image (The_Message) = "LONGUEUR" then
            return Longueur;
        else
            return Nul;
        end if;
    end Convert_To_Unary;

    function Convert_To_Binary
                (The_Message : Scanner.Lexeme) return Binary_Message is
    begin
        if Bounded_String.Image (The_Message) = "=" then
            return Egal;
        elsif Bounded_String.Image (The_Message) = "+" then
            return Plus;
        elsif Bounded_String.Image (The_Message) = "&" then
            return Plus_Ada;
        elsif Bounded_String.Image (The_Message) = ">" then
            return Sup;
        elsif Bounded_String.Image (The_Message) = "<" then
            return Inf;
        elsif Bounded_String.Image (The_Message) = "<>" then
            return Different;
        else
            return Nul;
        end if;
    end Convert_To_Binary;

    function Create (Value : String) return Object.Reference is  
    begin
        Iterator := Iterator + 1;
        if Iterator <= Custom.String_Max_Number then
            String_Tab (Iterator) := Bounded_String.Value
                                        (Value, Custom.String_Max_Length);
            return Object.Create (Object.Chaine, Iterator);
        else
            raise Errors.Max_String_Number_Exceeded;
        end if;
    end Create;

    function Create (Value : Scanner.Lexeme) return Object.Reference is  
    begin
        Iterator := Iterator + 1;
        if Iterator <= Custom.String_Max_Number then
            String_Tab (Iterator) := Value;
            return Object.Create (Object.Chaine, Iterator);
        else
            raise Errors.Max_String_Number_Exceeded;
        end if;
    end Create;

    function Get_Value (String_Object : Object.Reference)
                       return Scanner.Lexeme is
    begin
        return String_Tab (Object.Get_Id (String_Object));
    end Get_Value;

    function Send (To_Object : Object.Reference; The_Message : Scanner.Lexeme)
                  return Object.Reference is
        Current_Message : Unary_Message := Nul;
    begin
        Current_Message := Convert_To_Unary (The_Message);
        case Current_Message is
            when Nul =>
                raise Errors.Unknown_Message_For_String;
            when En_Texte =>
                return To_Object;
            when Chaine_Vide =>
                return (Boolean_Class.Create
                           (Bounded_String.Length
                               (String_Tab (Object.Get_Id (To_Object))) = 0));
            when Longueur =>
                return Integer_Class.Create
                          (Bounded_String.Length
                              (String_Tab (Object.Get_Id (To_Object))));
        end case;
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Scanner.Lexeme;
                   With_Object : Object.Reference) return Object.Reference is
        Current_Message : Binary_Message := Nul;
        Current_String : Scanner.Lexeme;
        L1, L2 : Natural;  
    begin
        Current_Message := Convert_To_Binary (The_Message);
        case Object.Get_Class (With_Object) is
            when Object.Chaine =>
                case Current_Message is
                    when Nul =>
                        raise Errors.Unknown_Message_For_String;
                    when Plus | Plus_Ada =>  
                        L1 := Bounded_String.Length
                                 (String_Tab (Object.Get_Id (To_Object)));
                        L2 := Bounded_String.Length
                                 (String_Tab (Object.Get_Id (With_Object)));
                        if (L1 + L2) <= Custom.String_Max_Length then
                            Bounded_String.Copy
                               (Current_String, String_Tab
                                                   (Object.Get_Id (To_Object)));
                            Bounded_String.Append
                               (Current_String,
                                String_Tab (Object.Get_Id (With_Object)));
                            return Create (Current_String);
                        else
                            raise Errors.Target_String_Is_Too_Long;
                        end if;
                    when Egal =>  
                        return Boolean_Class.Create
                                  (String_Utilities.Equal
                                      (Bounded_String.Image
                                          (String_Tab (Object.Get_Id
                                                          (To_Object))),
                                       Bounded_String.Image
                                          (String_Tab (Object.Get_Id
                                                          (With_Object)))));
                    when Sup =>
                        return Boolean_Class.Create
                                  (String_Utilities.Greater_Than
                                      (Bounded_String.Image
                                          (String_Tab (Object.Get_Id
                                                          (To_Object))),
                                       Bounded_String.Image
                                          (String_Tab (Object.Get_Id
                                                          (With_Object)))));
                    when Inf =>
                        return Boolean_Class.Create
                                  (String_Utilities.Less_Than
                                      (Bounded_String.Image
                                          (String_Tab (Object.Get_Id
                                                          (To_Object))),
                                       Bounded_String.Image
                                          (String_Tab (Object.Get_Id
                                                          (With_Object)))));
                    when Different =>
                        return Boolean_Class.Create
                                  (not String_Utilities.Equal
                                          (Bounded_String.Image
                                              (String_Tab (Object.Get_Id
                                                              (To_Object))),
                                           Bounded_String.Image
                                              (String_Tab (Object.Get_Id
                                                              (With_Object)))));
                end case;
            when others =>
                raise Errors.String_Object_Required_As_Argument;
        end case;
    end Send;

    function Get_For_Error (Value : String) return Object.Reference is
    begin
        String_Tab (1) := Bounded_String.Value
                             (Value, Custom.String_Max_Length);
        return Object.Create (Object.Chaine, 1);
    end Get_For_Error;

end String_Class;