_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); 
		...




