DataMuseum.dk

top - metrics - download

    Length: 7283 (0x1c73)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with System;
with Universal_Integer_Arithmetic;
use Universal_Integer_Arithmetic;
package body Universal_Real_Arithmetic is

    --    I_Zero : constant Universal_Integer := Ui (Integer'(0));
    --    I_One  : constant Universal_Integer := Ui (Integer'(1));
    --    I_Two  : constant Universal_Integer := Ui (Integer'(2));
    --    I_Ten  : constant Universal_Integer := Ui (Integer'(10));

    --    R_Zero : constant Universal_Real := (I_Zero, I_One);
    --    R_One  : constant Universal_Real := (I_One, I_One);

    function "&" (L, R : System.Byte_String) return System.Byte_String
        renames System."&";
    function "&" (L : System.Byte; R : System.Byte_String)
                 return System.Byte_String renames System."&";

    function R_Zero return Universal_Real is
    begin
        return (I_Zero, I_One);
    end R_Zero;

    function R_One return Universal_Real is
    begin
        return (I_One, I_One);
    end R_One;



    function Ur (N, D : Universal_Integer) return Universal_Real is

        -- Constructs a universal real as the ration of two universal integers.
        -- The value of d must not be ZERO; if it is NUMERIC_ERROR is raised.

        -- Every real number produced as a result of an operation defined in
        -- this package must have a positive denominator and the numerator and
        -- denominator must be reduced to lowest terms.  This ensures uniqueness
        -- of the representation.

        R : Universal_Integer;
        Y : Universal_Integer;
        Z : Universal_Integer;

    begin
        if Eql (D, I_Zero) then
            raise Numeric_Error;
        elsif Eql (N, I_Zero) then
            return R_Zero;
        elsif Eql (N, I_One) or else Eql (D, I_One) then
            if D < I_Zero then
                return (-N, -D);
            else
                return (N, D);
            end if;
        end if;

        -- Now reduce to lowest terms; that is, find the gcd of n and d.

        Y := abs N;
        Z := abs D;

        loop
            R := Y rem Z;
            exit when Eql (R, I_Zero);
            Y := Z;
            Z := R;
        end loop;

        if D >= I_Zero then
            return (N / Z, D / Z);
        else
            return (-N / Z, -D / Z);
        end if;
    end Ur;



    function Ui (X : Universal_Real) return Universal_Integer is
        I : Universal_Integer := X.Num / X.Den;
        R : Universal_Real := (I, I_One);
        H : Universal_Real := (I_One, I_Two);
    begin
        if Eql (X.Num, I_Zero) then
            return I_Zero;
        elsif X.Num < I_Zero and then X - R <= -H then
            return I - I_One;
        elsif X.Num > I_Zero and then X - R >= H then
            return I + I_One;
        else
            return I;
        end if;
    end Ui;

    function Ur (X : Universal_Integer) return Universal_Real is
    begin
        return (X, I_One);
    end Ur;

    function Ur (X : Integer) return Universal_Real is
    begin
        return Ur (Ui (X));
    end Ur;

    function Ur (X : Long_Integer) return Universal_Real is
    begin
        return Ur (Ui (X));
    end Ur;

    function Ur (X : Float) return Universal_Real is
    begin
        return Ur (Ui (Long_Integer (X)));
    end Ur;

    function Ur (N, D : Integer) return Universal_Real is
    begin
        return Ur (Ui (N), Ui (D));
    end Ur;


    function Ur (N, D : Long_Integer) return Universal_Real is
    begin
        return Ur (Ui (N), Ui (D));
    end Ur;

    function Numerator (X : Universal_Real) return Universal_Integer is
    begin
        return X.Num;
    end Numerator;

    function Denominator (X : Universal_Real) return Universal_Integer is
    begin
        return X.Den;
    end Denominator;



    function "-" (X : Universal_Real) return Universal_Real is
    begin
        return (-X.Num, X.Den);
    end "-";

    function "abs" (X : Universal_Real) return Universal_Real is
    begin
        return (abs X.Num, X.Den);
    end "abs";

    function "*" (X : Universal_Integer; Y : Universal_Real)
                 return Universal_Real is
    begin
        return Ur (Y.Num * X, Y.Den);
    end "*";

    function "*" (X : Universal_Real; Y : Universal_Integer)
                 return Universal_Real is
    begin
        return Ur (X.Num * Y, X.Den);
    end "*";

    function "/" (X : Universal_Real; Y : Universal_Integer)
                 return Universal_Real is
    begin
        return Ur (X.Num, X.Den * Y);
    end "/";

    function "+" (X, Y : Universal_Real) return Universal_Real is
    begin
        return Ur (X.Num * Y.Den + Y.Num * X.Den, X.Den * Y.Den);
    end "+";

    function "-" (X, Y : Universal_Real) return Universal_Real is
    begin
        return X + (-Y);
    end "-";

    function "*" (X, Y : Universal_Real) return Universal_Real is
    begin
        return Ur (X.Num * Y.Num, X.Den * Y.Den);
    end "*";

    function "/" (X, Y : Universal_Real) return Universal_Real is
    begin
        return Ur (X.Num * Y.Den, X.Den * Y.Num);
    end "/";

    function "**" (X : Universal_Real; Y : Integer) return Universal_Real is
    begin
        if Y = 0 then
            return R_One;
        elsif Y > 0 then
            return Ur (X.Num ** Y, X.Den ** Y);
        else
            return Ur (X.Den ** (-Y), X.Num ** (-Y));
        end if;
    end "**";


    function ">=" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num >= I_Zero;
    end ">=";

    function "<=" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num <= I_Zero;
    end "<=";

    function "<" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num < I_Zero;
    end "<";

    function ">" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num > I_Zero;
    end ">";

    function Eql (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Eql (Z.Num, I_Zero);
    end Eql;

    function Image (X : Integer) return System.Byte_String is
    begin
        if X < 128 then
            return (1 => System.Byte (X));
        else
            return System.Byte (128 + X rem 128) & Image (X / 128);
        end if;
    end Image;


    function Image (X : Universal_Real) return System.Byte_String is
        Num : constant System.Byte_String :=
           Universal_Integer_Arithmetic.Image (X.Num);
        Den : constant System.Byte_String :=
           Universal_Integer_Arithmetic.Image (X.Den);
    begin
        return Image (Num'Length) & Num & Den;
    end Image;


    function Value (S : System.Byte_String) return Universal_Real is
        L : Integer := 0;
        N : Integer;
        D : Integer := 1;
    begin
        for I in S'Range loop
            N := Integer (S (I));
            L := (N mod 128) * D + L;
            D := D * 128;

            if N < 128 then
                return (Universal_Integer_Arithmetic.Value (S (I + 1 .. I + L)),
                        Universal_Integer_Arithmetic.Value
                           (S (I + L + 1 .. S'Last)));
            end if;
        end loop;
    end Value;

end Universal_Real_Arithmetic;