home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / umbscheme-2.12.lha / UMBScheme / src / number.c < prev    next >
C/C++ Source or Header  |  1993-11-29  |  63KB  |  2,453 lines
  1. /* number.c - UMB Scheme, numbers package 
  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. #include "portable.h"
  37. #include "eval.h"
  38. #include "object.h"
  39. #include "architecture.h"
  40. #include "number.h"
  41. #include "fixnum.h"
  42. #include "bignum.h"
  43. #include "rational.h"
  44. #include "real.h"
  45. #include "complex.h"
  46. #include "steering.h"
  47. #include "io.h"
  48. #include <math.h>
  49.  
  50. /* Conversions used in promotion */
  51.  
  52. Private void Coerce_Args();
  53. Private void Coerce_Relational_Args();
  54.  
  55. /* Conversions used in demotion */
  56.  
  57. Private void Demote_Complex_To_Real();
  58. Private void Demote_Rational_To_Integer();
  59. Private void Demote_Bignum_To_Fixnum();
  60.  
  61. /* All the number operations. */
  62.  
  63. typedef void (*Procedure_Pointer)();
  64. typedef Procedure_Pointer Procedure_Array[ TOWER_LEVEL_COUNT ];
  65.  
  66. typedef Boolean (*Boolean_Function_Pointer)();
  67. typedef Boolean_Function_Pointer Boolean_Function_Array[ TOWER_LEVEL_COUNT ];
  68.  
  69. Private struct 
  70. {
  71.                     /* Predicates */
  72.     Boolean_Function_Array Is_Number_Zero;
  73.     Boolean_Function_Array Is_Number_Positive;
  74.     Boolean_Function_Array Is_Number_Negative;
  75.     Boolean_Function_Array Is_Number_Even;
  76.     Boolean_Function_Array Is_Number_Odd;
  77.     Boolean_Function_Array Is_Number_Exact;
  78.     Boolean_Function_Array Is_Number_Inexact;
  79.  
  80.                     /* Comparisons */
  81.     Boolean_Function_Array Number_Equal;
  82.     Boolean_Function_Array Number_Less_Than;
  83.     Boolean_Function_Array Number_Greater_Than;
  84.     Boolean_Function_Array Number_Less_Than_Or_Equal;
  85.     Boolean_Function_Array Number_Greater_Than_Or_Equal;
  86.  
  87.                     /* Arithmetic. */
  88.     Procedure_Array Number_Add;
  89.     Procedure_Array Number_Subtract;
  90.     Procedure_Array Number_Multiply;
  91.     Procedure_Array Number_Divide;
  92.     Procedure_Array Number_Quotient;
  93.     Procedure_Array Number_Remainder;
  94.     Procedure_Array Number_Modulo;
  95.     Procedure_Array Number_Negate;
  96.     Procedure_Array Number_Abs;
  97.     Procedure_Array Number_Numerator;
  98.     Procedure_Array Number_Denominator;
  99.     Procedure_Array Number_Rationalize;
  100.  
  101.                     /* Others. */
  102.     Procedure_Array Number_Max;
  103.     Procedure_Array Number_Min;
  104.     Procedure_Array Number_GCD;
  105.     Procedure_Array Number_LCM;
  106.  
  107.  
  108.     Procedure_Array Number_Floor;
  109.     Procedure_Array Number_Ceiling;
  110.     Procedure_Array Number_Truncate;
  111.     Procedure_Array Number_Round;
  112.  
  113.  
  114.     Procedure_Array Number_Sqrt;
  115.     Procedure_Array Number_Exp;
  116.     Procedure_Array Number_Log;
  117.     Procedure_Array Number_Expt;
  118.  
  119.  
  120.     Procedure_Array Number_Sin;
  121.     Procedure_Array Number_Cos;
  122.     Procedure_Array Number_Tan;
  123.     Procedure_Array Number_Asin;
  124.     Procedure_Array Number_Acos;
  125.     Procedure_Array Number_Atan;
  126.     Procedure_Array Number_Atan2;
  127.  
  128.     Procedure_Array Number_Exact_To_Inexact;
  129.     Procedure_Array Number_Inexact_To_Exact;
  130.     Procedure_Array Number_To_String;
  131.  
  132.     Procedure_Array Number_Make_Rectangular;
  133.     Procedure_Array Number_Make_Polar;
  134.     Procedure_Array Number_Real_Part;
  135.     Procedure_Array Number_Imaginary_Part;
  136.     Procedure_Array Number_Magnitude;
  137.     Procedure_Array Number_Angle;
  138.  
  139. } Num_Ops;
  140.  
  141. /* Basic Predicates on Numbers */
  142.  
  143. /* (number? object) */
  144.  
  145. Private void Number_Predicate()
  146. {
  147.    Value_Register = Is_Number(Top(1)) ? The_True_Object
  148.                                       : The_False_Object;
  149. }
  150.  
  151.  
  152. /* (integer? object) */
  153.  
  154. Private void Integer_Predicate()
  155. {
  156.     if ( Is_Number( Top(1) ) )
  157.     {
  158.         Integer p1 = Get_Number_Tower_Position( Top(1) );
  159.  
  160.         if ( p1 <= BIGNUM_LEVEL )
  161.             Value_Register = The_True_Object;
  162.         else if ( p1 == REAL_LEVEL )
  163.         {
  164.             Push( Top(1) );
  165.             Number_Round();
  166.             Replace( 1 , Value_Register );
  167.             Number_Equal(); Pop(1); /* just the rounded one */
  168.         }
  169.         else Value_Register = The_False_Object;
  170.     }
  171.     else Value_Register = The_False_Object;
  172. }
  173.  
  174.  
  175. /* (rational? object) */
  176.  
  177. Private void Rational_Predicate()
  178. {
  179.     if ( Is_Number( Top(1) ) )
  180.     {
  181.         Integer p1 = Get_Number_Tower_Position( Top(1) );
  182.  
  183.         if ( p1 <= RATIONAL_LEVEL )
  184.             Value_Register = The_True_Object;
  185.         else if ( p1 == REAL_LEVEL )
  186.         {
  187.             Push( Top(1) );
  188.             Number_Round();
  189.             Replace( 1 , Value_Register );
  190.             Number_Equal(); Pop(1); /* just the rounded one */
  191.         }
  192.         else Value_Register = The_False_Object;
  193.     }
  194.     else Value_Register = The_False_Object;
  195. }
  196.  
  197. /* (real? object) */
  198.  
  199. Private void Real_Predicate()
  200. {
  201.    Value_Register = Is_Number(Top(1)) &&
  202.                     Get_Number_Tower_Position(Top(1)) <= REAL_LEVEL
  203.                     ? The_True_Object
  204.                     : The_False_Object;
  205. }
  206.  
  207. /* (complex? object) */
  208.  
  209. Private void Complex_Predicate()
  210. {
  211.    Value_Register = Is_Number(Top(1)) &&
  212.                     Get_Number_Tower_Position(Top(1)) <= COMPLEX_LEVEL
  213.                     ? The_True_Object
  214.                     : The_False_Object;
  215. }
  216.  
  217.  
  218.  
  219.  
  220. /* Generic Number Procedures - invoke more specific procedures via Num_Ops */
  221.  
  222.  
  223. Public void Is_Number_Zero()
  224. {
  225.     Value_Register =
  226.     (*(Num_Ops.Is_Number_Zero[Get_Number_Tower_Position( Top(1) )]))()
  227.             ? The_True_Object
  228.             : The_False_Object;
  229. }
  230.  
  231.                     
  232.  
  233.  
  234. Public void Is_Number_Positive()
  235. {
  236.         
  237.     Value_Register =
  238.     (*(Num_Ops.Is_Number_Positive[Get_Number_Tower_Position( Top(1) )]))()
  239.         ? The_True_Object
  240.         : The_False_Object;
  241. }
  242.  
  243.                     
  244.  
  245.  
  246. Public void Is_Number_Negative()
  247. {
  248.     Value_Register =
  249.     (*(Num_Ops.Is_Number_Negative[Get_Number_Tower_Position( Top(1) )]))()
  250.         ? The_True_Object
  251.         : The_False_Object;
  252. }
  253.  
  254.                     
  255.  
  256.  
  257. Public void Is_Number_Odd()
  258. {
  259.     Value_Register =
  260.     (*(Num_Ops.Is_Number_Odd[Get_Number_Tower_Position( Top(1) )]))()
  261.         ? The_True_Object
  262.         : The_False_Object;
  263. }
  264.  
  265.                     
  266.  
  267.  
  268. Public void Is_Number_Even()
  269. {
  270.     Value_Register =
  271.     (*(Num_Ops.Is_Number_Even[Get_Number_Tower_Position( Top(1) )]))()
  272.         ? The_True_Object
  273.         : The_False_Object;
  274. }
  275.  
  276.                     
  277.  
  278.  
  279. Public void Is_Number_Exact()
  280. {
  281.     Value_Register =
  282.     (*(Num_Ops.Is_Number_Exact[Get_Number_Tower_Position( Top(1) )]))()
  283.         ? The_True_Object
  284.         : The_False_Object;
  285. }
  286.  
  287.                     
  288.  
  289.  
  290. Public void Is_Number_Inexact()
  291. {
  292.     Value_Register =
  293.     (*(Num_Ops.Is_Number_Inexact[Get_Number_Tower_Position( Top(1) )]))()
  294.         ? The_True_Object
  295.         : The_False_Object;
  296. }
  297.  
  298. /* Relations of the form (rel obj obj obj ...) */
  299.  
  300. Private Object Iterate_Over_Relations( Relation_Tower )
  301.         
  302.     Boolean_Function_Array Relation_Tower;
  303. {
  304.     /* In (rel obj obj ...) apply rel to successive obj pairs;
  305.        thus eg (> x y z) is the same as (and (> x y) (> y z)). */
  306.  
  307.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  308.  
  309.     if (arg_count < 2 )
  310.     {
  311.         Display_Error( "Fewer than 2 arguments to a relation: " ,
  312.                    Expression_Register );
  313.     }
  314.     
  315.     while ( arg_count > 1 )
  316.     {
  317.                   Push( Top( arg_count ) );
  318.            Push( Top( arg_count ) );
  319.            Coerce_Relational_Args();
  320.            
  321.            if ( (*(Relation_Tower[Get_Number_Tower_Position(Top(1))]))() )
  322.            {
  323.                Pop( 2 );
  324.                arg_count--;
  325.            }
  326.            else
  327.            {
  328.                Pop( 2 );
  329.                return( The_False_Object );
  330.            }
  331.        }
  332.     return( The_True_Object );
  333. }
  334.  
  335.  
  336.  
  337. Private void Varying_Number_Equal()
  338. {
  339.     Value_Register = Iterate_Over_Relations( Num_Ops.Number_Equal );
  340. }
  341.  
  342.  
  343.  
  344. Private void Varying_Number_Greater_Than()
  345. {
  346.     Value_Register = Iterate_Over_Relations( Num_Ops.Number_Greater_Than );
  347. }
  348.  
  349.  
  350.  
  351. Private void Varying_Number_Less_Than()
  352. {
  353.     Value_Register = I