home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / urealp.ads < prev    next >
Text File  |  1996-09-28  |  12KB  |  310 lines

  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                               U R E A L P                                --
  6. --                                                                          --
  7. --                                 S p e c                                  --
  8. --                                                                          --
  9. --                             $Revision: 1.19 $                            --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  Support for universal real arithmetic
  27.  
  28. with System; use System;
  29. with Types;  use Types;
  30. with Uintp;  use Uintp;
  31.  
  32. package Urealp is
  33.  
  34.    ---------------------------------------
  35.    -- Representation of Universal Reals --
  36.    ---------------------------------------
  37.  
  38.    --  A universal real value is represented by a single value (which is
  39.    --  an index into an internal table). These values are not hashed, so
  40.    --  the equality operator should not be used on Ureal values (instead
  41.    --  use the UR_Eq function).
  42.  
  43.    --  A Ureal value represents an arbitrary precision universal real value,
  44.    --  stored internally using four components
  45.  
  46.    --    the numerator (Uint, always non-negative)
  47.    --    the denominator (Uint, always non-zero, always positive if base = 0)
  48.    --    a real base (Nat, either zero, or in the range 2 .. 16)
  49.    --    a sign flag (Boolean), set if negative
  50.  
  51.    --  If the base is zero, then the absolute value of the Ureal is simply
  52.    --  numerator/denominator. If the base is non-zero, then the absolute
  53.    --  value is num (rbase ** den).
  54.  
  55.    --  Negative numbers are represented by the sign of the numerator being
  56.    --  negative. The denominator is always positive.
  57.  
  58.    --  A normalized Ureal value has base = 0, and numerator/denominator
  59.    --  reduced to lowest terms, with zero itself being represented as 0/1.
  60.    --  This is a canonical format, so that for normalized Ureal values it
  61.    --  is the case that two equal values always have the same denominator
  62.    --  and numerator values.
  63.  
  64.    --  Note: a value of minus zero is legitimate, and the operations in
  65.    --  Urealp preserve the handling of signed zeroes in accordance with
  66.    --  the rules of IEEE P754 ("IEEE floating point").
  67.  
  68.    ------------------------------
  69.    -- Types for Urealp Package --
  70.    ------------------------------
  71.  
  72.    type Ureal is private;
  73.    --  Type used for representation of universal reals
  74.  
  75.    No_Ureal : constant Ureal;
  76.    --  Constant used to indicate missing or unset Ureal value
  77.  
  78.    ---------------------
  79.    -- Ureal Constants --
  80.    ---------------------
  81.  
  82.    function Ureal_0 return Ureal;
  83.    --  Returns value 0.0
  84.  
  85.    function Ureal_Tenth return Ureal;
  86.    --  Returns value 0.1
  87.  
  88.    function Ureal_Half return Ureal;
  89.    --  Returns value 0.5
  90.  
  91.    function Ureal_1 return Ureal;
  92.    --  Returns value 1.0
  93.  
  94.    function Ureal_2 return Ureal;
  95.    --  Returns value 2.0
  96.  
  97.    function Ureal_10 return Ureal;
  98.    --  Returns value 10.0
  99.  
  100.    function Ureal_Fine_Delta return Ureal;
  101.    --  Returns value of System.Fine_Delta on target
  102.  
  103.    -----------------
  104.    -- Subprograms --
  105.    -----------------
  106.  
  107.    procedure Initialize;
  108.    --  Initialize Ureal tables. Note that Initialize must not be called if
  109.    --  Tree_Read is used.
  110.  
  111.    procedure Tree_Read;
  112.    --  Initializes internal tables from current tree file using Tree_Read.
  113.    --  Note that Initialize should not be called if Tree_Read is used.
  114.    --  Tree_Read includes all necessary initialization.
  115.  
  116.    procedure Tree_Write;
  117.    --  Writes out internal tables to current tree file using Tree_Write
  118.  
  119.    function Rbase (Real : Ureal) return Nat;
  120.    --  Return the base of the universal real.
  121.  
  122.    function Denominator (Real : Ureal) return Uint;
  123.    --  Return the denominator of the universal real.
  124.  
  125.    function Numerator (Real : Ureal) return Uint;
  126.    --  Return the numerator of the universal real.
  127.  
  128.    function Norm_Den (Real : Ureal) return Uint;
  129.    --  Return the denominator of the universal real after a normalization.
  130.  
  131.    function Norm_Num (Real : Ureal) return Uint;
  132.    --  Return the numerator of the universal real after a normalization.
  133.  
  134.    function UR_From_Uint (UI : Uint) return Ureal;
  135.    --  Returns real corresponding to universal integer value
  136.  
  137.    function UR_To_Uint (Real : Ureal) return Uint;
  138.    --  Return integer value obtained by accurate rounding of real value.
  139.    --  The rounding of values half way between two integers is away from
  140.    --  zero, as required by normal Ada 95 rounding semantics.
  141.  
  142.    function UR_From_Components
  143.      (Num      : Uint;
  144.       Den      : Uint;
  145.       Rbase    : Nat := 0;
  146.       Negative : Boolean := False)
  147.       return     Ureal;
  148.    --  Builds real value from given numerator, denominator and base. The
  149.    --  value is negative if Negative is set to true, and otherwise is
  150.    --  non-negative.
  151.  
  152.    function UR_Trunc (Real : Ureal) return Uint;
  153.    --  Return integer value obtained by a truncation of real value.
  154.  
  155.    function UR_Add (Left : Ureal; Right : Ureal) return Ureal;
  156.    function UR_Add (Left : Ureal; Right : Uint)  return Ureal;
  157.    function UR_Add (Left : Uint;  Right : Ureal) return Ureal;
  158.    --  Returns real sum of operands
  159.  
  160.    function UR_Div (Left : Ureal; Right : Ureal) return Ureal;
  161.    function UR_Div (Left : Uint;  Right : Ureal) return Ureal;
  162.    function UR_Div (Left : Ureal; Right : Uint)  return Ureal;
  163.    --  Returns real quotient of operands. Fatal error if Right is zero
  164.  
  165.    function UR_Mul (Left : Ureal; Right : Ureal) return Ureal;
  166.    function UR_Mul (Left : Uint;  Right : Ureal) return Ureal;
  167.    function UR_Mul (Left : Ureal; Right : Uint)  return Ureal;
  168.    --  Returns real product of operands
  169.  
  170.    function UR_Sub (Left : Ureal; Right : Ureal) return Ureal;
  171.    function UR_Sub (Left : Uint;  Right : Ureal) return Ureal;
  172.    function UR_Sub (Left : Ureal; Right : Uint)  return Ureal;
  173.    --  Returns real difference of operands
  174.  
  175.    function UR_Exponentiate (Real  : Ureal; N : Uint) return  Ureal;
  176.    --  Returns result of raising Ureal to Uint power.
  177.    --  Fatal error if Left is 0 and Right is negative.
  178.  
  179.    function UR_Abs (Real : Ureal) return Ureal;
  180.    --  Returns abs function of real
  181.  
  182.    function UR_Negate (Real : Ureal) return Ureal;
  183.    --  Returns negative of real
  184.  
  185.    function UR_Eq (Left, Right : Ureal) return Boolean;
  186.    --  Compares reals for equality.
  187.  
  188.    function UR_Max (Left, Right : Ureal) return Ureal;
  189.    --  Returns the maximum of two reals
  190.  
  191.    function UR_Min (Left, Right : Ureal) return Ureal;
  192.    --  Returns the minimum of two reals
  193.  
  194.    function UR_Ne (Left, Right : Ureal) return Boolean;
  195.    --  Compares reals for inequality.
  196.  
  197.    function UR_Lt (Left, Right : Ureal) return Boolean;
  198.    --  Compares reals for less than.
  199.  
  200.    function UR_Le (Left, Right : Ureal) return Boolean;
  201.    --  Compares reals for less than or equal.
  202.  
  203.    function UR_Gt (Left, Right : Ureal) return Boolean;
  204.    --  Compares reals for greater than.
  205.  
  206.    function UR_Ge (Left, Right : Ureal) return Boolean;
  207.    --  Compares reals for greater than or equal.
  208.  
  209.    function UR_Is_Zero (Real : Ureal) return Boolean;
  210.    --  Tests if real value is zero
  211.  
  212.    function UR_Is_Negative (Real : Ureal) return Boolean;
  213.    --  Tests if real value is negative, note that negative zero gives true
  214.  
  215.    function UR_Is_Positive (Real : Ureal) return Boolean;
  216.    --  Test if real value is greater than zero
  217.  
  218.    procedure UR_Write (Real : Ureal);
  219.    --  Writes value of real to standard output. Used only for debugging and
  220.    --  tree/source output. If the result is easily representable as a standard
  221.    --  Ada literal, it will be given that way, but as a result of evaluation
  222.    --  of static expressions, it is possible to generate constants (e.g. 1/13)
  223.    --  which have no such representation. In such cases (and in cases where it
  224.    --  is too much work to figure out the Ada literal), the string that is
  225.    --  output is of the form [numerator/denominator].
  226.  
  227.    ------------------------
  228.    -- Operator Renamings --
  229.    ------------------------
  230.  
  231.    function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add;
  232.    function "+" (Left : Uint;  Right : Ureal) return Ureal renames UR_Add;
  233.    function "+" (Left : Ureal; Right : Uint)  return Ureal renames UR_Add;
  234.  
  235.    function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div;
  236.    function "/" (Left : Uint;  Right : Ureal) return Ureal renames UR_Div;
  237.    function "/" (Left : Ureal; Right : Uint)  return Ureal renames UR_Div;
  238.  
  239.    function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul;
  240.    function "*" (Left : Uint;  Right : Ureal) return Ureal renames UR_Mul;
  241.    function "*" (Left : Ureal; Right : Uint)  return Ureal renames UR_Mul;
  242.  
  243.    function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub;
  244.    function "-" (Left : Uint;  Right : Ureal) return Ureal renames UR_Sub;
  245.    function "-" (Left : Ureal; Right : Uint)  return Ureal renames UR_Sub;
  246.  
  247.    function "**"  (Real  : Ureal; N : Uint) return Ureal
  248.                                                      renames UR_Exponentiate;
  249.  
  250.    function "abs" (Real : Ureal) return Ureal renames UR_Abs;
  251.  
  252.    function "-"   (Real : Ureal) return Ureal renames UR_Negate;
  253.  
  254.    function "="   (Left, Right : Ureal) return Boolean renames UR_Eq;
  255.  
  256.    function "<"   (Left, Right : Ureal) return Boolean renames UR_Lt;
  257.  
  258.    function "<="  (Left, Right : Ureal) return Boolean renames UR_Le;
  259.  
  260.    function ">="  (Left, Right : Ureal) return Boolean renames UR_Ge;
  261.  
  262.    function ">"   (Left, Right : Ureal) return Boolean renames UR_Gt;
  263.  
  264.    -----------------------------
  265.    -- Mark/Release Processing --
  266.    -----------------------------
  267.  
  268.    --  The space used by Ureal data is not automatically reclaimed. However,
  269.    --  a mark-release regime is implemented which allows storage to be
  270.    --  released back to a previously noted mark. This is used for example
  271.    --  when doing comparisons, where only intermediate results get stored
  272.    --  that do not need to be saved for future use.
  273.  
  274.    type Save_Mark is private;
  275.  
  276.    function Mark return Save_Mark;
  277.    --  Note mark point for future release
  278.  
  279.    procedure Release (M : Save_Mark);
  280.    --  Release storage allocated since mark was noted
  281.  
  282.    ------------------------------------
  283.    -- Representation of Ureal Values --
  284.    ------------------------------------
  285.  
  286. private
  287.  
  288.    type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
  289.  
  290.    No_Ureal : constant Ureal := Ureal'First;
  291.  
  292.    type Save_Mark is new Int;
  293.  
  294.    pragma Inline (Denominator);
  295.    pragma Inline (Mark);
  296.    pragma Inline (Norm_Num);
  297.    pragma Inline (Norm_Den);
  298.    pragma Inline (Numerator);
  299.    pragma Inline (Rbase);
  300.    pragma Inline (Release);
  301.    pragma Inline (Ureal_0);
  302.    pragma Inline (Ureal_Tenth);
  303.    pragma Inline (Ureal_Half);
  304.    pragma Inline (Ureal_1);
  305.    pragma Inline (Ureal_2);
  306.    pragma Inline (Ureal_10);
  307.    pragma Inline (UR_From_Components);
  308.  
  309. end Urealp;
  310.