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

File List | 1988-08-22 | 12KB | 524 lines

_OBJECT-ORIENTED DIMENSIONAL UNITS_
by
John A. Grosbery



Listing One

package float_unit is
type class is new float;
units_error : exception;

function "*" (left,right : class) return class;
    -- This function is to overload the inherited
    -- multiply function. Multiplying two dimensioned
    -- numbers does not produce a number with the same
    -- units, so this is an invalid operation.  It will
    -- raise the units_error exception.

-- The following multiplication functions provide for
-- multiplying a non-dimensional number (float or
-- integer) times a dimensional number (class). There
-- are two of each (one with float first, one with
-- class first) to make the multiplication functions
-- commutative.

function "*" (left : float; right : class) return class;
function "*" (left : class; right : float) return class;

function "*" (left : integer; right : class)   return
class;
function "*" (left : class;   right : integer) return
class;

function "/" (left,right : class) return class;
    -- This function is to overload the inherited
    -- divide function. Dividing two dimensioned numbers
    -- does not produce a number with the same units, so
    -- this is an invalid operation.  It will raise the
    -- units_error exception.

function "/" (left, right : class) return float;
    -- This function divides two items of type class and
    -- returns the result as type float.  Dividing a
    -- dimensioned number by another of the same
    -- dimensioned produces a non-dimensional number.

-- The next two divide functions allow dividing a
-- dimensioned number by a non-dimensioned floating point
-- or integer number.  Doing so produces a result with
-- the same dimensions as the dimensioned number.

function "/" (left : class; right : float) return class;
function "/" (left : class; right : integer) return
class;

function "**" (left:class; right:integer) return class;
    -- This function is to overload the inherited
    -- exponentiation function. Exponentiating
    -- dimensioned numbers does not produce a
    -- number with the same units, so this is an
    -- invalid operation.  It will raise the
    -- units_error exception.

function image ( the_object :in class ) return string;
    -- This function will take the_object of type
    -- class and convert it to a string type.  The
    -- name "image" was chosen because the purpose of
    -- this function is similar to that of Ada's "image"
        -- attribute.  This function and the following
    -- decouple the units package from any input/output
    -- device or package.


function value (the_string :in string) return class;
    -- This function will take a string which is a valid
    -- representation of an object of the type class and
    -- convert it to the type class.  If the_string
    -- contains an invalid value, the constraint_error
    -- exception will be raised.  The name "value" was
    -- used because the purpose of this function is
    -- similar to Ada's "value" attribute.

end float_unit;

with text_io;

package body float_unit is
------------------------------------------------------------
function "*" (left,right : class) return class is
    -- This function is to hide the inherited multiply
    -- function. Multiplying two dimensioned numbers does
    -- not produce a number with the same units, so
    -- this is an invalid operation.  If this function
    -- is invoked, it will raise the units_error exception.

begin
    -- Whole function invalid; force exception:

    raise units_error;
    return left * right;

    -- Above return needed to satisfy compiler, but
    -- it will never be executed.
end "*";

function "*" (left : float; right : class) return class
is
begin
    return class(left * float(right));
end "*";


function "*" (left : class; right : float) return class
is
begin
    return class( float(left) * right );
end "*";

function "*" (left : integer; right : class)   return
class
is
begin
    return class( float(left) * right );
end "*";

function "*" (left : class;   right : integer) return
class
is
begin
    return class( left * float(right) );
end "*";

function "/" (left,right : class) return class
is
begin
    -- Whole function invalid; force exception:

    raise units_error;
    return class( float(left) / float(right));

    -- Above return needed to satisfy compiler, but
    -- it will never be executed.
end "/";

function "/" (left, right : class) return float
is
begin
    return float(left) / float(right);
end "/";

function "/" (left : class; right : float) return class
is
begin
    return class( float(left) / right);
end "/";

function "/" (left : class; right : integer) return class
is
begin
    return class( float(left) / float(right) );
end "/";

function "**" (left:class; right:integer) return class
is
begin
    raise units_error;
    return class( float(left) ** right);
end "**";

package fio is new text_io.float_io(class);
-- Fio will be needed by image and value, below.

function image ( the_object :in class ) return string
is
    buffer : string(1..14);
begin
    fio.put(buffer, the_object);
    return buffer;
end image;

function value (the_string :in string) return class
is
    buffer : class;
    last   : positive;
begin
    fio.get(the_string, buffer, last);
    return buffer;
end value;

end float_unit;




Listing Two

------------------------------------------------------------
with float_unit;

generic
    type class_a is digits<>;
    type class_b is digits <>;
package product_unit is

type class is new float_unit.class;

function "*"(left    : class_a;
            right    : class_b) return class;

function "*"(left    : class_b;
            right    : class_a) return class;

function "/"(left    : class;
            right    : class_a) return class_b;

function "/"(left    : class;
            right    : class_b) return class_a;

end product_unit;

package body product_unit is

function "*"(left    : class_a;
            right    : class_b) return class
is
begin
    return class(float(left) * float(right));
end "*";

function "*"(left    : class_b;
            right    : class_a) return class
is
begin
    return class(float(left) * float(right));
end "*";

function "/"(left    : class;
            right    : class_a) return class_b
is
begin
    return class_b(float(left) / float(right));
end "/";

function "/"(left    : class;
            right    : class_b) return class_a
is
begin
    return class_a(float(left) / float(right));
end "/";

end product_unit;



Listing Three
------------------------------------------------------------

with float_unit;

generic
    type numerator_class is digits <>;
    type denominator_class is digits <>;
package quotient_unit is

type class is new float_unit.class;

function "/"(left    : numerator_class;
                 right    : denominator_class
) return class;

function "*"(left    : class;
            right    : denominator_class
) return numerator_class;

function "*"(left    : denominator_class;
            right    : class
) return numerator_class;

end quotient_unit;

package body quotient_unit is

function "/"(left    : numerator_class;
            right    : denominator_class) return class
is
begin
    return class(float(left) / float(right));
end "/";

function "*"(left    : class;
            right    : denominator_class
) return numerator_class
is
begin
    return numerator_class(float(left) * float(right));
end "*";

function "*"(left    : denominator_class;
            right    : class
) return numerator_class
is
begin
    return numerator_class(float(left) * float(right));
end "*";

end quotient_unit;



Example 1: Using the form for a package construct


        package float_unit  is
            type class is new float;

            function"*"(left : float;
                    right: class
                ) return  class;

            function "/" (left: class;
                    right: float
                ) return class;

            -- etc...
        end float_unit;



Example 2: Creating objects of the hour glass

        with hour;  use hour;
        procedure time_card is
            -- Create the objects:
            hours_worked : hour.class;
            job_1 : hour.class;
            job_2 : hour.class;

        begin
            -- Give them each a value:
            job_1 := 8.0;
            job_2 := 5.5;
            hours_worked := job_1 + job_2;

        end time_card;



Example 3: Using the hour class and a new mile class to create
the mile_per_hour class

        with float_unit;
        package mile is new unit;

        with float_unit;
        with hour;
        with mile;

        package mile_per_hour is
            type class is new float_unit.class;

            function "/"(left : mile.class;
                          right: hour.class
                        ) return class;

        end mile_per_hour;


Example 4: Installing the specification and the body for the
packages listed in Example 2 and 3

        with hour;
        with mile;
        with quotient_unit;

        package mile_per_hour is new quotient_unit(
            numerator_class => mile.class,
            denominator_class => hour.class);


Example 5: Creating new composite units by applying an existing
generic package as many times as necessary. In this case, a
package for cubic feet is created from miles/hour.

        with unit;
        package foot is new unit;

        with foot;
        with product_unit;
        package square_foot is new product_unit(
            class_a => foot,
            class_b => foot);


        with foot;
        with square_foot;
        with product_unit;
        package cubic_foot is new product_unit(
            class_a => foot,
            class_b => square_foot);



Example 6: Converting routines to couple a package with other
packages

        with float_unit;
        with hour;
        with mile;
        with mile_per_second;

        package mile_per_hour is
            type class is new float_unit.class;

            function "/"(left  : mile.class;
                           right : hour.class
                    ) return class;


            function convert (mps :
                    miles_per_second.class
                    ) return class;
        end mile_per_hour;



Example 7: Modelling relationships on objects


        with mile_per_hour;
        with mile_per_second;
        package mph_mps_convert  is

            function relation(mph :
                        mile_per_hour.class)
                return mile_per_second.class;

            function relation(mps :
                        mile_per_second.class)
                return mile_per_hour.class;
        end mph_mps_convert;


Example 8: Generalizing relationship objects for dimensional unit
applications by creating a class that provides functions to go
both ways. This generalization process is implemented as a
generic package that imports the conversion factor and the two
objects that are to be related.


        generic
            -- Import one kind of class:
            type class_a is digits <>;
            -- Import the other kind:
            type class_b is digits <>;
                         -- Import the conversion factor
            a_to_b_factor : in float := 1.0;
        package class_a_class_b_convert is

            function relation (a : class_a
                    ) return class_b;


            function relation (b : class_b
                    ) return class_a;

        end class_a_class_b_convert;


        package body class_a_class_b_convert is

            function relation (a : class_a
                    ) return class_b
            is
            begin
                return class_b(float(a) *
                            a_to_b_factor);
            end relation;


            function relation (b : class_b
                    ) return class_a;
            is
            begin
                return class_a(float(b) /
                         a_to_b_factor);
            end relation;

        end class_a_class_b_convert;



Example 9: Using the relationship objects described in Example 8


        with miles_per_hour;
        with miles_per_second;
        with class_a_class_b_convert;
        package mph_mps_convert is
                new class_a_class_b_convert(
            class_a => miles_per_hour.class,
            class_b => miles_per_second.class,
            a_to_b_factor => 3600.0);


Example 10: Code fragment showing the use of the mph_mps.convert
object created in Example 9 to convert 60 mile_per_hour into
mile_per_second


        with miles_per_hour;    use miles_per_hour;
        with miles_per_second;    use miles_per_second;
        with mph_mps_convert;
        ...
        mph : miles_per_hour.class := 60.0;
        mps  : miles_per_second.class;
        ...
        mps  := mph_mps_convert.relation(mph);
        ...