_ADA FOR PASCAL PROGRAMMERS_
by
Kim King


Example 1:  A Pascal program that counts occurrences of letters 
in the input stream 

program CountLetters(input, output); 
  { counts occurrences of letters in the input stream } 
  var Counts: array ['a'..'z'] of integer; 
      Ch: char; 
begin 
  for Ch := 'a' to 'z' do 
    Counts[Ch] := 0; 
  while not eof do 
    begin 
      read(Ch); 
      if ('a' <= Ch) and (Ch <= 'z') then 
        Counts[Ch] := Counts[Ch] + 1 
      else if ('A' <= Ch) and (Ch <= 'Z') then 
        begin 
          Ch := chr(ord(Ch) - ord('A') + ord('a')); 
          Counts[Ch] := Counts[Ch] + 1 
        end 
    end; 
  for Ch := 'a' to 'z' do 
    writeln(Ch, Counts[Ch]:6) 
end. 


Example 2:  An Ada program that counts occurrences of letters in 
the input stream 


 1. with Text_IO; use Text_IO; 
 2. procedure Count_Letters is 
 3.   -- counts occurrences of letters in the input stream 
 4.   package Int_IO is new Integer_IO(Integer); 
 5.   use Int_IO; 
 6.   Counts: array ('a'..'z') of Integer := (others => 0); 
 7.   Ch: Character; 
 8. begin 
 9.   while not End_Of_File loop 
10.     Get(Ch); 
11.     if 'a' <= Ch and Ch <= 'z' then 
12.       Counts(Ch) := Counts(Ch) + 1; 
13.     elsif 'A' <= Ch and Ch <= 'Z' then 
14.       Ch := Character'Val(Character'Pos(Ch) -
15.                           Character'Pos('A') + 
16.                           Character'Pos('a')); 
17.       Counts(Ch) := Counts(Ch) + 1; 
18.     end if; 
19.   end loop; 
20.   for Ch in 'a'..'z' loop 
21.     Put(Ch); 
22.     Put(Counts(Ch), 6); 
23.     New_Line; 
24.   end loop; 
25. end Count_Letters; 



Example 3: Overloading the Put procedure

procedure Put(File: File_Type; Item: Character); 
procedure Put(Item: Character); 
procedure Put(File: File_Type; Item: String); 
procedure Put(Item: String); 


Example 4: The specification of the Length_Conversions package 

package Length_Conversions is 
  Feet_To_Meters: constant := 0.3048; 
  Inches_To_Centimeters: constant := 2.54; 
  Miles_To_Kilometers: constant := 1.6093; 
  Yards_To_Meters: constant := 0.9144; 
end Length_Conversions; 


Example 5: A program that uses the Length_Conversions package 

with Text_IO, Length_Conversions; 
use Text_IO, Length_Conversions; 
procedure Convert_To_Meters is 
  package Int_IO is new Integer_IO(Integer); 
  use Int_IO; 
  Feet: Integer; 
begin 
  Put("Enter a measurement in feet: "); 
  Get(Feet); 
  Skip_Line; 
  Put("The equivalent measurement in meters is: "); 
  Put(Integer(Float(Feet)*Feet_To_Meters), 1); 
  New_Line; 
end Convert_To_Meters; 


Example 6: The specification of the Angle_Conversions package 

package Angle_Conversions is 
  function Degrees_To_Radians(Degrees: Float) return Float; 
  function Radians_To_Degrees(Radians: Float) return Float; 
end Angle_Conversions; 



Example 7: The body of the Angle_Conversions package 

package body Angle_Conversions is 

  Two_Pi: constant := 2.0 * 3.14159; 

  function Degrees_To_Radians(Degrees: Float) return Float is 
  begin 
    return Two_Pi * Degrees / 360.0; 
  end Degrees_To_Radians; 

  function Radians_To_Degrees(Radians: Float) return Float is 
  begin 
    return 360.0 * Radians / Two_Pi; 
  end Radians_To_Degrees; 

end Angle_Conversions; 


Example 8: The specification of the Char_Stack package 

package Char_Stack is 

  procedure Push(X: Character); 
    -- pushes X onto the stack 

  procedure Pop(X: out Character); 
    -- stores the top stack element into X, then pops the stack 

  function Is_Empty return Boolean; 
    -- returns True if the stack is empty, False otherwise 

end Char_Stack; 



Example 9: The body of the Char_Stack package 

package body Char_Stack is 

  Stack_Size: constant := 100;  --maximum size of stack 
  Stack_Array: array (1..Stack_Size) of Character; 
  Top_Of_Stack: Integer range 0..Stack_Size := 0; 

  procedure Push(X: Character) is 
  begin 
    Top_Of_Stack := Top_Of_Stack + 1; 
    Stack_Array(Top_Of_Stack) := X; 
  end Push; 

  procedure Pop(X: out Character) is 
  begin 
    X := Stack_Array(Top_Of_Stack); 
    Top_Of_Stack := Top_Of_Stack - 1; 
  end Pop; 

  function Is_Empty return Boolean is 
  begin 
    return Top_Of_Stack = 0; 
  end Is_Empty; 

end Char_Stack; 


Example 10: A program that uses the Char_Stack package to reverse 
a string 

with Text_IO, Char_Stack; 
use Text_IO, Char_Stack; 
procedure Reverse_String is 
  Ch: Character; 
begin 
  Put("Enter string to be reversed: "); 
  while not End_Of_Line loop 
    Get(Ch); 
    Push(Ch); 
  end loop; 
  Skip_Line; 

  Put("The reversal is: "); 
  while not Is_Empty loop 
    Pop(Ch); 
    Put(Ch); 
  end loop; 
  New_Line; 
end Reverse_String; 


Example 11: The specification of the Char_Stacks package; 
Char_Stack is an ordinary type

package Char_Stacks is 

  Stack_Size: constant := 100; 
  type Array_Type is array (1..Stack_Size) of Character; 
  type Char_Stack is 
    record 
      Stack_Array: Array_Type; 
      Top_Of_Stack: Integer range 0..Stack_Size := 0; 
    end record; 

  procedure Push(S: in out Char_Stack; X: Character); 
    -- pushes X onto stack S 

  procedure Pop(S: in out Char_Stack; X: out Character); 
    -- stores the top element of S into X, then pops S 

  function Is_Empty(S: Char_Stack) return Boolean; 
    -- returns True if S is empty, False otherwise 

end Char_Stacks; 


Example 12: The specification of the Char_Stacks package; 
Char_Stack is a private type


package Char_Stacks is 

  type Char_Stack is private; 

  procedure Push(S: in out Char_Stack; X: Character); 
    -- pushes X onto stack S 

  procedure Pop(S: in out Char_Stack; X: out Character); 
    -- stores the top element of S into X, then pops S 

  function Is_Empty(S: Char_Stack) return Boolean; 
    -- returns True if S is empty, False otherwise 

private 
  Stack_Size: constant := 100; 
  type Array_Type is array (1..Stack_Size) of Character; 
  type Char_Stack is 
    record 
      Stack_Array: Array_Type; 
      Top_Of_Stack: Integer range 0..Stack_Size := 0; 
    end record; 
end Char_Stacks; 


Example 13: The body of the Char_Stacks package 

package body Char_Stacks is 

  procedure Push(S: in out Char_Stack; X: Character) is 
  begin 
    S.Top_Of_Stack := S.Top_Of_Stack + 1; 
    S.Stack_Array(S.Top_Of_Stack) := X; 
  end Push; 

  procedure Pop(S: in out Char_Stack; X: out Character) is 
  begin 
    X := S.Stack_Array(S.Top_Of_Stack); 
    S.Top_Of_Stack := S.Top_Of_Stack - 1; 
  end Pop; 

  function Is_Empty(S: Char_Stack) return Boolean is 
  begin 
    return S.Top_Of_Stack = 0; 
  end Is_Empty; 

end Char_Stacks; 


Example 14: A program that uses the Char_Stacks package to 
reverse a string 

with Text_IO, Char_Stacks; 
use Text_IO, Char_Stacks; 
procedure Reverse_String is 
  S: Char_Stack; 
  Ch: Character; 
begin 
  Put("Enter string to be reversed: "); 
  while not End_Of_Line loop 
    Get(Ch); 
    Push(S, Ch); 
  end loop; 
  Skip_Line; 

  Put("The reversal is: "); 
  while not Is_Empty(S) loop 
    Pop(S, Ch); 
    Put(Ch); 
  end loop; 
  New_Line; 
end Reverse_String; 



Example 15: The specification of the Char_Stacks package with 
exceptions added 

package Char_Stacks is 

  type Char_Stack is private; 

  procedure Push(S: in out Char_Stack; X: Character); 
    -- pushes X onto stack S; raises Overflow if S is full 

  procedure Pop(S: in out Char_Stack; X: out Character); 
    -- stores the top element of S into X, then pops S 
    -- raises Underflow if S is empty 

  function Is_Empty(S: Char_Stack) return Boolean; 
    -- returns True if S is empty, False otherwise 

  Overflow, Underflow: exception; 

private 
  Stack_Size: constant := 100; 
  type Array_Type is array (1..Stack_Size) of Character; 
  type Char_Stack is 
    record 
      Stack_Array: Array_Type; 
      Top_Of_Stack: Integer range 0..Stack_Size := 0; 
    end record; 
end Char_Stacks; 




Example 16: The body of the Char_Stacks package with exceptions 
added 

package body Char_Stacks is 

  procedure Push(S: in out Char_Stack; X: Character) is 
  begin 
    if S.Top_Of_Stack = Stack_Size then 
      raise Overflow; 
    end if; 
    S.Top_Of_Stack := S.Top_Of_Stack + 1; 
    S.Stack_Array(S.Top_Of_Stack) := X; 
  end Push; 

  procedure Pop(S: in out Char_Stack; X: out Character) is 
  begin 
    if S.Top_Of_Stack = 0 then 
      raise Underflow; 
    end if; 
    X := S.Stack_Array(S.Top_Of_Stack); 
    S.Top_Of_Stack := S.Top_Of_Stack - 1; 
  end Pop; 

  function Is_Empty(S: Char_Stack) return Boolean is 
  begin 
    return S.Top_Of_Stack = 0; 
  end Is_Empty; 

end Char_Stacks; 


Example 17: A program that uses the Char_Stacks package to 
reverse a string (with exception handling added) 


with Text_IO, Char_Stacks; 
use Text_IO, Char_Stacks; 
procedure Reverse_String is 
  S: Char_Stack; 
  Ch: Character; 
begin 
  Put("Enter string to be reversed: "); 
  begin 
    while not End_Of_Line loop 
      Get(Ch); 
      Push(S, Ch); 
    end loop; 
  exception 
    when Overflow => null;   -- ignore overflow 
  end; 
  Skip_Line; 

  Put("The reversal is: "); 
  while not Is_Empty(S) loop 
    Pop(S, Ch); 
    Put(Ch); 
  end loop; 
  New_Line; 
end Reverse_String; 


Example 18: The specification of the generic Stacks package 

generic 
  type Element is private; 
package Stacks is 

  type Stack is private; 

  procedure Push(S: in out Stack; X: Element); 
    -- pushes X onto stack S; raises Overflow if S is full 

  procedure Pop(S: in out Stack; X: out Element); 
    -- stores the top element of S into X, then pops S 
    -- raises Underflow if S is empty 

  function Is_Empty(S: Stack) return Boolean; 
    -- returns True if S is empty, False otherwise 

  Overflow, Underflow: exception; 

private 
  Stack_Size: constant := 100; 
  type Array_Type is array (1..Stack_Size) of Element; 
  type Stack is 
    record 
      Stack_Array: Array_Type; 
      Top_Of_Stack: Integer range 0..Stack_Size := 0; 
    end record; 
end Stacks; 


Example 19: A program that uses the generic Stacks package to 
reverse a string 

with Text_IO, Stacks; 
use Text_IO; 
procedure Reverse_String is 

  package Char_Stacks is new Stacks(Character); 
  use Char_Stacks; 

  S: Stack; 
  Ch: Character; 

begin 
  Put("Enter string to be reversed: "); 
  begin 
    while not End_Of_Line loop 
      Get(Ch); 
      Push(S, Ch); 
    end loop; 
  exception 
    when Overflow => null; 
  end; 
  Skip_Line; 

  Put("The reversal is: "); 
  while not Is_Empty(S) loop 
    Pop(S, Ch); 
    Put(Ch); 
  end loop; 
  New_Line; 
end Reverse_String; 




