Power-Programmierung/CD1.mdf/magazine/drdobbs/1988/09/king.lis

File List | 1988-08-22 | 11KB | 460 lines

_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;