{ This module defines an interface for a ratio data type and implements it
  for HP 9000 Series 700 workstations under HP-UX 9.x, using HP Pascal.

  Programmer: John Stone, Grinnell College.
  Original version: February 13-20, 1996.
  Added ratio_numerator and ratio_denominator functions: March 22, 1996.
}

{ The dispose() procedure does not actually recycle storage unless the
  HEAP_DISPOSE compiler option is turned on. }

$HEAP_DISPOSE ON$

module ratios;

$search 'naturals.o'$
import
  naturals;

export

  { The use of a pointer to a non-exported data type is HP Pascal's way of
    making a data type effectively opaque. }

  type
    signum = (negative, non_negative);
    ratio = ^ratio_structure;

  { The make_ratio function returns the ratio of two natural numbers, with
    the specified sign (except that the sign of a zero ratio is always
    non-negative. }

  function make_ratio (s: signum; n, d: natural): ratio;

  { The ratio_numerator function returns the numerator of a ratio, as a
    natural number. }

  function ratio_numerator (r: ratio): natural;

  { The ratio_denominator function returns the denominator of a ratio, as a
    natural number. }

  function ratio_denominator (r: ratio): natural;

  { The ratio_negative function returns the negative, the additive inverse,
    of a given ratio. }

  function ratio_negative (negand: ratio): ratio;

  { The ratio_abs function returns the absolute value of a given ratio. }

  function ratio_abs (r: ratio): ratio;

  { The is_negative_ratio function determines whether a given ratio is
    strictly negative -- less than zero. }

  function is_negative_ratio (given: ratio): Boolean;

  { The is_zero_ratio function determines whether a given ratio is 0/1,
    returning TRUE if it is and FALSE if it is not. }

  function is_zero_ratio (given: ratio): Boolean;

  { The is_positive_ratio function determines whether a given ratio is
    strictly positive -- greater than zero. }

  function is_positive_ratio (given: ratio): Boolean;

  { The ratio_sum function adds any two ratios and returns their sum. }

  function ratio_sum (augend, addend: ratio): ratio;

  { The ratio_difference function subtracts one ratio (the subtrahend) from
    another (the minuend) and returns their difference. } 

  function ratio_difference (minuend, subtrahend: ratio): ratio;

  { The ratio_product function multiplies one ratio (the multiplicand) by
    another (the multiplier) and returns their product. }

  function ratio_product (multiplicand, multiplier: ratio): ratio;

  { The ratio_quotient function divides one ratio (the dividend) by
    another (the divisor) and returns the quotient as a ratio.  It
    presupposes that the divisor is not zero. }

  function ratio_quotient (dividend, divisor: ratio): ratio;

  { The ratio_power function raises a ratio (the base) to the power
    specified by a natural number (the exponent) and returns the result as
    a ratio.  It returns 1/1 whenever the exponent is zero, even if the
    base is also zero. } 

  function ratio_power (base: ratio; exponent: natural): ratio;

  { Given a ratio, the ratio_twice function computes and returns its double
    -- that is, the ratio that is twice as large. } 

  function ratio_twice (given: ratio): ratio;

  { Given a ratio, the ratio_half function computes and returns its half. }

  function ratio_half (given: ratio): ratio;

  { Given a ratio, the ratio_square function computes and returns its
    square. }

  function ratio_square (given: ratio): ratio;

  { Given a ratio, the ratio_cube function computes and returns its cube. }

  function ratio_cube (given: ratio): ratio;

  { Given a non-zero ratio, the ratio_reciprocal function computes and
    returns its reciprocal -- its multiplicative inverse. }

  function ratio_reciprocal (given: ratio): ratio;

  { The ratio_increment procedure increments a given ratio variable by some
    amount, also given as a ratio. } 

  procedure ratio_increment (var given: ratio; amount: ratio);

  { The ratio_decrement procedure decrements a given ratio variable by some
    some amount, also given as a ratio. }

  procedure ratio_decrement (var given: ratio; amount: ratio);

  { The ratio_scale_up procedure multiplies the value of a given ratio
    variable by some amount, also given as a ratio. }

  procedure ratio_scale_up (var given: ratio; scale: ratio);

  { The ratio_scale_down procedure divides the value of a given ratio
    variable by some amount, also given as a ratio.  It presupposes that
    the amount is not zero. } 

  procedure ratio_scale_down (var given: ratio; scale: ratio);

  { The ratio_double procedure doubles the value of a given ratio
    variable. }

  procedure ratio_double (var given: ratio);

  { The ratio_halve procedure halves the value of a given ratio variable. }

  procedure ratio_halve (var given: ratio);

  { The ratio_less function determines whether the first of its arguments is
    numerically less than the second. }

  function ratio_less (first, second: ratio): Boolean;

  { The ratio_equal function determines whether its arguments are
    arithmetically equal -- not necessarily identical as storage
    structures, but equal in value. }

  function ratio_equal (first, second: ratio): Boolean;

  { The ratio_greater function determines whether the first of its
    arguments is arithmetically greater than the second. }

  function ratio_greater (first, second: ratio): Boolean;

  { The ratio_not_less function determines whether the first of its
    arguments is arithmetically less than the second, returning FALSE if it
    is and TRUE if it is not.  (In other words, it returns TRUE if its
    first argument is arithmetically greater than or equal to its
    second.) }

  function ratio_not_less (first, second: ratio): Boolean;

  { The ratio_not_equal function determines whether the first of its
    arguments differs in value from its second -- not whether they differ
    as storage structures, but whether their arithmetical values differ. }

  function ratio_not_equal (first, second: ratio): Boolean;

  { The ratio_not_greater function determines whether the first of its
    arguments is arithmetically greater than the second, returning FALSE
    if it is and TRUE if it is not.  (In other words, it returns TRUE if
    its first argument is arithmetically less than or equal to its
    second.) } 

  function ratio_not_greater (first, second: ratio): Boolean;

  { The ratio_max function returns the greater of its two arguments; if
    they are equal, it returns the first of the two. }

  function ratio_max (first, second: ratio): ratio;

  { The ratio_min function returns the lesser of its two arguments; if they
    are equal, it returns the first of the two. }

  function ratio_min (first, second: ratio): ratio;

  { The read_ratio procedure collects from a specified text file a sequence
    of characters consisting of zero or more whitespace characters, an
    optional sign (+ or -), one or more decimal digits, and, optionally,
    a slash and one or more further decimal digits.  It computes the ratio
    expressed by this numeral and stores it in a given variable.  It
    presupposes that the text file has already been opened for input and
    that there is at least one decimal digit to be read. }

  procedure read_ratio (var source: text; var legendum: ratio);

  { The input_ratio procedure collects the same character sequence as
    read_ratio, but specifically from standard input. }

  procedure input_ratio (var legendum: ratio);

  { The write_ratio procedure writes a base-ten fraction for a given
    ratio to a specified text file: first, if the ratio is negative, a
    minus sign; then the numerator, with no leading zeroes or spaces
    (but the single digit '0' is written if the given ratio is 0/1); then a
    slash; and finally the denominator, again with no leading zeroes or
    spaces.  It presupposes that the text file has already been opened for
    output. } 

  procedure write_ratio (var target: text; scribendum: ratio);

  { The output_ratio procedure writes a base-ten fraction for a given 
    ratio, as in write_ratio, but specifically to standard output. }

  procedure output_ratio (scribendum: ratio);

  { The output_ratio_to_standard_error procedure writes a base-ten
    fraction for a given ratio, as in write_ratio, but specifically to
    standard error output. }

  procedure output_ratio_to_standard_error (scribendum: ratio);

  { The ratio_assign procedure copies a given ratio into a variable
    location. }

  procedure ratio_assign (var target: ratio; source: ratio);

  { Given any natural number, the natural_to_ratio function constructs
    and returns a ratio of equal value. } 

  function natural_to_ratio (n: natural): ratio;

  { Given any integer, the integer_to_ratio function constructs and
    returns a ratio of equal value. }

  function integer_to_ratio (n: integer): ratio;

  { Given any non-negative ratio, the round_ratio_to_natural function
    returns the natural number of most nearly equal value.  If the ratio is
    exactly halfway between two natural numbers, this function returns
    whichever of them is even. }

  function round_ratio_to_natural (r: ratio): natural;

  { Given any ratio, the round_ratio_to_integer function returns the
    integer of most nearly equal value.  If the ratio is exactly halfway
    between two natural numbers, this function returns whichever of them is
    even.  This function presupposes that the value of its argument is
    neither greater than MAXINT nor less than MININT. }

  function round_ratio_to_integer (r: ratio): integer;

  { The string_to_ratio function determines and returns the ratio expressed
    by a given string.  (It presupposes that the string consists entirely
    of zero or more whitespace characters, an optional sign (+ or -), one
    or more decimal digits, and, optionally, a slash and one or more
    further decimal digits. }

  function string_to_ratio (var s: string): ratio;

  { Given any ratio, the ratio_to_string procedure constructs and returns
    the base-ten numeral for it: first, if the ratio is negative, a minus
    sign; then the numerator, with no leading zeroes or spaces (but the
    single digit '0' if the given ratio is 0/1); then a slash; and finally
    the denominator, again with no leading zeroes or spaces.  (The
    procedure presupposes that a sufficiently large string is provided.) }

  procedure ratio_to_string (r: ratio; var s: string);

  { The deallocate_ratio procedure frees all of the storage allocated for
    a given ratio and changes the value of its argument to NIL.  It
    presupposes that a ratio has been stored in r and not previously
    deallocated. } 

  procedure deallocate_ratio (var r: ratio);

implement

  $search 'stacks.o'$
  import
    stdinput, stdoutput, stderr, stacks;

    { The following constants are more or less arbitrary integers
      signifying various kinds of exceptions that can occur within this
      module. }

  const
    FIRST_EXCEPTION_CODE = 1;
    MAKE_EXCEPTION = 1;
    DIVISION_EXCEPTION = 2;
    RECIPROCAL_EXCEPTION = 3;
    END_OF_FILE_EXCEPTION = 4;
    NO_DIGITS_READ_EXCEPTION = 5;
    MISSING_DENOMINATOR_EXCEPTION = 6;
    NATURAL_EXCEPTION = 7;
    INTEGER_OVERFLOW_EXCEPTION = 8;
    STRING_EXCEPTION = 9;
    STRING_OVERFLOW_EXCEPTION = 10;
    EXCEPTION_EXCEPTION = 11;
    LAST_EXCEPTION_CODE = EXCEPTION_EXCEPTION;

    { The structure used to represent a ratio consists of a sign, a
      numerator, and a denominator.  The numerator and the denominator
      are natural numbers, and it is an invariant of this module that
      in every ratio that is released, the numerator and denominator
      are relatively prime.  Also, the denominator is never zero. }

  type
    ratio_structure = record
                        sign: signum;
                        numerator: natural;
                        denominator: natural
                      end;

  { The ratio_handler procedure is invoked whenever one of the
    preconditions for the successful execution of a procedure is found to
    be false.  It prints out an appropriate explanation of the exception
    just before the program is halted. } 

  procedure ratio_handler (exception_code: integer);
  begin
    if (exception_code < FIRST_EXCEPTION_CODE) or
           (LAST_EXCEPTION_CODE < exception_code) then
      exception_code := EXCEPTION_EXCEPTION;
    write (stderr, 'Exception #', exception_code : 1,
           ' in module RATIOS: ');
    case exception_code of
      DIVISION_EXCEPTION:
        writeln (stderr, 'division by zero attempted in procedure ',
                 'RATIO_QUOTIENT or procedure RATIO_SCALE_DOWN');
      RECIPROCAL_EXCEPTION:
        writeln (stderr, 'zero argument to procedure RATIO_RECIPROCAL');
      END_OF_FILE_EXCEPTION:
        writeln (stderr, 'unexpected end of file encountered in ',
                 'procedure READ_RATIO');
      NO_DIGITS_READ_EXCEPTION:
        writeln (stderr, 'attempt to read non-numeral in procedure ',
                 'READ_RATIO');
      MISSING_DENOMINATOR_EXCEPTION:
        writeln (stderr, 'denominator absent from fraction in procedure ',
                 'READ_RATIO');
      NATURAL_EXCEPTION:
        writeln (stderr, 'negative argument to procedure ',
                 'ROUND_RATIO_TO_NATURAL');
      INTEGER_OVERFLOW_EXCEPTION:
        writeln (stderr, 'argument out of range in procedure ',
                 'ROUND_RATIO_TO_INTEGER');
      STRING_EXCEPTION:
        writeln (stderr, 'non-numeral presented as argument to function ',
                 'STRING_TO_RATIO');
      STRING_OVERFLOW_EXCEPTION:
        writeln (stderr, 'out of room in string argument to procedure ',
                 'RATIO_TO_STRING');
      EXCEPTION_EXCEPTION:
        writeln (stderr, 'argument out of range in procedure ',
                 'RATIO_HANDLER.');
    end
  end;

  { The build_ratio function allocates storage for a ratio and initializes
    its fields with the specified values, allocating fresh storage for
    the numerator and denominator if the value of the parameter ut
    (``use or throw out'') is FALSE, but using the given storage if it is
    TRUE.  This function presupposes that d is non-zero and that n and d
    are relatively prime. }

  function build_ratio (s: signum; n: natural; d: natural; ut: Boolean):
    ratio;  
  var
    result: ratio;
      { a pointer to the newly allocated record }
  begin
    new (result);
    if is_zero (n) then
      result^.sign := non_negative
    else
      result^.sign := s;
    if ut then begin
      result^.numerator := n;
      result^.denominator := d
    end
    else begin
      assign (result^.numerator, n);
      assign (result^.denominator, d)
    end;
    build_ratio := result
  end;

  { The gcd function finds and returns the greatest common divisor of any
    two natural numbers, using Euclid's algorithm.  If either of its
    arguments is zero, the function returns the other argument. }

  function gcd (first, second: natural): natural;
  var
    primus, secundus: natural;
      { initially copies of first and second, but decreasing towards the
        greatest common divisor and zero, respectively }
    rest: natural;
      { the remainder after a trial division }
  begin
    assign (primus, first);
    assign (secundus, second);
    while not is_zero (secundus) do begin
      rest := remainder (primus, secundus);
      deallocate_natural (primus);
      primus := secundus;
      secundus := rest
    end;
    deallocate_natural (secundus);
    gcd := primus
  end;

  { The build_and_reduce function constructs and returns a ratio having
    the specified sign and an absolute value is equal to the quotient of n 
    and d.  Unlike build_ratio, it does not assume that n and d are
    relatively prime, though it does presuppose that d is not zero. }

  function build_and_reduce (s: signum; n: natural; d: natural;
                             ut: Boolean): ratio; 
  var
    common: natural;
      { the greatest common divisor of n and d }
    one: natural;
      { 1, as a natural number }
  begin
    common := gcd (n, d);
    one := integer_to_natural (1);
    if equal (common, one) then
      build_and_reduce := build_ratio (s, n, d, ut)
    else begin
      build_and_reduce := build_ratio (s, quotient (n, common),
                                       quotient (d, common), TRUE);
      if ut then begin
        deallocate_natural (n);
        deallocate_natural (d)
      end
    end;
    deallocate_natural (common);
    deallocate_natural (one)
  end;

  { The opposite function returns the sign opposite to any given sign. }

  function opposite (s: signum): signum;
  begin
    case s of
    negative:
      opposite := non_negative;
    non_negative:
      opposite := negative
    end
  end;

  { The skip_white_space procedure advances through a text file until
    a non-whitespace character (or the end of the file) is encountered. }

  procedure skip_white_space (var source: text);
  const
    TAB = #I;
    NEWLINE = #J;
    VERTICAL_TAB = #K;
    FORMFEED = #L;
    RETURN = #M;
    SPACE = #32;
  var
    finished: Boolean;
      { indicates whether it is necessary to keep looking for white space
        to skip }
  begin
    finished := FALSE;
    while not finished do
      if eof (source) then
        finished := TRUE
      else if source^ in [TAB, NEWLINE, VERTICAL_TAB, FORMFEED, RETURN,
                          SPACE] then
        get (source)
      else
        finished := TRUE
  end;

  function make_ratio (s: signum; n, d: natural): ratio;
  begin
    assert (not is_zero (d), MAKE_EXCEPTION, ratio_handler);
    make_ratio := build_and_reduce (s, n, d, FALSE)
  end;

  function ratio_numerator (r: ratio): natural;
  var
    result: natural;
  begin
    assign (result, r^.numerator);
    ratio_numerator := result
  end;

  function ratio_denominator (r: ratio): natural;
  var
    result: natural;
  begin
    assign (result, r^.denominator);
    ratio_denominator := result
  end;

  function ratio_negative (negand: ratio): ratio;
  begin
    if (negand^.sign = negative) or is_zero (negand^.numerator) then
      ratio_negative := build_ratio (non_negative, negand^.numerator,
                                     negand^.denominator, FALSE)
    else
      ratio_negative := build_ratio (negative, negand^.numerator,
                                     negand^.denominator, FALSE)
  end;

  function ratio_abs (r: ratio): ratio;
  begin
    ratio_abs := build_ratio (non_negative, r^.numerator, r^.denominator,
                              FALSE)
  end;

  function is_negative_ratio (given: ratio): Boolean;
  begin
    is_negative_ratio := (given^.sign = negative)
  end;

  function is_zero_ratio (given: ratio): Boolean;
  begin
    is_zero_ratio := is_zero (given^.numerator)
  end;

  function is_positive_ratio (given: ratio): Boolean;
  begin
    is_positive_ratio := (given^.sign = non_negative) and
                         not is_zero (given^.numerator)
  end;

  function ratio_sum (augend, addend: ratio): ratio;
  var
    ad, bc, bd: natural;
      { a/b + c/d = (ad + bc) / bd }
  begin
    ad := product (augend^.numerator, addend^.denominator);
    bc := product (augend^.denominator, addend^.numerator);
    bd := product (augend^.denominator, addend^.denominator);
    if augend^.sign = addend^.sign then
      ratio_sum := build_and_reduce (augend^.sign, sum (ad, bc), bd, TRUE)
    else if less (ad, bc) then
      ratio_sum := build_and_reduce (addend^.sign, difference (bc, ad), bd,
                                     TRUE)
    else if less (bc, ad) then
      ratio_sum := build_and_reduce (augend^.sign, difference (ad, bc), bd,
                                     TRUE)
    else begin
      deallocate_natural (bd);
      ratio_sum := build_ratio (non_negative, integer_to_natural (0),
                                integer_to_natural (1), TRUE)
    end;
    deallocate_natural (ad);
    deallocate_natural (bc)
  end;

  function ratio_difference (minuend, subtrahend: ratio): ratio;
  var
    ad, bc, bd: natural;
      { a/b - c/d = (ad - bc) / bd }
  begin
    ad := product (minuend^.numerator, subtrahend^.denominator);
    bc := product (minuend^.denominator, subtrahend^.numerator);
    bd := product (minuend^.denominator, subtrahend^.denominator);
    if minuend^.sign <> subtrahend^.sign then
      ratio_difference := build_and_reduce (minuend^.sign, sum (ad, bc),
                                            bd, TRUE)
    else if less (ad, bc) then
      ratio_difference := build_and_reduce (opposite (minuend^.sign),
                                            difference (bc, ad), bd, TRUE)
    else if less (bc, ad) then
      ratio_difference := build_and_reduce (minuend^.sign,
                                            difference (ad, bc), bd, TRUE)
    else begin
      deallocate_natural (bd);
      ratio_difference := build_ratio (non_negative,
                                       integer_to_natural (0), 
                                       integer_to_natural (1), TRUE)
    end;
    deallocate_natural (ad);
    deallocate_natural (bc)
  end;

  function ratio_product (multiplicand, multiplier: ratio): ratio;
  begin
    if (multiplicand^.sign = multiplier^.sign) or
       is_zero (multiplicand^.numerator) or
       is_zero (multiplier^.numerator) then
      ratio_product :=
        build_and_reduce(non_negative,
                         product (multiplicand^.numerator,
                                  multiplier^.numerator),
                         product (multiplicand^.denominator,
                                  multiplier^.denominator),
                         TRUE)
    else
      ratio_product :=
        build_and_reduce(negative,
                         product (multiplicand^.numerator,
                                  multiplier^.numerator),
                         product (multiplicand^.denominator,
                                  multiplier^.denominator),
                         TRUE)
  end;

  function ratio_quotient (dividend, divisor: ratio): ratio;
  begin
    assert (not is_zero (divisor^.numerator), DIVISION_EXCEPTION,
            ratio_handler);
    if (dividend^.sign = divisor^.sign) or
       is_zero (dividend^.numerator) then
      ratio_quotient :=
        build_and_reduce(non_negative,
                         product (dividend^.numerator,
                                  divisor^.denominator),
                         product (dividend^.denominator,
                                  divisor^.numerator),
                         TRUE)
    else
      ratio_quotient :=
        build_and_reduce(negative,
                         product (dividend^.numerator,
                                  divisor^.denominator),
                         product (dividend ^.denominator,
                                  divisor^.numerator),
                         TRUE)
  end;

  function ratio_power (base: ratio; exponent: natural): ratio;
  begin
    if is_odd (exponent) then
      ratio_power := build_ratio (base^.sign,
                                  power (base^.numerator, exponent),
                                  power (base^.denominator, exponent),
                                  TRUE)
    else
      ratio_power := build_ratio (non_negative,
                                  power (base^.numerator, exponent),
                                  power (base^.denominator, exponent),
                                  TRUE)
  end;

  function ratio_twice (given: ratio): ratio;
  var
    result: ratio;
      { the newly allocated ratio, twice as large as the given one }
  begin
    new (result);
    result^.sign := given^.sign;
    if is_even (given^.denominator) then begin
      assign (result^.numerator, given^.numerator);
      result^.denominator := half (given^.denominator)
    end
    else begin
      result^.numerator := twice (given^.numerator);
      assign (result^.denominator, given^.denominator)
    end;
    ratio_twice := result
  end;

  function ratio_half (given: ratio): ratio;
  var
    result: ratio;
      { the newly allocated ratio, half as large as the given one }
  begin
    new (result);
    result^.sign := given^.sign;
    if is_even (given^.numerator) then begin
      result^.numerator := half (given^.numerator);
      assign (result^.denominator, given^.denominator)
    end
    else begin
      assign (result^.numerator, given^.numerator);
      result^.denominator := twice (given^.denominator)
    end;
    ratio_half := result
  end;

  function ratio_square (given: ratio): ratio;
  begin
    ratio_square := build_ratio (non_negative, square (given^.numerator),
                                 square (given^.denominator), TRUE)
  end;

  function ratio_cube (given: ratio): ratio;
  begin
    ratio_cube := build_ratio (given^.sign, cube (given^.numerator),
                               cube (given^.denominator), TRUE)
  end;

  function ratio_reciprocal (given: ratio): ratio;
  begin
    assert (not is_zero (given^.numerator), RECIPROCAL_EXCEPTION,
            ratio_handler);
    ratio_reciprocal := build_ratio (given^.sign, given^.denominator,
                                     given^.numerator, FALSE)
  end;

  procedure ratio_increment (var given: ratio; amount: ratio);
  var
    old_numerator, old_denominator: natural;
      { the original numerator and denominator of `given' }
  begin
    old_numerator := given^.numerator;
    old_denominator := given^.denominator;
    given := ratio_sum (given, amount);
    deallocate_natural (old_numerator);
    deallocate_natural (old_denominator)
  end;

  procedure ratio_decrement (var given: ratio; amount: ratio);
  var
    old_numerator, old_denominator: natural;
      { the original numerator and denominator of `given' }
  begin
    old_numerator := given^.numerator;
    old_denominator := given^.denominator;
    given := ratio_difference (given, amount);
    deallocate_natural (old_numerator);
    deallocate_natural (old_denominator)
  end;

  procedure ratio_scale_up (var given: ratio; scale: ratio);
  var
    old_numerator, old_denominator: natural;
      { the original numerator and denominator of `given' }
  begin
    old_numerator := given^.numerator;
    old_denominator := given^.denominator;
    given := ratio_product (given, scale);
    deallocate_natural (old_numerator);
    deallocate_natural (old_denominator)
  end;

  procedure ratio_scale_down (var given: ratio; scale: ratio);
  var
    old_numerator, old_denominator: natural;
      { the original numerator and denominator of `given' }
  begin
    assert (not is_zero (scale^.numerator), DIVISION_EXCEPTION,
            ratio_handler);
    old_numerator := given^.numerator;
    old_denominator := given^.denominator;
    given := ratio_quotient (given, scale);
    deallocate_natural (old_numerator);
    deallocate_natural (old_denominator)
  end;

  procedure ratio_double (var given: ratio);
  begin
    if is_even (given^.denominator) then
      halve (given^.denominator)
    else
      double (given^.numerator)
  end;

  procedure ratio_halve (var given: ratio);
  begin
    if is_even (given^.numerator) then
      halve (given^.numerator)
    else
      double (given^.denominator)
  end;

  function ratio_less (first, second: ratio): Boolean;
  var
    ad, bc: natural;
  begin
    if first^.sign = second^.sign then begin
      ad := product (first^.numerator, second^.denominator);
      bc := product (first^.denominator, second^.numerator);
      case first^.sign of
      negative:
        ratio_less := less (bc, ad);
      non_negative:
        ratio_less := less (ad, bc);
      end;
      deallocate_natural (ad);
      deallocate_natural (bc)
    end
    else
      ratio_less := (first^.sign = negative)
  end;

  function ratio_equal (first, second: ratio): Boolean;
  var
    ad, bc: natural;
  begin
    if (first^.sign = second^.sign) then begin
      ad := product (first^.numerator, second^.denominator);
      bc := product (first^.denominator, second^.numerator);
      ratio_equal := equal (ad, bc);
      deallocate_natural (ad);
      deallocate_natural (bc)
    end
    else
      ratio_equal := FALSE
  end;

  function ratio_greater (first, second: ratio): Boolean;
  var
    ad, bc: natural;
  begin
    if (first^.sign = second^.sign) then begin
      ad := product (first^.numerator, second^.denominator);
      bc := product (first^.denominator, second^.numerator);
      case first^.sign of
      negative:
        ratio_greater := greater (bc, ad);
      non_negative:
        ratio_greater := greater (ad, bc);
      end;
      deallocate_natural (ad);
      deallocate_natural (bc)
    end
    else
      ratio_greater := (first^.sign = non_negative)
  end;

  function ratio_not_less (first, second: ratio): Boolean;
  var
    ad, bc: natural;
  begin
    if (first^.sign = second^.sign) then begin
      ad := product (first^.numerator, second^.denominator);
      bc := product (first^.denominator, second^.numerator);
      case first^.sign of
      negative:
        ratio_not_less := not_less (bc, ad);
      non_negative:
        ratio_not_less := not_less (ad, bc);
      end;
      deallocate_natural (ad);
      deallocate_natural (bc)
    end
    else
      ratio_not_less := (first^.sign = non_negative)
  end;

  function ratio_not_equal (first, second: ratio): Boolean;
  var
    ad, bc: natural;
  begin
    if (first^.sign = second^.sign) then begin
      ad := product (first^.numerator, second^.denominator);
      bc := product (first^.denominator, second^.numerator);
      ratio_not_equal := not_equal (ad, bc);
      deallocate_natural (ad);
      deallocate_natural (bc)
    end
    else
      ratio_not_equal := TRUE
  end;

  function ratio_not_greater (first, second: ratio): Boolean;
  var
    ad, bc: natural;
  begin
    if (first^.sign = second^.sign) then begin
      ad := product (first^.numerator, second^.denominator);
      bc := product (first^.denominator, second^.numerator);
      case first^.sign of
      negative:
        ratio_not_greater := not_greater (bc, ad);
      non_negative:
        ratio_not_greater := not_greater (ad, bc);
      end;
      deallocate_natural (ad);
      deallocate_natural (bc)
    end
    else
      ratio_not_greater := (first^.sign = negative)
  end;

  function ratio_max (first, second: ratio): ratio;
  var
    result: ratio;
      { the greater of the ratios }
  begin
    if ratio_not_less (first, second) then
      ratio_assign (result, first)
    else
      ratio_assign (result, second);
    ratio_max := result
  end;

  function ratio_min (first, second: ratio): ratio;
  var
    result: ratio;
      { the lesser of the ratios }
  begin
    if ratio_not_greater (first, second) then
      ratio_assign (result, first)
    else
      ratio_assign (result, second);
    ratio_min := result
  end;

  procedure read_ratio (var source: text; var legendum: ratio);
  var
    s: signum;
      { the sign of the ratio, as recovered from the source file }
    n, d: natural;
      { the numerator and denominator of the ratio, as recovered from
        the source file }
    slash: Boolean;
      { indicates whether there is a slash after the numerator,
        presumably followed by an explicit denominator }
  begin
    skip_white_space (source);
    assert (not eof (source), END_OF_FILE_EXCEPTION, ratio_handler);

    { Recover the sign of the ratio. }

    if source^ = '-' then begin
      s := negative;
      get (source);
      assert (not eof (source), END_OF_FILE_EXCEPTION, ratio_handler);
    end
    else if source^ = '+' then begin
      s := non_negative;
      get (source);
      assert (not eof (source), END_OF_FILE_EXCEPTION, ratio_handler)
    end
    else
      s := non_negative;

    { Read in the numerator. }

    assert (('0' <= source^) and (source^ <= '9'),
            NO_DIGITS_READ_EXCEPTION, ratio_handler);
    read_natural (source, n);

    { Deal with the slash, if it is present. }

    if eof (source) then
      slash := FALSE
    else
      slash := (source^ = '/');
    if slash then begin

      { Read in the denominator. }
      get (source);
      assert (not eof (source), END_OF_FILE_EXCEPTION, ratio_handler);
      assert (('0' <= source^) and (source^ <= '9'),
              MISSING_DENOMINATOR_EXCEPTION, ratio_handler);
      read_natural (source, d)

    end
    else
      d := integer_to_natural (1);

    if is_zero (n) then
      s := non_negative;
    legendum := build_and_reduce (s, n, d, TRUE)
  end;

  procedure input_ratio (var legendum: ratio);
  begin
    read_ratio (input, legendum)
  end;

  procedure write_ratio (var target: text; scribendum: ratio);
  begin
    if scribendum^.sign = negative then
      write (target, '-');
    write_natural (target, scribendum^.numerator);
    write (target, '/');
    write_natural (target, scribendum^.denominator)
  end;

  procedure output_ratio (scribendum: ratio);
  begin
    write_ratio (output, scribendum)
  end;

  procedure output_ratio_to_standard_error (scribendum: ratio);
  begin
    write_ratio (stderr, scribendum)
  end;

  procedure ratio_assign (var target: ratio; source: ratio);
  begin
    new (target);
    target^.sign := source^.sign;
    assign (target^.numerator, source^.numerator);
    assign (target^.denominator, source^.denominator)
  end;

  function natural_to_ratio (n: natural): ratio;
  var
    result: ratio;
  begin
    new (result);
    result^.sign := non_negative;
    assign (result^.numerator, n);
    result^.denominator := integer_to_natural (1);
    natural_to_ratio := result
  end;

  function integer_to_ratio (n: integer): ratio;
  var
    s: signum;
      { the sign of n, and hence of the ratio }
    numer: natural;
      { the numerator of the ratio }
  begin
    if n = MININT then begin
      s := negative;
      numer := integer_to_natural (MAXINT);
      up1 (numer)
    end
    else begin
      if n < 0 then
        s := negative
      else
        s := non_negative;
      numer := integer_to_natural (abs (n))
    end;
    integer_to_ratio := build_ratio (s, numer, integer_to_natural (1), TRUE)
  end;

  function round_ratio_to_natural (r: ratio): natural;
  var
    quot, rem: natural;
      { the quotient and remainder, respectively, when the numerator of the
        ratio is divided by its denominator }
  begin
    assert (r^.sign = non_negative, NATURAL_EXCEPTION, ratio_handler);
    divide (r^.numerator, r^.denominator, quot, rem);
    double (rem);
    if less (r^.denominator, rem) or
       (equal (r^.denominator, rem) and is_odd (quot)) then
      up1 (quot);
    round_ratio_to_natural := quot;
    deallocate_natural (rem)
  end;

  function round_ratio_to_integer (r: ratio): integer;
  const
    VALUE_BITS_IN_INTEGER = 31;
      { the number of bits in the representation of an integer, not
        counting the sign bit }
  var
    original_sign: signum;
      { the sign of the ratio, and hence of the integer }
    rounded: natural;
      { the natural number nearest to the absolute value of the ratio }
    bit_counter: integer;
      { counts off the value bits in the representation of an integer }
    power_of_two: integer;
      { a power of two, to be added to the absolute value of the integer
        to be returned }
    result: integer;
      { the absolute value of the integer to be returned, computed one bit
        at a time }
  begin
    original_sign := r^.sign;
    r^.sign := non_negative;
    rounded := round_ratio_to_natural (r);
    r^.sign := original_sign;
    bit_counter := 0;
    result := 0;
    power_of_two := 1;
    while (bit_counter < VALUE_BITS_IN_INTEGER) and
          not is_zero (rounded) do begin
      if is_odd (rounded) then
         result := result + power_of_two;
      halve (rounded);
      if bit_counter <> VALUE_BITS_IN_INTEGER - 1 then
        power_of_two := power_of_two * 2;
      bit_counter := bit_counter + 1
    end;
    if (result = 0) and (original_sign = negative) then begin
      down1 (rounded);
      assert (is_zero (rounded), INTEGER_OVERFLOW_EXCEPTION,
              ratio_handler);
      round_ratio_to_integer := MININT
    end
    else begin
      assert (is_zero (rounded), INTEGER_OVERFLOW_EXCEPTION,
              ratio_handler);
      case original_sign of
      negative:
        round_ratio_to_integer := -result;
      non_negative:
        round_ratio_to_integer := result
      end
    end;
    deallocate_natural (rounded)
  end;

  function string_to_ratio (var s: string): ratio;
  const
    TAB = #I;
    NEWLINE = #J;
    VERTICAL_TAB = #K;
    FORMFEED = #L;
    RETURN = #M;
    SPACE = #32;
  var
    position: integer;
      { counts off positions in the source string }
    len: integer;
      { the length of the source string }
    sg: signum;
      { the sign of the ratio, as recovered from the string }
    ten: natural;
      { 10, as a natural number }
    n, d: natural;
      { the numerator and denominator of the fraction, as recovered from
        the string }
    digit: natural;
      { one digit at a time, recovered from a single character of the
        string }
    finished: Boolean;
      { indicates whether it is necessary to keep looking for digits to
        include in a natural number } 
    slash: Boolean;
      { indicates whether a slash is present in the string }
  begin
    position := 0;
    len := strlen (s);

    { Skip past white space. }

    repeat
      position := position + 1;
      assert (position <= len, STRING_EXCEPTION, ratio_handler)
    until not (s[position] in [TAB, NEWLINE, VERTICAL_TAB, FORMFEED,
                               RETURN, SPACE]);

    { Recover any explicit sign. }

    if s[position] = '-' then begin
      sg := negative;
      position := position + 1;
      assert (position <= len, STRING_EXCEPTION, ratio_handler)
    end
    else if s[position] = '+' then begin
      sg := non_negative;
      position := position + 1;
      assert (position <= len, STRING_EXCEPTION, ratio_handler)
    end
    else
      sg := non_negative;

    { Collect the numerator of the fraction. }

    assert (('0' <= s[position]) and (s[position] <= '9'),
            STRING_EXCEPTION, ratio_handler);
    ten := integer_to_natural (10);
    n := integer_to_natural (0);
    finished := FALSE;
    while not finished do
      if ('0' <= s[position]) and (s[position] <= '9') then begin
        scale_up (n, ten);
        digit := integer_to_natural (ord (s[position]) - ord ('0'));
        increment (n, digit);
        deallocate_natural (digit);
        position := position + 1;
        finished := (len < position)
      end
      else
        finished := TRUE;

    { Deal with the slash, if it is present. }

    if (len < position) then
      slash := FALSE
    else
      slash := (s[position] = '/');

    if slash then begin

      { Collect the denominator of the fraction. }

      position := position + 1;
      assert (position <= len, STRING_EXCEPTION, ratio_handler);
      assert (('0' <= s[position]) and (s[position] <= '9'),
              STRING_EXCEPTION, ratio_handler);
      d := integer_to_natural (0);
      finished := FALSE;
      while not finished do
        if ('0' <= s[position]) and (s[position] <= '9') then begin
          scale_up (d, ten);
          digit := integer_to_natural (ord (s[position]) - ord ('0'));
          increment (d, digit);
          deallocate_natural (digit);
          position := position + 1;
          finished := (len < position)
        end
        else
          finished := TRUE;

    end
    else { The default denominator is 1. }
      d := integer_to_natural (1);

    deallocate_natural (ten);
    assert (position = len + 1, STRING_EXCEPTION, ratio_handler);
    if is_zero (n) then
      sg := non_negative;
    string_to_ratio := build_and_reduce (sg, n, d, TRUE)
  end;

  procedure ratio_to_string (r: ratio; var s: string);

    procedure append_natural (n: natural; var s: string);
    var
      len: integer;
        { the actual length of the string s }
      max: integer;
        { the maximum length of the string s }
      ten: natural;
        { 10, as a natural number }
      digits: stack;
        { a stack containing the digits of the decimal representation
          of n, from least significant at the bottom to most significant
          at the top }
      rest: natural;
        { initially, a copy of n; later on, the quotient on division of
          n by some power of ten }
      quot, rem: natural;
        { the quotient and remainder obtained by dividing rest by ten }
    begin
      len := strlen (s);
      max := strmax (s);
      ten := integer_to_natural (10);
      initialize_stack (digits);
      assign (rest, n);
      repeat
        divide (rest, ten, quot, rem);
        push_to_stack (natural_to_integer (rem), digits);
        deallocate_natural (rem);
        deallocate_natural (rest);
        rest := quot
      until is_zero (rest);
      deallocate_natural (ten);
      while not is_empty_stack (digits) do begin
        len := len + 1;
        assert (len <= max, STRING_OVERFLOW_EXCEPTION, ratio_handler);
        setstrlen (s, len);
        s[len] := chr (ord ('0') + pop_stack (digits))
      end;
    end;

  begin { procedure ratio_to_string }
    s := '';
    if r^.sign = negative then
      strappend (s, '-');
    append_natural (r^.numerator, s);
    strappend (s, '/');
    append_natural (r^.denominator, s)
  end;

  procedure deallocate_ratio (var r: ratio);
  begin
    deallocate_natural (r^.numerator);
    deallocate_natural (r^.denominator);
    dispose (r);
    r := NIL
  end;

end.