home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / umbscheme-2.12.lha / UMBScheme / src / rational.c < prev    next >
C/C++ Source or Header  |  1993-11-29  |  15KB  |  809 lines
  1. /* rational.c -- UMB Scheme, specific rational number procedures.
  2.  
  3. UMB Scheme Interpreter                  $Revision: 2.12 $
  4. Copyright (C) 1988, 1991 William R Campbell
  5.  
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with this program; if not, write to the Free Software
  18. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. UMB Scheme was written by Bill Campbell with help from Karl Berry,
  21. Barbara Dixey, Ira Gerstein, Mary Glaser, Kathy Hargreaves, Bill McCabe,
  22. Long Nguyen, Susan Quina, Jeyashree Sivasubram, Bela Sohoni and Thang Quoc Tran.
  23.  
  24. For additional information about UMB Scheme, contact the author:
  25.  
  26.     Bill Campbell
  27.     Department of Mathematics and Computer Science
  28.     University of Massachusetts at Boston
  29.     Harbor Campus
  30.     Boston, MA 02125
  31.  
  32.     Telephone: 617-287-6449        Internet: bill@cs.umb.edu
  33.  
  34. */
  35.  
  36.  
  37. #include "portable.h"
  38. #include "eval.h"
  39. #include "object.h"
  40. #include "architecture.h"
  41. #include "number.h"
  42. #include "fixnum.h"
  43. #include "bignum.h"
  44. #include "rational.h"
  45. #include "real.h"
  46. #include "complex.h"
  47. #include "steering.h"
  48. #include "io.h"
  49. #include <math.h>
  50. #include <errno.h>
  51.  
  52. Private Short Rational_Compare();
  53.  
  54.  
  55.  
  56. /* Predicates. */
  57.  
  58. Public Boolean Is_Rational_Zero()
  59. {
  60.       return (Number_Sign(Get_Number_Rational_Numerator(Top(1))) == 0);;
  61. }
  62.  
  63. Public Boolean Is_Rational_Positive()
  64. {
  65.     return (Number_Sign(Get_Number_Rational_Numerator(Top(1))) > 0);
  66. }
  67.  
  68. Public Boolean Is_Rational_Negative()
  69. {
  70.     return(Number_Sign(Get_Number_Rational_Numerator(Top(1))) < 0);
  71. }
  72.  
  73. Public Boolean Is_Rational_Odd()
  74. {
  75.     Error("Rationals aren't odd or even");
  76.     return FALSE;
  77. }
  78.  
  79. Public Boolean Is_Rational_Even()
  80. {
  81.     Error("Rationals aren't odd or even");
  82.     return FALSE;
  83. }
  84.  
  85. Public Boolean Is_Rational_Exact()
  86. {
  87.     return (Is_Exact_Number(Top(1)));
  88. }
  89.  
  90. Public Boolean Is_Rational_Inexact()
  91. {
  92.     return (! Is_Exact_Number(Top(1)));
  93. }
  94.  
  95.  
  96.  
  97. /* Comparisons. */
  98.  
  99. Public Boolean Rational_Less_Than()
  100. {
  101.     return Rational_Compare() < 0;
  102. }
  103.  
  104. Public Boolean Rational_Greater_Than()
  105. {
  106.     return Rational_Compare() > 0;
  107. }
  108.  
  109. Public Boolean Rational_Equal()
  110. {
  111.     return Rational_Compare() == 0;
  112. }
  113.  
  114. Public Boolean Rational_Less_Than_Or_Equal()
  115. {
  116.     return Rational_Compare() <= 0;
  117. }
  118.  
  119. Public Boolean Rational_Greater_Than_Or_Equal()
  120. {
  121.     return Rational_Compare() >= 0;
  122. }
  123.  
  124. Private Short Rational_Compare()
  125. {
  126.     Rational_Subtract();
  127.     return Number_Sign( Get_Number_Rational_Numerator( Value_Register ));
  128. }
  129.  
  130.  
  131.  
  132.  
  133. /* Arithmetic. */
  134.  
  135. Public void Rational_Add()
  136. {
  137.     /* rat 1 = a/b, rat 2 = c/d, result = (a*d + b*c)/b*d     */
  138.  
  139.     Push(Get_Number_Rational_Numerator(Top( 2 )));    /* numer rat 1 */
  140.     Push(Get_Number_Rational_Denominator(Top( 2 )));  /* denom rat 2 */
  141.     Number_Multiply();
  142.     Pop( 2 );
  143.     Push( Value_Register );
  144.  
  145.     Push(Get_Number_Rational_Denominator(Top( 3 )));  /* denom rat 1 */
  146.     Push(Get_Number_Rational_Numerator(Top( 3 )));    /* numer rat 2 */
  147.     Number_Multiply();
  148.     Pop( 2 );
  149.     Push( Value_Register );
  150.  
  151.     /* add 2 new numerators */
  152.     Number_Add();
  153.     Pop( 2 );
  154.     Push( Value_Register );
  155.  
  156.     Push(Get_Number_Rational_Denominator(Top( 3 )));  /* denom rat 1 */
  157.     Push(Get_Number_Rational_Denominator(Top( 3 ))); /* denom rat 2 */
  158.     Number_Multiply();
  159.     Pop( 2 );
  160.     Push( Value_Register );    /* denominator */
  161.  
  162.     Make_Rational_Number();
  163.     Pop( 2 );
  164.  
  165.     if ( ! Is_Exact_Number( Top(1) ) || ! Is_Exact_Number( Top(2) ) )
  166.     {
  167.         Push( Value_Register );
  168.         Number_Exact_To_Inexact(); Pop(1);
  169.     }
  170. }
  171.  
  172.  
  173.  
  174. Public void Rational_Subtract()
  175. {
  176.     /* rat 1 = a/b, rat 2 = c/d, result = (a*d - b*c)/b*d     */
  177.  
  178.     Push(Get_Number_Rational_Numerator(Top( 2 )));    /* numer rat 1 */
  179.     Push(Get_Number_Rational_Denominator(Top( 2 )));  /* denom rat 2 */
  180.     Number_Multiply();
  181.     Pop( 2 );
  182.     Push( Value_Register );
  183.  
  184.     Push(Get_Number_Rational_Denominator(Top( 3 )));  /* denom rat 1 */
  185.     Push(Get_Number_Rational_Numerator(Top( 3 )));    /* numer rat 2 */
  186.     Number_Multiply();
  187.     Pop( 2 );
  188.     Push( Value_Register );
  189.  
  190.     /* subtract 2 new numerators */
  191.     Number_Subtract();
  192.     Pop( 2 );
  193.     Push( Value_Register );
  194.  
  195.     Push(Get_Number_Rational_Denominator(Top( 3 )));  /* denom rat 1 */
  196.     Push(Get_Number_Rational_Denominator(Top( 3 ))); /* denom rat 2 */
  197.     Number_Multiply();
  198.     Pop( 2 );
  199.     Push( Value_Register );    /* denominator */
  200.  
  201.     Make_Rational_Number();
  202.     Pop( 2 );
  203.  
  204.     if ( ! Is_Exact_Number( Top(1) ) || ! Is_Exact_Number( Top(2) ) )
  205.     {
  206.         Push( Value_Register );
  207.         Number_Exact_To_Inexact(); Pop(1);
  208.     }
  209. }
  210.  
  211.  
  212.  
  213. Public void Rational_Multiply()
  214. {
  215.     /* rat 1 = a/b, rat 2 = c/d, result = a*c/b*d    */
  216.  
  217.     Push(Get_Number_Rational_Numerator(Top( 2 )));    /* numer rat 1 */
  218.     Push(Get_Number_Rational_Numerator(Top( 2 )));    /* numer rat 2 */
  219.     Number_Multiply();
  220.     Pop( 2 );
  221.     Push( Value_Register );    /* new numer of result rat */
  222.  
  223.     Push(Get_Number_Rational_Denominator(Top( 2 ))); /* denom rat 2 */
  224.     Push(Get_Number_Rational_Denominator(Top( 4 ))); /* denom rat 1 */
  225.     Number_Multiply();
  226.     Pop( 2 );
  227.     Push( Value_Register );    /* new denom of result rat */
  228.  
  229.     Make_Rational_Number();
  230.     Pop( 2 );
  231.  
  232.     if ( ! Is_Exact_Number( Top(1) ) || ! Is_Exact_Number( Top(2) ) )
  233.     {
  234.         Push( Value_Register );
  235.         Number_Exact_To_Inexact(); Pop(1);
  236.     }
  237. }
  238.  
  239.  
  240. Public void Rational_Divide()
  241. {
  242.     /* rat 1 = a/b, rat 2 = c/d, result = a*d/c*b    */
  243.  
  244.     Push(Get_Number_Rational_Numerator(Top( 2 )));    /* numer rat 1 */
  245.     Push(Get_Number_Rational_Denominator(Top( 2 ))); /* denom rat 2 */
  246.     Number_Multiply();
  247.     Pop( 2 );
  248.     Push( Value_Register );    /* new numer of result rat */
  249.  
  250.     Push(Get_Number_Rational_Denominator(Top( 3 ))); /* denom rat 1 */
  251.     Push(Get_Number_Rational_Numerator(Top( 3 )));    /* numer rat 2 */
  252.     Number_Multiply();
  253.     Pop( 2 );
  254.     Push( Value_Register );    /* new denom of result rat */
  255.  
  256.     Make_Rational_Number();
  257.     Pop( 2 );
  258.  
  259.     if ( ! Is_Exact_Number( Top(1) ) || ! Is_Exact_Number( Top(2) ) )
  260.     {
  261.         Push( Value_Register );
  262.         Number_Exact_To_Inexact(); Pop(1);
  263.     }
  264. }
  265.  
  266.  
  267. Public void Rational_Quotient()
  268. {
  269.     Error("Quotient makes no sense on rationals");
  270. }
  271.  
  272. Public void Rational_Remainder()
  273. {
  274.     Error("Remainder makes no sense on rationals");
  275. }
  276.  
  277.  
  278. Public void Rational_Modulo()
  279. {
  280.     Error("Modulo makes no sense on rationals");
  281. }
  282.  
  283.  
  284. Public void Rational_Negate()
  285. {
  286.     Push(Get_Number_Rational_Numerator(Top(1)));
  287.     Number_Negate();
  288.     Replace(1, Value_Register);
  289.     Push(Get_Number_Rational_Denominator(Top(2)));
  290.     Make_Rational_Number();
  291.     Pop(2);    
  292.  
  293.     if ( ! Is_Exact_Number( Top(1) ) )
  294.     {
  295.         Push( Value_Register );
  296.         Number_Exact_To_Inexact(); Pop(1);
  297.     }
  298. }
  299.  
  300.  
  301. Public void Rational_Abs()
  302. {
  303.     if (Is_Rational_Negative())
  304.     {
  305.         Rational_Negate();
  306.     }
  307.     else
  308.     {
  309.         Value_Register = Top(1);
  310.     }
  311. }
  312.  
  313. Public void Rational_Numerator()
  314. {
  315.     
  316.     Value_Register = Get_Number_Rational_Numerator(Top( 1 ));
  317.  
  318.     if ( ! Is_Exact_Number( Top(1) ) )
  319.     {
  320.         Push( Value_Register );
  321.         Number_Exact_To_Inexact(); Pop(1);
  322.     }
  323. }
  324.  
  325.  
  326. Public void Rational_Denominator()
  327. {
  328.     
  329.     Value_Register = Get_Number_Rational_Denominator(Top( 1 ));
  330.  
  331.     if ( ! Is_Exact_Number( Top(1) ) )
  332.     {
  333.         Push( Value_Register );
  334.         Number_Exact_To_Inexact(); Pop(1);
  335.     }
  336. }
  337.  
  338.  
  339. Public void Rational_Rationalize()
  340. {
  341.     Error("Rational_Rationalize is not yet implemented");
  342. }
  343.  
  344.  
  345.  
  346. Public void Rational_Max()
  347. {
  348.     Value_Register = Rational_Greater_Than() ? Top(2) : Top(1);
  349.  
  350.     if ( ! Is_Exact_Number( Top(1) ) || ! Is_Exact_Number( Top(2) ) )
  351.     {
  352.         Push( Value_Register );
  353.         Number_Exact_To_Inexact(); Pop(1);
  354.     }
  355. }
  356.  
  357. Public void Rational_Min()
  358. {
  359.     Value_Register = Rational_Less_Than() ? Top(2) : Top(1);
  360.  
  361.     if ( ! Is_Exact_Number( Top(1) ) || ! Is_Exact_Number( Top(2) ) )
  362.     {
  363.         Push( Value_Register );
  364.         Number_Exact_To_Inexact(); Pop(1);
  365.     }
  366. }
  367.  
  368. Public void Rational_GCD()
  369. {
  370.     Error("GCD makes no sense on rationals");
  371. }
  372.  
  373.  
  374. Public void Rational_LCM()
  375. {
  376.     Error("LCM makes no sense on rationals");
  377. }
  378.  
  379. Public void Rational_Floor()
  380. {
  381.     Value_Register = Copy_Object(Top(1), Rational_Size);
  382.  
  383.     Push(Get_Number_Rational_Numerator(Value_Register));
  384.     Push(Get_Number_Rational_Denominator(Value_Register))