The Ada Program: rational.adb

  1 -- rational.adb:  define record and functions for rational numbers
  2 
  3 procedure Rational is
  4 
  5    type Rational is
  6       record
  7          Num : Integer;
  8          Den : Positive := 1;
  9       end record;
 10 
 11    function GCD (X, Y: Natural) return Natural is
 12       X1: Natural := X;  Y1: Natural := Y;
 13    begin
 14       while (Y1 /= 0) loop
 15          X1 := Y1;  Y1 := X1 mod Y1;
 16       end loop;
 17       return X1;
 18    end GCD;
 19 
 20    function Rat (N: Integer; D: Positive:=1) return Rational is
 21       G: Natural := GCD (abs N, D);
 22    begin
 23       return (Rational'(Num=>N/G, Den=>D/G));
 24    end Rat;
 25 
 26    function "/" (Left: Integer; Right: Positive) return Rational is
 27    begin
 28       return (Rat (N=>Left, D=>Right));
 29    end "/";
 30 
 31    function "/" (Left, Right: Rational) return Rational is
 32    begin
 33       return ((Left.Num*Right.Den) / (Left.Den*Right.Num));
 34    end "/";
 35 
 36    function "*" (Left, Right: Rational) return Rational is
 37    begin
 38       return ((Left.Num*Right.Num) / (Left.Den*Right.Den));
 39    end "*";
 40 
 41    function "-" (Left: Rational) return Rational is
 42    begin
 43       return (Rational'(Num=>-Left.Num, Den=>Left.Den));
 44    end "-";
 45 
 46    R: Rational;
 47 
 48 begin
 49 
 50    -- these all create the same rational number
 51    R := Rational'(Num=>5, Den=>2);
 52    R := Rational'(5, 2);
 53    R := Rat (N=>5, D=>2);
 54    R := Rat (D=>2, N=>5);
 55    R := Rat (5, 2);
 56    R := 5 / 2;
 57 
 58    -- unlike "Rational'", "Rat" reduces and may omit 2nd arg
 59    R := Rational'(Num=>9, Den=>3);
 60    R := Rat (9, 3);
 61    R := Rational'(Num=>9, Den=>1);
 62    R := Rat (9);
 63 
 64    -- "/" is overloaded to provide convenient constructor
 65    R := 12 / 3;
 66 
 67    -- equality may not work as expected
 68    R := Rational'(Num=>12, Den=>3);
 69    if (R = Rational'(Num=>4, Den=>1)) then
 70       null;
 71    end if;
 72 
 73    if (Rat (1) = R/R) then
 74       null;
 75    end if;
 76 
 77 end Rational;