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

⟦aedd1d44a⟧ Ada Source

    Length: 21504 (0x5400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Character_Utilities, seg_04796f

Derivation

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

E3 Source Code



package body Character_Utilities is

-- <!DOCTYPE ADA>
-- <ADA>

--------------------------------------------------------------------------------
-- <PROLOGUE>
-- <UNIT>        Character_Utilities
--
-- <DESCRIPTION> This package defines subtypes and operations for working with
--               ASCII characters.
--
-- <HISTORY>
--
-- <ORIGIN>
-- <AUTHOR>      David Blanchard and Peter A. Berggren
-- <DATE>        12 July 1989
--
-- <COMPANY>     Science Applications International Corporation
-- <ADDRESS>     311 Park Place Boulevard, Suite 360
-- <ADDRESS>     Clearwater, Florida 34619
--
-- <REMARK>      The specification of this package was derived from "Software
--               Components with Ada", by Grady Booch.
--               Developed for the STARS program under task IR20.
-- </ORIGIN>
--
-- </HISTORY>
--
-- <NOTES>       Dependencies =>
--                 ( Operating_System => None ,
--                   Compiler         => None ,
--                   Device           => None ) ;
--
--  <copyright notice>
--      This component was derived from specifications described in the book,
--      "Software Components with Ada", by Grady Booch.
--
--
-- </PROLOGUE>
--------------------------------------------------------------------------------

    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;


E3 Meta Data

    nblk1=14
    nid=14
    hdr6=26
        [0x00] rec0=21 rec1=00 rec2=01 rec3=056
        [0x01] rec0=1a rec1=00 rec2=12 rec3=05c
        [0x02] rec0=08 rec1=00 rec2=13 rec3=042
        [0x03] rec0=17 rec1=00 rec2=02 rec3=046
        [0x04] rec0=19 rec1=00 rec2=03 rec3=028
        [0x05] rec0=19 rec1=00 rec2=04 rec3=068
        [0x06] rec0=19 rec1=00 rec2=05 rec3=00c
        [0x07] rec0=18 rec1=00 rec2=06 rec3=004
        [0x08] rec0=19 rec1=00 rec2=07 rec3=04e
        [0x09] rec0=17 rec1=00 rec2=08 rec3=05a
        [0x0a] rec0=18 rec1=00 rec2=09 rec3=05a
        [0x0b] rec0=17 rec1=00 rec2=0a rec3=02e
        [0x0c] rec0=1a rec1=00 rec2=0b rec3=07a
        [0x0d] rec0=18 rec1=00 rec2=0c rec3=012
        [0x0e] rec0=17 rec1=00 rec2=0d rec3=09e
        [0x0f] rec0=19 rec1=00 rec2=0e rec3=03c
        [0x10] rec0=1a rec1=00 rec2=0f rec3=00a
        [0x11] rec0=1a rec1=00 rec2=10 rec3=018
        [0x12] rec0=04 rec1=00 rec2=11 rec3=000
        [0x13] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21544a4da865477631263 0x42a00088462060003
Free Block Chain:
  0x14: 0000  00 00 00 29 80 04 6e 65 20 2c 04 00 1f 2d 2d 20  ┆   )  ne ,   -- ┆