DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦9254d560e⟧ Ada Source

    Length: 18432 (0x4800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Character_Utilities, seg_042798

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



package body Character_Utilities is

    The_Case_Offset : constant := Character'Pos ('a') - Character'Pos ('A');
--
-- The constant The_Case_Offset defines the offset from the uppercase character
-- set to the lowercase character set.
--

    procedure Make_Uppercase (The_Character : in out Character) is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Make_Uppercase
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Make_Uppercase
        The_Character := Uppercase_Of (The_Character => The_Character);
    end Make_Uppercase;

    procedure Make_Lowercase (The_Character : in out Character) is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Make_Lowercase
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Make_Lowercase
        The_Character := Lowercase_Of (The_Character => The_Character);
    end Make_Lowercase;

    function Uppercase_Of (The_Character : in Character) return Character is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Uppercase_Of
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Uppercase_Of
        if Is_Lowercase (The_Character => The_Character) then
            return Character'Val
                      (Character'Pos (The_Character) - The_Case_Offset);
        else
            return The_Character;
        end if;
    end Uppercase_Of;

    function Lowercase_Of (The_Character : in Character) return Character is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Lowercase_Of
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Lowercase_Of
        if Is_Uppercase (The_Character => The_Character) then
            return Character'Val
                      (Character'Pos (The_Character) + The_Case_Offset);
        else
            return The_Character;
        end if;
    end Lowercase_Of;

    function Is_Control (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Control
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Control
        return The_Character in Control_Character;
    end Is_Control;

    function Is_Graphic (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Graphic
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Graphic
        return The_Character in Graphic_Character;
    end Is_Graphic;

    function Is_Uppercase (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Uppercase
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Uppercase
        return The_Character in Uppercase_Character;
    end Is_Uppercase;

    function Is_Lowercase (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Lowercase
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Lowercase
        return The_Character in Lowercase_Character;
    end Is_Lowercase;

    function Is_Digit (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Digit
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Digit
        return The_Character in Digit_Character;
    end Is_Digit;

    function Is_Alphabetic (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Alphabetic
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Alphabetic
        return Is_Uppercase (The_Character => The_Character) or else
                  Is_Lowercase (The_Character => The_Character);
    end Is_Alphabetic;

    function Is_Alphanumeric (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Alphanumeric
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Alphanumeric
        return Is_Alphabetic (The_Character => The_Character) or else
                  Is_Digit (The_Character => The_Character);
    end Is_Alphanumeric;

    function Is_Special (The_Character : in Character) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Special
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Special
        return Is_Graphic (The_Character => The_Character) and then
                  not Is_Alphanumeric (The_Character => The_Character);
    end Is_Special;

    function Value_Of (The_Character : in Character) return Digit is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Value_Of
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Value_Of
        if Is_Digit (The_Character => The_Character) then
            return Character'Pos (The_Character) - Character'Pos ('0');
        else
            raise Lexical_Error;
        end if;
    end Value_Of;

    function Image_Of (The_Digit : in Digit) return Character is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Image_Of
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Image_Of
        return Character'Val (Character'Pos ('0') + The_Digit);
    end Image_Of;

    function Index_Of (The_Character : in Character) return Letter is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Index_Of
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Index_Of
        if Is_Uppercase (The_Character => The_Character) then
            return Character'Pos (The_Character) - Character'Pos ('A') + 1;
        elsif Is_Lowercase (The_Character => The_Character) then
            return Character'Pos (The_Character) - Character'Pos ('a') + 1;
        else
            raise Lexical_Error;
        end if;
    end Index_Of;

    function Uppercase_Of (The_Letter : in Letter) return Character is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Uppercase_Of
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Uppercase_Of
        return Character'Val (Character'Pos ('A') + The_Letter - 1);
    end Uppercase_Of;

    function Lowercase_Of (The_Letter : in Letter) return Character is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Lowercase_Of
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Lowercase_Of
        return Character'Val (Character'Pos ('a') + The_Letter - 1);
    end Lowercase_Of;

    function Is_Equal (Left : in Character;
                       Right : in Character;
                       Case_Sensitive : in Boolean := True) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Equal
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Equal
        if Case_Sensitive then
            return Left = Right;
        else
            return Uppercase_Of (The_Character => Left) =
                      Uppercase_Of (The_Character => Right);
        end if;
    end Is_Equal;

    function Is_Less_Than
                (Left : in Character;
                 Right : in Character;
                 Case_Sensitive : in Boolean := True) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Less_Than
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Less_Than
        if Case_Sensitive then
            return Left < Right;
        else
            return Uppercase_Of (The_Character => Left) <
                      Uppercase_Of (The_Character => Right);
        end if;
    end Is_Less_Than;

    function Is_Greater_Than
                (Left : in Character;
                 Right : in Character;
                 Case_Sensitive : in Boolean := True) return Boolean is
--------------------------------------------------------------------------------
-- <SUBPROGRAM>
-- <UNIT>        Is_Greater_Than
--
-- <DESCRIPTION> For a complete description of this subprogram see the
--               specification of this package.
--
-- <EXCEPTIONS>  For a complete description of the exceptions raised by this
--               subprogram see the specification of this package.
--
-- </SUBPROGRAM>
--------------------------------------------------------------------------------
    begin -- Is_Greater_Than
        if Case_Sensitive then
            return Left > Right;
        else
            return Uppercase_Of (The_Character => Left) >
                      Uppercase_Of (The_Character => Right);
        end if;
    end Is_Greater_Than;

end Character_Utilities;

-- </ADA>

E3 Meta Data

    nblk1=11
    nid=0
    hdr6=22
        [0x00] rec0=1b rec1=00 rec2=01 rec3=042
        [0x01] rec0=17 rec1=00 rec2=02 rec3=046
        [0x02] rec0=19 rec1=00 rec2=03 rec3=028
        [0x03] rec0=19 rec1=00 rec2=04 rec3=068
        [0x04] rec0=19 rec1=00 rec2=05 rec3=00c
        [0x05] rec0=18 rec1=00 rec2=06 rec3=004
        [0x06] rec0=19 rec1=00 rec2=07 rec3=04e
        [0x07] rec0=17 rec1=00 rec2=08 rec3=05a
        [0x08] rec0=18 rec1=00 rec2=09 rec3=05a
        [0x09] rec0=17 rec1=00 rec2=0a rec3=02e
        [0x0a] rec0=1a rec1=00 rec2=0b rec3=07a
        [0x0b] rec0=18 rec1=00 rec2=0c rec3=012
        [0x0c] rec0=17 rec1=00 rec2=0d rec3=09e
        [0x0d] rec0=19 rec1=00 rec2=0e rec3=03c
        [0x0e] rec0=1a rec1=00 rec2=0f rec3=00a
        [0x0f] rec0=1a rec1=00 rec2=10 rec3=018
        [0x10] rec0=05 rec1=00 rec2=11 rec3=000
    tail 0x217434ffa862f6c3434c5 0x42a00088462060003