Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/piwg/z000020.ada

Text File | 1988-05-03 | 6.2 KB | 202 lines

-- The purpose of this package is to define an Ada type that has exactly
-- the operations that are valid for any physical quantity. This package
-- is then used by the packages that define many physical units. These
-- packages are used in turn by packages that define operators on physical
-- units that produce other physical units. Additional packages in this
-- set provide for outputting of physical units, conversions between
-- physical units, and other functions needed when working with physical
-- units.
--
-- Note: only this package needs to be generic, all other packages inherit
-- the type REAL from the package PHYSICAL_REAL.
--

generic

--         The formal generic parameter ANY_REAL will typically be
--         FLOAT or LONG_FLOAT but can be any Ada real type. This
--         type is to define the underlying computer arithmetic that
--         will be used to evaluate the physical equations.
--         ANY_REAL is a non dimensional quantity. It has no physical units.

  type ANY_REAL is digits <> ;

package GENERIC_PHYSICAL_REAL is

  type REAL is private ;

--                Operators available for all types derived from REAL
--
--     implicit :    :=    =     /=
--
--
--             Physical quantities with the same units can be added
--             preserving their physical units.

  function "+" ( LEFT , RIGHT : REAL ) return REAL ;

--             Physical quantities with the same units can be subtracted
--             preserving their physical units.

  function "-" ( LEFT , RIGHT : REAL ) return REAL ;

--             Multiplying a physical quantity by itself does not produce
--             the same physical quantity and thus must not be allowed.
--             Multiplying a physical quantity by a non dimensional quantity
--             does preserve the units of the physical quantity.

  function "*" ( LEFT : ANY_REAL ;
                 RIGHT : REAL ) return REAL ;

  function "*" ( LEFT : REAL ;
                 RIGHT : ANY_REAL ) return REAL ;

--             Dividing a physical quantity by a non dimensional quantity
--             preserves the units of the physical quantity.

  function "/" ( LEFT : REAL ;
                 RIGHT : ANY_REAL ) return REAL ;

--             Dividing a physical quantity by itself produces
--             a non dimensional value.

  function "/" ( LEFT , RIGHT : REAL ) return ANY_REAL ;

--               The absolute value of a physical quantity retains the
--               same physical units.

  function "abs" ( LEFT : REAL ) return REAL ;

--             Equality and inequality are implicitly defined. The other
--             relational operators must be explicitly defined.

  function "<" ( LEFT , RIGHT : REAL ) return BOOLEAN ;

  function ">" ( LEFT , RIGHT : REAL ) return BOOLEAN ;

  function "<=" ( LEFT , RIGHT : REAL ) return BOOLEAN ;

  function ">=" ( LEFT , RIGHT : REAL ) return BOOLEAN ;

--              The primary purpose of this function for the user is
--              to make constants into values of a specific physical
--              unit.
--              The use of this function in the set of physics packages
--              is to apply the required Ada type to the result of a
--              non dimensional computation.

  function DIMENSION ( LEFT : ANY_REAL ) return REAL ;

--              The use of this function in the set of physics packages
--              is to take any physical quantity and get a non dimensional
--              value in the base floating point arithmetic type in order
--              to preform computation. This should not be needed by users
--              of the set of physics packages.

  function UNDIMENSION ( LEFT : REAL ) return ANY_REAL ;

--    For compilers that can make use of INLINE

  pragma INLINE ( "+" , "-" , "*" , "/" , "abs" , "<" , ">" , "<=" , ">=" ,
      DIMENSION , UNDIMENSION ) ;

--
private
  type REAL is new ANY_REAL ;  -- ANY_REAL is the generic formal parameter
end GENERIC_PHYSICAL_REAL ;

package body GENERIC_PHYSICAL_REAL is

  function "+" ( LEFT , RIGHT : REAL ) return REAL is

  begin
    return REAL ( ANY_REAL( LEFT ) + ANY_REAL ( RIGHT )) ;
  end "+" ;

  function "-" ( LEFT , RIGHT : REAL ) return REAL is

  begin
    return REAL ( ANY_REAL( LEFT ) - ANY_REAL ( RIGHT )) ;
  end "-" ;

  function "*" ( LEFT : ANY_REAL ;
                 RIGHT : REAL ) return REAL is

  begin
    return REAL ( LEFT * ANY_REAL( RIGHT )) ;
  end "*" ;

  function "*" ( LEFT : REAL ;
                 RIGHT : ANY_REAL ) return REAL is

  begin
    return REAL ( ANY_REAL( LEFT ) * RIGHT) ;
  end "*" ;

  function "/" ( LEFT : REAL ;
                 RIGHT : ANY_REAL ) return REAL is

  begin
    return REAL ( ANY_REAL( LEFT ) / RIGHT) ;
  end "/" ;

  function "/" ( LEFT , RIGHT : REAL ) return ANY_REAL is

  begin
    return ANY_REAL ( LEFT ) / ANY_REAL ( RIGHT ) ;
  end "/" ;

  function "abs" ( LEFT : REAL ) return REAL is

  begin
    return REAL ( abs( ANY_REAL( LEFT ))) ;
  end "abs" ;

  function "<" ( LEFT , RIGHT : REAL ) return BOOLEAN is

  begin
    return ANY_REAL ( LEFT ) < ANY_REAL ( RIGHT ) ;
  end "<" ;

  function ">" ( LEFT , RIGHT : REAL ) return BOOLEAN is

  begin
    return ANY_REAL ( LEFT ) > ANY_REAL ( RIGHT ) ;
  end ">" ;

  function "<=" ( LEFT , RIGHT : REAL ) return BOOLEAN is

  begin
    return ANY_REAL ( LEFT ) <= ANY_REAL ( RIGHT ) ;
  end "<=" ;

  function ">=" ( LEFT , RIGHT : REAL ) return BOOLEAN is

  begin
    return ANY_REAL ( LEFT ) >= ANY_REAL ( RIGHT ) ;
  end ">=" ;

  function DIMENSION ( LEFT : ANY_REAL ) return REAL is

  begin
    return REAL ( LEFT ) ;
  end DIMENSION ;

  function UNDIMENSION ( LEFT : REAL ) return ANY_REAL is

  begin
    return ANY_REAL ( LEFT ) ;
  end UNDIMENSION ;

end GENERIC_PHYSICAL_REAL ;

-- The following instantiation is used by many other packages in the
-- set of physical units packages. The instantiated package becomes
-- a withable library unit thus saving the reinstantiation in every
-- other package.
--
with GENERIC_PHYSICAL_REAL ;

package PHYSICAL_REAL is new GENERIC_PHYSICAL_REAL ( FLOAT ) ;