Dec  6 15:01 1995  fig1_2.adb Page 1


-- Function F is a simple recursive routine
-- A test program is provided

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Fig1_2 is

    function F( X: Integer ) return Integer is
    begin
        if X = 0 then 		-- Base case 
            return 0; 
        else
            return 2 * F( X - 1 ) + X ** 2; 
        end if;
    end F;

begin
    Put( F( 5 ) ); New_Line;
end Fig1_2;











































Dec  6 15:05 1995  fig1_3.adb Page 1


-- Function Bad illustrates infinite recursion
-- Procedure Fig1_3 is a simple test routine
-- Don't run this program!!! 
-- It's infinite recursion...

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Fig1_3 is

    function Bad( N: Integer ) return Integer is
    begin
        if N = 0 then 
            return 0; 
        else
            return Bad( N / 3 + 1 ) + N - 1; 
        end if;
    end Bad;

begin
    Put( Bad( 5 ) ); New_Line;
end Fig1_3;









































Dec  6 15:07 1995  fig1_4.adb Page 1


-- Procedure Print_Digit prints N, assuming that N is between 0 and 9.
-- Procedure Print_Out is a recursive routine that prints an arbitrary
--    nonegative N
-- Procedure Fig1_4 is a short test routine

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Error_Pack; use Error_Pack;

procedure Fig1_4 is

    procedure Print_Digit( N: Integer ) is
    begin
        Put( Character'Val( Character'Pos( '0' ) + N ) );
    end Print_Digit;

    procedure Print_Out( N: Integer ) is	-- Print nonnegative n 
    begin
        if N < 0 then
            Error( "N is negative" );
        elsif N < 10 then
            Print_Digit( N );
        else
            Print_Out( N / 10 );
            Print_Digit( N mod 10 );
        end if;
    end Print_Out;


begin
    Print_Out( 47568 ); New_Line;
end Fig1_4;































Jan 11 15:40 1996  fig1_5.adb Page 1


-- Function Count_Lines returns the number of lines in a file
--     passed as a parameter
-- Procedure Fig1_5 prompts for a file name, calls Count_Lines,
--     and outputs the number of lines in the file

with Ada.Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO;

procedure Fig1_5 is
    Max_File_Name_Length : constant := 256;
    File_Name            : String( 1..Max_File_Name_Length );
    Name_Length          : Natural;
    Number_Of_Lines      : Integer;

    function Count_Lines( File_Name : String ) return Integer is
        Max_Line_Length	: constant := 256;
        Lines_Read	: Natural := 0;
        File_Desc	: File_Type;
        One_Line	: String( 1..Max_Line_Length );
        Line_Length	: Natural range 0..Max_Line_Length;
    begin
        Open( File_Desc, In_File, File_Name );

        while not End_Of_File( File_Desc ) loop
            Get_Line( File_Desc, One_Line, Line_Length );
            if Line_Length < One_Line'Last then
                Lines_Read := Lines_Read + 1;
            end if;
        end loop;

        Close( File_Desc );
        return Lines_Read;

    end Count_Lines;

begin
    loop
        begin
            Text_IO.Put( "Enter input file name: " );
            Text_IO.Get_Line( File_Name, Name_Length );
            Number_Of_Lines := Count_Lines( File_Name( 1..Name_Length ) );

            Put( File_Name( 1..Name_Length ) );
            Put( " Has " ); Put( Number_Of_Lines, Width => 0 );
            Put_Line( " Lines." );

        exception
            when Name_Error =>
                Put( "Error opening " );
                Put( File_Name( 1..Name_Length ) );
                Put_Line( "." );

            when Data_Error =>
                Put( File_Name( 1..Name_Length ) );
                Put_Line( " Is not a text file." );
        end;







Jan 11 15:40 1996  fig1_5.adb Page 2



    end loop;

exception
    when End_Error =>
        Put_Line( "Exiting..." );


end Fig1_5;






















































Jan 11 15:40 1996  complex_numbers.ads Page 1


-- Generic Package Specification for Complex_Numbers
--
-- Requires:
--     Instantiated with any floating point type
-- Types defined:
--     Complex             private type
-- Exceptions defined:
--     Divide_By_Zero      raised by "/" if dividend is zero
-- Operations defined for Complex:
--     Unary + and -
--     Binary +, -, *, /
--     Put procedure
--     Set function        returns a new complex number
--     Real_Part and Imag_Part  access components

generic
    type Real is digits <>;

package Complex_Numbers is
    type Complex is private;

    procedure Put( A: Complex );
    function Set( Real_Part, Imag_Part: Real ) return Complex;
    function Real_Part( A: Complex ) return Real;
    function Imag_Part( A: Complex ) return Real;
    function "+"( A, B: Complex ) return Complex;
    function "+"( A:    Complex ) return Complex;
    function "-"( A, B: Complex ) return Complex;
    function "-"( A:    Complex ) return Complex;
    function "*"( A, B: Complex ) return Complex;
    function "/"( A, B: Complex ) return Complex;

    Divide_By_Zero : exception;

private
    type Complex is
      record
        Real_Part : Real := 0.0;
        Imag_Part : Real := 0.0;
      end record;

end Complex_Numbers;





















Dec  6 15:36 1995  complex_numbers.adb Page 1


-- Implementation of package Complex_Numbers
-- All operations are trivial except for "/"

with Ada.Text_IO; use Ada.Text_IO;

package body Complex_Numbers is

    procedure Put( A: Complex ) is
        package Float_Text_IO is new Float_Io( Real ); use Float_Text_IO;
    begin
        Put( A.Real_Part, Exp => 0 ); Put( " + " );
        Put( A.Imag_Part, Exp => 0 ); Put( "I" );
    end Put;

    function Set( Real_Part, Imag_Part: Real ) return Complex is
    begin
        return Complex'( Real_Part, Imag_Part );
    end Set;

    function Real_Part( A: Complex ) return Real is 
    begin
        return A.Real_Part;
    end Real_Part;

    function Imag_Part( A: Complex ) return Real is
    begin
        return A.Imag_Part;
    end Imag_Part;

    function "+"( A, B: Complex ) return Complex is
    begin
        return Complex'( A.Real_Part + B.Real_Part, A.Imag_Part + B.Imag_Part );
    end "+";

    function "+"( A:    Complex ) return Complex is
    begin
        return A;
    end "+";

    function "-"( A, B: Complex ) return Complex is
    begin
        return Complex'( A.Real_Part - B.Real_Part, A.Imag_Part - B.Imag_Part );
    end "-";

    function "-"( A:    Complex ) return Complex is
    begin
        return Complex'( - A.Real_Part, - A.Imag_Part );
    end "-";

    function "*"( A, B: Complex ) return Complex is
    begin
        return Complex'( A.Real_Part * B.Real_Part - A.Imag_Part * B.Imag_Part,
                 A.Real_Part * B.Imag_Part + A.Imag_Part * B.Real_Part );
    end "*";

    -- Return result of A / B







Dec  6 15:36 1995  complex_numbers.adb Page 2


    -- If B is zero, raise Divide_By_Zero exception

    function "/"( A, B: Complex ) return Complex is
        Modulus : Real;
        B_Complement, Tmp : Complex;
    begin
        Modulus := B.Real_Part * B.Real_Part + B.Imag_Part * B.Imag_Part;
        if Modulus = 0.0 then
            raise Divide_By_Zero;
        end if;

        B_Complement := ( B.Real_Part, - B.Imag_Part );
        Tmp := A * B_Complement;

        return Complex'( Tmp.Real_Part / Modulus, Tmp.Imag_Part / Modulus );
    end "/";

end Complex_Numbers;













































Dec  6 15:37 1995  complex_numbers_test.adb Page 1


-- Simple test program for complex numbers

with Ada.Text_IO; use Ada.Text_IO;
with Complex_Numbers;

procedure Complex_Numbers_Test is
    package Float_Complex is new Complex_Numbers( Float ); use Float_Complex;

begin
    -- Evaluate:
    -- 
    --	  ( 6 + 4i )( 8 + 2i ) 
    --	- --------------------- 
    --	  ( 1 +  i )( 3 + 2i ) 
    -- 

    Put( - ( Set( 6.0, 4.0 ) * Set( 8.0, 2.0 ) )
       / ( Set( 1.0, 1.0 ) * Set( 3.0, 2.0 ) ) );

    New_Line;
end Complex_Numbers_Test;










































Jan 11 15:41 1996  error_pack.ads Page 1


-- Package Specificiation for Error_Pack
-- No types are defined
-- Two short procedures are defined:
--     Error              Process an error message
--     Fatal_Error        Process a fatal error message

package Error_Pack is
    procedure Error( S: String );
    procedure Fatal_Error( S: String );
end Error_Pack;





















































Dec  6 15:39 1995  error_pack.adb Page 1


-- Implementation of package Error_Pack
-- In this implementation Error and Fatal_Error
-- merely print the error message
-- In neither case is the program terminated

with Text_IO; use Text_IO;

package body Error_Pack is
    procedure Error( S: String ) is
    begin
        Put_Line( S );
    end Error;

    procedure Fatal_Error( S: String ) is
    begin
        Put_Line( S );
    end Fatal_Error;
end Error_Pack;