C.7. Operators - JulTob/Ada GitHub Wiki
You can use and overload operators in Ada.
You can use as a pre-operator:
Example of quick type conversion
package Useful is
function "+" (S: String) return Bounded_String;
end;
package body Useful is
function "+" (S: String) return Bounded_String is
begin
return To_Bounded_String(S);
end "+";
end Useful;
with Useful; use Useful;
For algebraic utilities.
ads
package Rational_Numbers is
type Rational is private;
-- unary operators
function "+" (X: Rational) return Rational;
function "-" (X: Rational) return Rational;
-- binary operators
function "+" (X, Y: Rational) return Rational;
function "-" (X, Y: Rational) return Rational;
function "*" (X, Y: Rational) return Rational;
function "/" (X, Y: Rational) return Rational;
-- constructor function
function "/" (X: Integer; Y: Positive) return Rational;
-- selector functions
function Numerator(R: Rational) return Integer;
function Denominator(R: Rational) return Positive;
private
type Rational is
record
Num: Integer := 0; -- numerator
Den: Positive := 1; -- denominator
end record;
end;
private package Rational_Numbers.Slave is
-- The function Normal cancels any common factors in
-- the numerator and denominator and returns
-- the normalized form.
-- It could be restructured as a child function.
function Normal(R: Rational) return Rational;
end;
package body Rational_Numbers.Slave is
-- It would be more efficient to use the iterative
-- form of GCD
function GCD(X, Y: Natural) return Natural is
begin
if Y = 0 then
return X;
else
return GCD(Y, X mod Y);
end if;
end GCD;
function Normal(R: Rational) return Rational is
G: Positive := GCD(abs R.Num, R.Den);
begin
return (R.Num/G, R.Den/G);
end Normal;
end Rational_Numbers.Slave;
with Rational_Numbers.Slave;
package body Rational_Numbers is
use Slave;
-- It might be argued that it would be better to use the
-- constructor function "/" rather than directly use Normal
-- in the various operations.
function "+" (X: Rational) return Rational is
begin
return X;
end "+";
function "-" (X: Rational) return Rational is
begin
return (-X.Num
, X.Den);
end "-";
function "+" (X, Y: Rational) return Rational is
begin
return Normal((
X.Num*Y.Den + Y.Num*X.Den,
X.Den*Y.Den));
end "+";
function "-" (X, Y: Rational) return Rational is
begin
return Normal((
X.Num*Y.Den - Y.Num*X.Den,
X.Den*Y.Den));
end "-";
function "*" (X, Y: Rational) return Rational is
begin
return Normal((
X.Num*Y.Num,
X.Den*Y.Den));
end "*";
function "/" (X, Y: Rational) return Rational is
N: Integer := X.Num*Y.Den;
D: Integer := X.Den*Y.Num;
begin
-- we have to change the signs if D is negative because
-- Den is of subtype Positive.
if D < 0 then D := -D; N := -N; end if;
return Normal((
Num => N,
Den => D));
end "/";
function "/" (X: Integer; Y: Positive) return Rational is
begin
return Normal((Num => X, Den => Y));
end "/";
function Numerator(R: Rational) return Integer is
begin
return R.Num;
end Numerator;
function Denominator(R: Rational) return Positive is
begin
return R.Den;
end Denominator;
end Rational_Numbers;
package Rational_Numbers.IO is
procedure Get(X: out Rational);
procedure Put(X: in Rational);
end;
with Ada.Text_IO, Ada.Integer_Text_IO; use Ada;
with Rational_Numbers.Slave;
package body Rational_Numbers.IO is
-- This child package directly accesses the components of the
-- type Rational and uses the function Normal in the child
-- package which is not visible to the external client.
-- An alternative approach would be only to use the public
-- view of the type Rational in which case this package need not
-- be a child.
procedure Get(X: out Rational) is
N: Integer; -- numerator
D: Integer; -- denominator
C: Character;
EOL: Boolean; -- end of line
begin
-- Read the signed numerator with the predefined Get.
-- This also skips spaces and newlines.
Integer_Text_IO.Get(N); -- numerator
Text_IO.Look_Ahead(C, EOL);
if EOL or else C /= '/' then
raise Text_IO.Data_Error;
end if;
Text_IO.Get(C); -- remove the / character
Text_IO.Look_Ahead(C, EOL);
if EOL or else C not in '0' .. '9' then
raise Text_IO.Data_Error;
end if;
-- Read the unsigned denominator.
Integer_Text_IO.Get(D); -- denominator
if D = 0 then
raise Text_IO.Data_Error;
end if;
X := Slave.Normal((N, D));
end Get;
procedure Put(X: in Rational) is
begin
Integer_Text_IO.Put(X.Num, 0);
Text_IO.Put('/');
Integer_Text_IO.Put(X.Den, 0);
end Put;
end Rational_Numbers.IO;
with Rational_Numbers;
use Rational_Numbers;
package Rat_Stack is
-- This package provides a stack of Rational values.
-- The subprograms Push and Pop are as usual - they raise
-- the exception Error if an attempt is made to Push onto a
-- full stack or Pop from an empty one. The procedure Clear
-- sets the stack to empty.
Error: exception;
procedure Clear;
procedure Push(R: in Rational);
function Pop return Rational;
end;
private package Rat_Stack.Data is
Max: constant := 4; -- stack size
Top: Integer := 0;
Stack: array (1 .. Max) of Rational;
end Rat_Stack.Data;
with Rat_Stack.Data;
package body Rat_Stack is
use Data;
-- The data which represents the stack is in the private child
-- package Data.
procedure Clear is
begin
Top := 0;
end Clear;
procedure Push(R: in Rational) is
begin
if Top = Max then
raise Error;
end if;
Top := Top + 1;
Stack(Top) := R;
end Push;
function Pop return Rational is
begin
if Top = 0 then
raise Error;
end if;
Top := Top - 1;
return Stack(Top + 1);
end Pop;
end Rat_Stack;
with Rational_Numbers.IO;
with Ada.Text_IO;
private with Rat_Stack.Data;
procedure Rat_Stack.Print_Top is
use Data;
-- Prints the top item on the stack without deleting it.
-- Outputs an appropriate message if the stack is empty.
-- Note the private with clause for Rat_Stack.Data. This is
-- necessary because we have chosen not to give a distinct
-- specification for Print_Top. In such a case the context
-- clause behaves as if it were on a specification and the
-- specification of a public child can only have a private
-- with clause for a private sibling.
begin
if Top = 0 then
Ada.Text_IO.Put("Nothing on stack");
else
Rational_Numbers.IO.Put(Stack(Top));
end if;
Ada.Text_IO.New_Line;
end Rat_Stack.Print_Top;
with Rat_Stack;
with Ada.Text_IO; use Ada.Text_IO;
procedure Rational_Reckoner is
C: Character;
Control_Error, Done: exception;
procedure Process(C: Character) is separate;
begin
Put("Welcome to the Rational Reckoner");
New_Line(2);
Put_Line("Operations are + - * / ? ! plus eXit");
Put_Line("Input rational by #[sign]digits/digits");
Rat_Stack.Clear;
loop
begin
Get(C);
Process(C);
exception
when Rat_Stack.Error =>
New_Line;
Put_Line("Stack overflow/underflow, " &
"stack reset");
Rat_Stack.Clear;
when Control_Error =>
New_Line;
Put_Line("Unexpected character, " &
"not # + - * / ? ! or X");
when Done =>
exit;
end;
end loop;
New_Line;
Put_Line("Finished");
Skip_Line(2);
end Rational_Reckoner;
with Rat_Stack.Print_Top; use Rat_Stack;
with Rational_Numbers; use Rational_Numbers;
separate(Rational_Reckoner)
procedure Process(C: Character) is
-- Performs the action represented by the character passed
-- as parameter.
-- Raises the exception Control_Error if the character is not
-- recognized. Raises Done if the program is to terminate. It
-- might also propagate Rat_Stack.Error from the calls of Push
-- and Pop.
R: Rational;
procedure Get_Rational(R: out Rational) is separate;
begin
case C is
when '#' =>
Get_Rational(R);
Push(R);
when '+' =>
Push(Pop + Pop);
when '-' =>
R := Pop; Push(Pop - R);
when '*' =>
Push(Pop * Pop);
when '/' =>
R := Pop; Push(Pop / R);
when '?' =>
Print_Top;
when '!' =>
Print_Top; R := Pop;
when ' ' =>
null;
when 'X' | 'x' =>
raise Done;
when others =>
raise Control_Error;
end case;
end Process;
with Rational_Numbers.IO;
separate(Rational_Reckoner.Process)
procedure Get_Rational(R: out Rational) is
-- Reads a rational value. If an attempt raises Data_Error
-- then it outputs a message and a prompt and tries again.
begin
loop
begin
IO.Get(R);
exit;
exception
when Data_Error =>
Skip_Line; New_Line;
Put_Line("Not a rational, try again ");
Put('#');
end;
end loop;
end Get_Rational;