DataMuseum.dk

top - metrics - download

    Length: 5094 (0x13e6)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Text_Io;
package body Source_Io is

    Space : constant Character := ' ';
    Peek_Character : Character := Ascii.Nul;
    Was_Peeking : Boolean := False;

    --**
    Eol_Returned : Boolean := False;

    procedure Get (Item : out Character) is
    begin
        -- Get

        if Was_Peeking then
            Was_Peeking := False;
            Item := Peek_Character;
        elsif Text_Io.End_Of_File and not Eol_Returned then
            Eol_Returned := True;
            Item := New_Line;
        elsif Text_Io.End_Of_File and Eol_Returned then
            Eol_Returned := False;
            Item := End_Of_File;
        elsif Text_Io.End_Of_Line then
            Item := New_Line;
            Text_Io.Skip_Line;
        else
            Text_Io.Get (Item);
        end if;

    exception
        -- DG does NOT handle EOF properly
        when Text_Io.End_Error =>
            Item := End_Of_File;

    end Get;

    --
    function Peek return Character is

    begin
        -- Peek

        Get (Peek_Character);
        Was_Peeking := True;
        return Peek_Character;

    end Peek;

    --
    function Is_White_Space (Item : in Character) return Boolean is
    begin
        -- Is_White_Space

        case Item is

            when Space | Ascii.Ht | Ascii.Ff | Ascii.Vt =>
                return True;

            when others =>
                return False;

        end case;

    end Is_White_Space;

    --
    function Is_Letter (Item : in Character) return Boolean is
    begin
        case Item is
            when 'a' .. 'z' | 'A' .. 'Z' =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Letter;

    --
    function Is_Digit (Item : in Character) return Boolean is
    begin
        -- Is_Digit
        return (Item in '0' .. '9');
    end Is_Digit;

    --
    function Is_Punctuation (Item : in Character) return Boolean is
        -- see LRM 2.2:5-6
        -- '!' is added because it is a substitute for '|'
    begin
        -- Is_Punctuation
        case Item is
            when '&' | ''' | '(' | ')' | '*' | '+' | ',' | '-' | '.' |
                 '/' | '!' | ':' | ';' | '<' | '=' | '>' | '|' =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Punctuation;

    --
    function Is_Lower_Case (Item : in Character) return Boolean is
    begin
        -- Is_Lower_Case
        return (Item in 'a' .. 'z');
    end Is_Lower_Case;

    --
    function To_Upper_Case (Item : in Character) return Character is
    begin
        -- To_Upper_Case
        if Is_Lower_Case (Item) then
            return (Character'Val (Character'Pos ('A') +
                                   (Character'Pos (Item) -
                                    Character'Pos ('a'))));
        else
            return Item;
        end if;
    end To_Upper_Case;

    --
    function Is_Extended_Digit (Item : in Character) return Boolean is
    begin
        -- Is_Extended_Digit
        case Item is
            when '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Extended_Digit;

    --
    function Is_Non_Quote_Graphic (Item : in Character) return Boolean is
    begin
        -- Is_Non_Quote_Graphic
        case Item is
            when Space | '!' | '#' .. '~' =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Non_Quote_Graphic;

    --
    function Is_Graphic (Item : in Character) return Boolean is
    begin
        -- Is_Graphic
        return (Item in Space .. '~');
    end Is_Graphic;

    --
    function Is_Comment (Item : in Character) return Boolean is
    begin
        -- Is_Comment
        return (Item = '-' and then Peek = '-');
    end Is_Comment;

    --
    function Is_Compound_Delimiter (Item : in Character) return Boolean is
        Peek_Character : Character := Peek;
    begin
        -- Is_Compound_Delimiter

        case Item is

            when '=' =>
                return (Peek_Character = '>');

            when '.' =>
                return (Peek_Character = '.');

            when '*' =>
                return (Peek_Character = '*');

            when ':' | '/' =>
                return (Peek_Character = '=');

            when '>' =>
                return (Peek_Character = '=' or Peek_Character = '>');

            when '<' =>
                return (Peek_Character = '=' or
                        Peek_Character = '>' or Peek_Character = '<');

            when others =>
                return False;

        end case;

    end Is_Compound_Delimiter;

    --
    function Is_Valid_Compound_Delimiter (Item : in Character) return Boolean is
    begin
        -- Is_Valid_Compound_Delimiter
        case Item is
            when '>' | '.' | '*' | '=' | '<' =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Valid_Compound_Delimiter;

end Source_Io;