home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / oct93 / develop / umbscheme.lha / UMBScheme / src / number.c < prev    next >
C/C++ Source or Header  |  1993-07-21  |  63KB  |  2,473 lines
  1. /* number.c - UMB Scheme, numbers package
  2.  
  3. UMB Scheme Interpreter                    $Revision: 2.5 $
  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. #ifdef _DCC
  70. __far
  71. #endif
  72.  
  73. Private struct
  74. {
  75.                     /* Predicates */
  76.     Boolean_Function_Array Is_Number_Zero;
  77.     Boolean_Function_Array Is_Number_Positive;
  78.     Boolean_Function_Array Is_Number_Negative;
  79.     Boolean_Function_Array Is_Number_Even;
  80.     Boolean_Function_Array Is_Number_Odd;
  81.     Boolean_Function_Array Is_Number_Exact;
  82.     Boolean_Function_Array Is_Number_Inexact;
  83.  
  84.                     /* Comparisons */
  85.     Boolean_Function_Array Number_Equal;
  86.     Boolean_Function_Array Number_Less_Than;
  87.     Boolean_Function_Array Number_Greater_Than;
  88.     Boolean_Function_Array Number_Less_Than_Or_Equal;
  89.     Boolean_Function_Array Number_Greater_Than_Or_Equal;
  90.  
  91.                     /* Arithmetic. */
  92.     Procedure_Array Number_Add;
  93.     Procedure_Array Number_Subtract;
  94.     Procedure_Array Number_Multiply;
  95.     Procedure_Array Number_Divide;
  96.     Procedure_Array Number_Quotient;
  97.     Procedure_Array Number_Remainder;
  98.     Procedure_Array Number_Modulo;
  99.     Procedure_Array Number_Negate;
  100.     Procedure_Array Number_Abs;
  101.     Procedure_Array Number_Numerator;
  102.     Procedure_Array Number_Denominator;
  103.     Procedure_Array Number_Rationalize;
  104.  
  105.                     /* Others. */
  106.     Procedure_Array Number_Max;
  107.     Procedure_Array Number_Min;
  108.     Procedure_Array Number_GCD;
  109.     Procedure_Array Number_LCM;
  110.  
  111.  
  112.     Procedure_Array Number_Floor;
  113.     Procedure_Array Number_Ceiling;
  114.     Procedure_Array Number_Truncate;
  115.     Procedure_Array Number_Round;
  116.  
  117.  
  118.     Procedure_Array Number_Sqrt;
  119.     Procedure_Array Number_Exp;
  120.     Procedure_Array Number_Log;
  121.     Procedure_Array Number_Expt;
  122.  
  123.  
  124.     Procedure_Array Number_Sin;
  125.     Procedure_Array Number_Cos;
  126.     Procedure_Array Number_Tan;
  127.     Procedure_Array Number_Asin;
  128.     Procedure_Array Number_Acos;
  129.     Procedure_Array Number_Atan;
  130.     Procedure_Array Number_Atan2;
  131.  
  132.     Procedure_Array Number_Exact_To_Inexact;
  133.     Procedure_Array Number_Inexact_To_Exact;
  134.     Procedure_Array Number_To_String;
  135.  
  136.     Procedure_Array Number_Make_Rectangular;
  137.     Procedure_Array Number_Make_Polar;
  138.     Procedure_Array Number_Real_Part;
  139.     Procedure_Array Number_Imaginary_Part;
  140.     Procedure_Array Number_Magnitude;
  141.     Procedure_Array Number_Angle;
  142.  
  143. } Num_Ops;
  144.  
  145. /* Basic Predicates on Numbers */
  146.  
  147. /* (number? object) */
  148.  
  149. Private void Number_Predicate()
  150. {
  151.    Value_Register = Is_Number(Top(1)) ? The_True_Object
  152.                       : The_False_Object;
  153. }
  154.  
  155.  
  156. /* (integer? object) */
  157.  
  158. Private void Integer_Predicate()
  159. {
  160.     if ( Is_Number( Top(1) ) )
  161.     {
  162.         Integer p1 = Get_Number_Tower_Position( Top(1) );
  163.  
  164.         if ( p1 <= BIGNUM_LEVEL )
  165.             Value_Register = The_True_Object;
  166.         else if ( p1 == REAL_LEVEL )
  167.         {
  168.             Push( Top(1) );
  169.             Number_Round();
  170.             Replace( 1 , Value_Register );
  171.             Number_Equal(); Pop(1); /* just the rounded one */
  172.         }
  173.         else Value_Register = The_False_Object;
  174.     }
  175.     else Value_Register = The_False_Object;
  176. }
  177.  
  178.  
  179. /* (rational? object) */
  180.  
  181. Private void Rational_Predicate()
  182. {
  183.     if ( Is_Number( Top(1) ) )
  184.     {
  185.         Integer p1 = Get_Number_Tower_Position( Top(1) );
  186.  
  187.         if ( p1 <= RATIONAL_LEVEL )
  188.             Value_Register = The_True_Object;
  189.         else if ( p1 == REAL_LEVEL )
  190.         {
  191.             Push( Top(1) );
  192.             Number_Round();
  193.             Replace( 1 , Value_Register );
  194.             Number_Equal(); Pop(1); /* just the rounded one */
  195.         }
  196.         else Value_Register = The_False_Object;
  197.     }
  198.     else Value_Register = The_False_Object;
  199. }
  200.  
  201. /* (real? object) */
  202.  
  203. Private void Real_Predicate()
  204. {
  205.    Value_Register = Is_Number(Top(1)) &&
  206.             Get_Number_Tower_Position(Top(1)) <= REAL_LEVEL
  207.             ? The_True_Object
  208.             : The_False_Object;
  209. }
  210.  
  211. /* (complex? object) */
  212.  
  213. Private void Complex_Predicate()
  214. {
  215.    Value_Register = Is_Number(Top(1)) &&
  216.             Get_Number_Tower_Position(Top(1)) <= COMPLEX_LEVEL
  217.             ? The_True_Object
  218.             : The_False_Object;
  219. }
  220.  
  221.  
  222.  
  223.  
  224. /* Generic Number Procedures - invoke more specific procedures via Num_Ops */
  225.  
  226.  
  227. Public void Is_Number_Zero()
  228. {
  229.     Value_Register =
  230.     (*(Num_Ops.Is_Number_Zero[Get_Number_Tower_Position( Top(1) )]))()
  231.         ? The_True_Object
  232.         : The_False_Object;
  233. }
  234.  
  235.  
  236.  
  237.  
  238. Public void Is_Number_Positive()
  239. {
  240.  
  241.     Value_Register =
  242.     (*(Num_Ops.Is_Number_Positive[Get_Number_Tower_Position( Top(1) )]))()
  243.         ? The_True_Object
  244.         : The_False_Object;
  245. }
  246.  
  247.  
  248.  
  249.  
  250. Public void Is_Number_Negative()
  251. {
  252.     Value_Register =
  253.     (*(Num_Ops.Is_Number_Negative[Get_Number_Tower_Position( Top(1) )]))()
  254.         ? The_True_Object
  255.         : The_False_Object;
  256. }
  257.  
  258.  
  259.  
  260.  
  261. Public void Is_Number_Odd()
  262. {
  263.     Value_Register =
  264.     (*(Num_Ops.Is_Number_Odd[Get_Number_Tower_Position( Top(1) )]))()
  265.         ? The_True_Object
  266.         : The_False_Object;
  267. }
  268.  
  269.  
  270.  
  271.  
  272. Public void Is_Number_Even()
  273. {
  274.     Value_Register =
  275.     (*(Num_Ops.Is_Number_Even[Get_Number_Tower_Position( Top(1) )]))()
  276.         ? The_True_Object
  277.         : The_False_Object;
  278. }
  279.  
  280.  
  281.  
  282.  
  283. Public void Is_Number_Exact()
  284. {
  285.     Value_Register =
  286.     (*(Num_Ops.Is_Number_Exact[Get_Number_Tower_Position( Top(1) )]))()
  287.         ? The_True_Object
  288.         : The_False_Object;
  289. }
  290.  
  291.  
  292.  
  293.  
  294. Public void Is_Number_Inexact()
  295. {
  296.     Value_Register =
  297.     (*(Num_Ops.Is_Number_Inexact[Get_Number_Tower_Position( Top(1) )]))()
  298.         ? The_True_Object
  299.         : The_False_Object;
  300. }
  301.  
  302. /* Relations of the form (rel obj obj obj ...) */
  303.  
  304. Private Object Iterate_Over_Relations( Relation_Tower )
  305.  
  306.     Boolean_Function_Array Relation_Tower;
  307. {
  308.     /* In (rel obj obj ...) apply rel to successive obj pairs;
  309.        thus eg (> x y z) is the same as (and (> x y) (> y z)). */
  310.  
  311.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  312.  
  313.     if (arg_count < 2 )
  314.     {
  315.         Display_Error( "Fewer than 2 arguments to a relation: " ,
  316.                    Expression_Register );
  317.     }
  318.  
  319.     while ( arg_count > 1 )
  320.     {
  321.            Push( Top( arg_count ) );
  322.            Push( Top( arg_count ) );
  323.            Coerce_Relational_Args();
  324.  
  325.            if ( (*(Relation_Tower[Get_Number_Tower_Position(Top(1))]))() )
  326.            {
  327.                Pop( 2 );
  328.                arg_count--;
  329.            }
  330.            else
  331.            {
  332.                Pop( 2 );
  333.                return( The_False_Object );
  334.            }
  335.        }
  336.     return( The_True_Object );
  337. }
  338.  
  339.  
  340.  
  341. Private void Varying_Number_Equal()
  342. {
  343.     Value_Register = Iterate_Over_Relations( Num_Ops.Number_Equal );
  344. }
  345.  
  346.  
  347.  
  348. Private void Varying_Number_Greater_Than()
  349. {
  350.     Value_Register = Iterate_Over_Relations( Num_Ops.Number_Greater_Than );
  351. }
  352.  
  353.  
  354.  
  355. Private void Varying_Number_Less_Than()
  356. {
  357.     Value_Register = Iterate_Over_Relations( Num_Ops.Number_Less_Than );
  358. }
  359.  
  360.  
  361.  
  362. Private void Varying_Number_Greater_Than_Or_Equal()
  363. {
  364.     Value_Register =
  365.     Iterate_Over_Relations( Num_Ops.Number_Greater_Than_Or_Equal );
  366. }
  367.  
  368.  
  369.  
  370. Private void Varying_Number_Less_Than_Or_Equal()
  371. {
  372.     Value_Register =
  373.     Iterate_Over_Relations( Num_Ops.Number_Less_Than_Or_Equal );
  374. }
  375.  
  376.  
  377.  
  378.  
  379. Public void Number_Equal()
  380. {
  381.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  382.  
  383.     Value_Register =
  384.     (*(Num_Ops.Number_Equal[Get_Number_Tower_Position( Top(1) )]))()
  385.         ? The_True_Object
  386.         : The_False_Object;
  387. }
  388.  
  389.  
  390.  
  391.  
  392.  
  393. Public void Number_Less_Than()
  394. {
  395.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  396.  
  397.     Value_Register =
  398.     (*(Num_Ops.Number_Less_Than[Get_Number_Tower_Position( Top(1) )]))()
  399.         ? The_True_Object
  400.         : The_False_Object;
  401. }
  402.  
  403.  
  404.  
  405.  
  406.  
  407. Public void Number_Greater_Than()
  408. {
  409.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  410.  
  411.     Value_Register =
  412.     (*(Num_Ops.Number_Greater_Than[Get_Number_Tower_Position( Top(1) )]))()
  413.         ? The_True_Object
  414.         : The_False_Object;
  415. }
  416.  
  417.  
  418.  
  419.  
  420.  
  421. Public void Number_Less_Than_Or_Equal()
  422. {
  423.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  424.  
  425.     Value_Register =
  426.     (*(Num_Ops.Number_Less_Than_Or_Equal[
  427.                 Get_Number_Tower_Position( Top(1) )]))()
  428.         ? The_True_Object
  429.         : The_False_Object;
  430. }
  431.  
  432.  
  433.  
  434.  
  435.  
  436. Public void Number_Greater_Than_Or_Equal()
  437. {
  438.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  439.  
  440.     Value_Register =
  441.     (*(Num_Ops.Number_Greater_Than_Or_Equal[
  442.                 Get_Number_Tower_Position( Top(1) )]))()
  443.         ? The_True_Object
  444.         : The_False_Object;
  445. }
  446.  
  447. /* Numerical operations with varying numbers of arguments */
  448.  
  449.  
  450. Private void Iterate_Over_Operands( Arg_Count , Op_Tower )
  451.  
  452.     Integer Arg_Count;
  453.     Procedure_Array Op_Tower;
  454. {
  455.     while ( Arg_Count > 1 )
  456.     {
  457.         Push( Value_Register );
  458.         Push( Top( Arg_Count ) );
  459.         Coerce_Args();
  460.         (*(Op_Tower[Get_Number_Tower_Position( Top(1) )]))();
  461.         Pop(2);
  462.         Arg_Count--;
  463.     }
  464.     Demote();
  465. }
  466.  
  467.  
  468.  
  469. Private void Varying_Number_Add()
  470. {
  471.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  472.  
  473.     if ( arg_count >= 2 )
  474.     {
  475.         Value_Register = Top(arg_count);
  476.         Iterate_Over_Operands( arg_count, Num_Ops.Number_Add );
  477.     }
  478.     else if ( arg_count == 1 )
  479.         Value_Register = Top( 1 );
  480.     else
  481.         Make_Fixnum_Number( 0 );
  482. }
  483.  
  484.  
  485.  
  486. Private void Varying_Number_Subtract()
  487. {
  488.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  489.  
  490.     if ( arg_count >= 2 )
  491.     {
  492.         Value_Register = Top(arg_count);
  493.         Iterate_Over_Operands( arg_count , Num_Ops.Number_Subtract);
  494.     }
  495.     else if (arg_count == 1 )
  496.     {
  497.         Make_Fixnum_Number( 0 );  /* treat as (- 0 arg) */
  498.         Iterate_Over_Operands( 2 , Num_Ops.Number_Subtract);
  499.     }
  500.     else
  501.         Display_Error( "At least 1 argument required in: " ,
  502.                    Expression_Register );
  503. }
  504.  
  505.  
  506.  
  507. Private void Varying_Number_Multiply()
  508. {
  509.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  510.  
  511.     if ( arg_count >= 2 )
  512.     {
  513.         Value_Register = Top(arg_count);
  514.         Iterate_Over_Operands( arg_count, Num_Ops.Number_Multiply );
  515.     }
  516.     else if ( arg_count == 1 )
  517.         Value_Register = Top( 1 );
  518.     else
  519.         Make_Fixnum_Number( 1 );
  520. }
  521.  
  522.  
  523.  
  524. Private void Varying_Number_Divide()
  525. {
  526.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  527.  
  528.     if ( arg_count >= 2 )
  529.     {
  530.         Value_Register = Top(arg_count);
  531.         Iterate_Over_Operands( arg_count , Num_Ops.Number_Divide );
  532.     }
  533.     else if (arg_count == 1 )
  534.     {
  535.         Make_Fixnum_Number( 1 );  /* treat as (/ 1 arg) */
  536.         Iterate_Over_Operands( 2 , Num_Ops.Number_Divide );
  537.     }
  538.     else
  539.         Display_Error( "At least 1 argument required in: " ,
  540.                    Expression_Register );
  541. }
  542.  
  543.  
  544.  
  545. Private void Varying_Number_Min()
  546. {
  547.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  548.  
  549.     if ( arg_count >= 2 )
  550.     {
  551.         Value_Register = Top(arg_count);
  552.         Iterate_Over_Operands( arg_count , Num_Ops.Number_Min );
  553.     }
  554.     else if (arg_count == 1 )
  555.     {
  556.         Value_Register = Top(arg_count);
  557.     }
  558.     else
  559.         Display_Error( "At least 1 argument required in: " ,
  560.                    Expression_Register );
  561. }
  562.  
  563.  
  564.  
  565. Private void Varying_Number_Max()
  566. {
  567.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  568.  
  569.     if ( arg_count >= 2 )
  570.     {
  571.         Value_Register = Top(arg_count);
  572.         Iterate_Over_Operands( arg_count , Num_Ops.Number_Max );
  573.     }
  574.     else if (arg_count == 1 )
  575.     {
  576.         Value_Register = Top(1);
  577.     }
  578.     else
  579.         Display_Error( "At least 1 argument required in: " ,
  580.                    Expression_Register );
  581. }
  582.  
  583.  
  584.  
  585. Private void Varying_Number_GCD()
  586. {
  587.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  588.  
  589.     if ( arg_count >= 2 )
  590.     {
  591.         Value_Register = Top(arg_count);
  592.         Iterate_Over_Operands( arg_count, Num_Ops.Number_GCD );
  593.     }
  594.     else if ( arg_count == 1 )
  595.     {
  596.         Make_Fixnum_Number( 0 );
  597.         Iterate_Over_Operands( 2 , Num_Ops.Number_GCD );
  598.     }
  599.     else
  600.         Make_Fixnum_Number( 0 );
  601. }
  602.  
  603.  
  604.  
  605. Private void Varying_Number_LCM()
  606. {
  607.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  608.  
  609.     if ( arg_count >= 2 )
  610.     {
  611.         Value_Register = Top(arg_count);
  612.         Iterate_Over_Operands( arg_count, Num_Ops.Number_LCM );
  613.     }
  614.     else if ( arg_count == 1 )
  615.     {
  616.         Make_Fixnum_Number( 0 );
  617.         Iterate_Over_Operands( 2 , Num_Ops.Number_LCM );
  618.     }
  619.     else
  620.         Make_Fixnum_Number( 1 );
  621. }
  622.  
  623.  
  624.  
  625. Public void Number_Add()
  626. {
  627.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  628.  
  629.     (*(Num_Ops.Number_Add[Get_Number_Tower_Position( Top(1) )]))();
  630.  
  631.     Demote() ;          /* To lowest possible position (in Value_Register) */
  632. }
  633.  
  634.  
  635.  
  636.  
  637. Public void Number_Subtract()
  638. {
  639.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  640.  
  641.     (*(Num_Ops.Number_Subtract[Get_Number_Tower_Position( Top(1) )]))();
  642.  
  643.     Demote() ;          /* To lowest possible position (in Value_Register) */
  644. }
  645.  
  646.  
  647.  
  648.  
  649. Public void Number_Multiply()
  650. {
  651.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  652.  
  653.     (*(Num_Ops.Number_Multiply[Get_Number_Tower_Position( Top(1) )]))();
  654.  
  655.     Demote() ;          /* To lowest possible position (in Value_Register) */
  656. }
  657.  
  658.  
  659.  
  660.  
  661. Public void Number_Divide()
  662. {
  663.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  664.  
  665.     (*(Num_Ops.Number_Divide[Get_Number_Tower_Position( Top(1) )]))();
  666.  
  667.     Demote() ;          /* To lowest possible position (in Value_Register) */
  668. }
  669.  
  670.  
  671.  
  672.  
  673. Public void Number_Quotient()
  674. {
  675.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  676.  
  677.     (*(Num_Ops.Number_Quotient[Get_Number_Tower_Position( Top(1) )]))();
  678.  
  679.     Demote() ;          /* To lowest possible position (in Value_Register) */
  680. }
  681.  
  682.  
  683.  
  684.  
  685. Public void Number_Remainder()
  686. {
  687.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  688.  
  689.     (*(Num_Ops.Number_Remainder[Get_Number_Tower_Position( Top(1) )]))();
  690.  
  691.     Demote() ;          /* To lowest possible position (in Value_Register) */
  692. }
  693.  
  694.  
  695.  
  696.  
  697. Public void Number_Modulo()
  698. {
  699.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  700.  
  701.     (*(Num_Ops.Number_Modulo[Get_Number_Tower_Position( Top(1) )]))();
  702.  
  703.     Demote() ;          /* To lowest possible position (in Value_Register) */
  704. }
  705.  
  706.  
  707.  
  708. Public void Number_Negate()
  709. {
  710.     (*(Num_Ops.Number_Negate[Get_Number_Tower_Position( Top(1) )]))();
  711.  
  712.     Demote() ;  /* To lowest possible position (in Value_Register) */
  713. }
  714.  
  715.  
  716.  
  717. Public void Number_Abs()
  718. {
  719.     (*(Num_Ops.Number_Abs[Get_Number_Tower_Position( Top(1) )]))();
  720.  
  721.     Demote() ;  /* To lowest possible position (in Value_Register) */
  722. }
  723.  
  724.  
  725.  
  726.  
  727. Public void Number_Numerator()
  728. {
  729.     (*(Num_Ops.Number_Numerator[Get_Number_Tower_Position( Top(1) )]))();
  730.  
  731.     Demote() ;  /* To lowest possible position (in Value_Register) */
  732. }
  733.  
  734.  
  735.  
  736. Public void Number_Denominator()
  737. {
  738.     (*(Num_Ops.Number_Denominator[Get_Number_Tower_Position( Top(1) )]))();
  739.  
  740.     Demote() ;  /* To lowest possible position (in Value_Register) */
  741. }
  742.  
  743.  
  744. /*
  745. Private void SS( label )
  746.  
  747.     String    label;
  748. {
  749.     Integer i;
  750.     Output( "\n" );
  751.     Output( label );
  752.     Output( ": " );
  753.     for ( i = 1 ; i <= 10 && i <= Arg_Stack_Ptr; i++ )
  754.     {
  755.         Show_Object( Top(i) , 12 );
  756.         Output( ", " );
  757.     }
  758. }
  759. */
  760.  
  761.  
  762.  
  763. Private void Real_To_Integer( real )
  764.  
  765.     Double real;
  766. {
  767.     Double    quotient;
  768.     Integer remainder;
  769.     quotient = floor( real / RADIX );
  770.     remainder = real - (quotient * RADIX);
  771.  
  772.     Integer_To_Number( remainder );
  773.  
  774.     if ( quotient > 0.0 )
  775.     {
  776.         Push( Value_Register );
  777.         Real_To_Integer( quotient );
  778.         Push( Value_Register );
  779.         Integer_To_Number( RADIX );
  780.         Push( Value_Register );
  781.         Number_Multiply();
  782.         Pop( 2 );
  783.         Push( Value_Register );
  784.         Number_Add();
  785.         Pop( 2 );
  786.     }
  787. }
  788.  
  789.  
  790. Public void SS( label )
  791.     String    label;
  792. {
  793.     Integer i;
  794.     Output( "\n" ); Output( label ); Output( ": " );
  795.     for ( i = 1; i <= 8 && i <= Arg_Stack_Ptr; i++ );
  796.     {
  797.         Show_Object( Top(i), 1 );
  798.         if ( i < 8 && i < Arg_Stack_Ptr ) Output( ", " );
  799.     }
  800.  
  801. }
  802.  
  803.  
  804. Public void Number_Rationalize()        /* (rationalize x eps) */
  805. {
  806.     Boolean negative_input = FALSE;
  807.     Boolean exact = Is_Exact_Number( Top(1) ) && Is_Exact_Number( Top(2) );
  808.  
  809.     /* Check Domains of Inputs */
  810.  
  811.     if  ( Is_Complex(Top(1)) )
  812.     {
  813.         Display_Error( "Complex argument to rationalize: " , Top(1) );
  814.     }
  815.     else if  ( Is_Complex(Top(2)) )
  816.     {
  817.         Display_Error( "Complex argument to rationalize: " , Top(2) );
  818.     }
  819.  
  820.     /* Work with absolute values */
  821.  
  822.     Push( Top( 1 ) );
  823.     Number_Abs(); Pop(1);
  824.     Replace( 1 , Value_Register );  /* |eps| */
  825.     Push( Top(2) );
  826.     Is_Number_Negative(); Pop(1);
  827.     negative_input = (Value_Register == The_True_Object);
  828.     Push( Top( 2 ) );
  829.     Number_Abs(); Pop(1);
  830.     Replace( 2 , Value_Register );  /* |x| */
  831.  
  832.     /* Construct the continued fraction */
  833.  
  834.     Push( Value_Register );         /* y = x */
  835.     Push( Value_Register );
  836.     Number_Truncate(); Pop(1);
  837.     if ( Is_Real( Value_Register ) )
  838.     {
  839.         Real_To_Integer( Get_Number_Real_Value( Value_Register ) );
  840.     }
  841.     Push( Value_Register );         /* a = truncate( |x| */
  842.     Push( Value_Register );         /* num = truncate( |x| ) */
  843.     Integer_To_Number( 1 );
  844.     Push( Value_Register );         /* den = 1 */
  845.     Push( Value_Register );         /* oldnum = 1 */
  846.     Integer_To_Number( 0 );
  847.     Push( Value_Register );         /* oldden = 0 */
  848.  
  849.     /* Stack =  oldden, oldnum, den, num, a, y, |epsilon|, |x| */
  850.  
  851.     while ( TRUE )
  852.     {
  853.         /* Rational found when |x - num/den| <= |epsilon| */
  854.  
  855.         Push( Top(3) );
  856.         Is_Number_Zero(); Pop(1);
  857.         if ( Value_Register == The_False_Object )
  858.         {
  859.             /* den != 0  */
  860.  
  861.             Push( Top(8) ); /* x */
  862.             Push( Top(5) ); /* num */
  863.             Push( Top(5) ); /* den */
  864.             Make_Rational_Number(); Pop(2);
  865.             Push( Value_Register );
  866.             Number_Subtract();  Pop(2);
  867.             Push( Value_Register );
  868.             Number_Abs(); Pop(1);
  869.             Push( Value_Register ); /* |x - num/den| */
  870.             Push( Top(8) );         /* |epsilon| */
  871.             Number_Less_Than_Or_Equal(); Pop(2);
  872.  
  873.             if ( Value_Register == The_True_Object )
  874.             {
  875.                 /* |x - num/den| <= |epsilon| */
  876.  
  877.                 Push( Top(4) ); /* num */
  878.                 Push( Top(4) ); /* den */
  879.                 Make_Rational_Number(); /* num/den */
  880.                 Pop(2);
  881.  
  882.                 /* Negate if necessary */
  883.  
  884.                 if ( negative_input )
  885.                 {
  886.                     Push( Value_Register );
  887.                     Number_Negate(); Pop(1);
  888.                 }
  889.                 Is_Exact_Number( Value_Register ) = exact;
  890.                 Pop(6);
  891.                 return;
  892.             }
  893.         }
  894.  
  895.         /* Otherwise, compute the next fraction */
  896.  
  897.         /* Stack =  oldden, oldnum, den, num, a, y, |epsilon|, |x| */
  898.  
  899.         Integer_To_Number( 1 );
  900.         Push( Value_Register ); /* 1 */
  901.         Push( Top(7) );         /* y */
  902.         Push( Top(7) );         /* a */
  903.         Number_Subtract(); Pop(2);
  904.         Push( Value_Register );
  905.         Number_Divide(); Pop(2);
  906.         Replace( 6 , Value_Register );  /* y = 1/(y - a)  */
  907.  
  908.         Push( Value_Register );
  909.         Number_Truncate(); Pop(1);
  910.         if ( Is_Real( Value_Register ) )
  911.         {
  912.             Real_To_Integer( Get_Number_Real_Value( Value_Register ) );
  913.         }
  914.         Replace( 5 , Value_Register );  /* a = truncate( y )  */
  915.  
  916.         Push( Top(2) ); /* oldnum */
  917.         Push( Top(6) ); /* a */
  918.         Push( Top(6) ); /* num */
  919.         Number_Multiply(); Pop(2);
  920.         Push( Value_Register );
  921.         Number_Add(); Pop(2);           /* newnum = oldnum + a * num  */
  922.  
  923.         Replace( 2 , Top(4) );          /* oldnum = num  */
  924.         Replace( 4 , Value_Register );  /* num = newnum  */
  925.  
  926.         Push( Top(1) ); /* oldden */
  927.         Push( Top(6) ); /* a */
  928.         Push( Top(5) ); /* den */
  929.         Number_Multiply(); Pop(2);
  930.         Push( Value_Register );
  931.         Number_Add(); Pop(2);           /* newden = oldden + a * den  */
  932.  
  933.         Replace( 1 , Top(3) );          /* oldden = den  */
  934.         Replace( 3 , Value_Register );  /* den = newden  */
  935.     }
  936. }
  937.  
  938.  
  939.  
  940. Public void Number_Max()
  941. {
  942.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  943.  
  944.     (*(Num_Ops.Number_Max[Get_Number_Tower_Position( Top(1) )]))();
  945.  
  946.     Demote() ;          /* To lowest possible position (in Value_Register) */
  947. }
  948.  
  949.  
  950.  
  951.  
  952. Public void Number_Min()
  953. {
  954.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  955.  
  956.     (*(Num_Ops.Number_Min[Get_Number_Tower_Position( Top(1) )]))();
  957.  
  958.     Demote() ;          /* To lowest possible position (in Value_Register) */
  959. }
  960.  
  961.  
  962.  
  963.  
  964. Public void Number_GCD()
  965. {
  966.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  967.  
  968.     (*(Num_Ops.Number_GCD[Get_Number_Tower_Position( Top(1) )]))();
  969.  
  970.     Demote() ;          /* To lowest possible position (in Value_Register) */
  971. }
  972.  
  973.  
  974.  
  975. Public void Number_LCM()
  976. {
  977.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  978.  
  979.     (*(Num_Ops.Number_LCM[Get_Number_Tower_Position( Top(1) )]))();
  980.  
  981.     Demote() ;          /* To lowest possible position (in Value_Register) */
  982. }
  983.  
  984.  
  985.  
  986.  
  987. Public void Number_Floor()
  988. {
  989.     (*(Num_Ops.Number_Floor[Get_Number_Tower_Position( Top(1) )]))();
  990.  
  991.     Demote() ;  /* To lowest possible position (in Value_Register) */
  992. }
  993.  
  994.  
  995.  
  996. Public void Number_Ceiling()
  997. {
  998.     (*(Num_Ops.Number_Ceiling[Get_Number_Tower_Position( Top(1) )]))();
  999.  
  1000.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1001. }
  1002.  
  1003.  
  1004.  
  1005. Public void Number_Truncate()
  1006. {
  1007.     (*(Num_Ops.Number_Truncate[Get_Number_Tower_Position( Top(1) )]))();
  1008.  
  1009.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1010. }
  1011.  
  1012.  
  1013.  
  1014. Public void Number_Round()
  1015. {
  1016.     (*(Num_Ops.Number_Round[Get_Number_Tower_Position( Top(1) )]))();
  1017.  
  1018.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1019. }
  1020.  
  1021.  
  1022.  
  1023.  
  1024. Public void Number_Sqrt()
  1025. {
  1026.     (*(Num_Ops.Number_Sqrt[Get_Number_Tower_Position( Top(1) )]))();
  1027.  
  1028.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1029. }
  1030.  
  1031.  
  1032.  
  1033. Public void Number_Exp()
  1034. {
  1035.     (*(Num_Ops.Number_Exp[Get_Number_Tower_Position( Top(1) )]))();
  1036.  
  1037.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1038. }
  1039.  
  1040.  
  1041.  
  1042. Public void Number_Log()
  1043. {
  1044.     (*(Num_Ops.Number_Log[Get_Number_Tower_Position( Top(1) )]))();
  1045.  
  1046.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1047. }
  1048.  
  1049.  
  1050.  
  1051. Public void Number_Expt()
  1052. {
  1053.     /* Must check one domain restriction here before coercion occurs */
  1054.  
  1055.     if(Get_Number_Tower_Position(Top(1)) > BIGNUM_LEVEL)
  1056.     {
  1057.         Push(Top(2));
  1058.         Is_Number_Negative();
  1059.         if(Value_Register == The_True_Object)
  1060.         {
  1061.         Pop(1);
  1062.         Error("Domain error for expt");
  1063.         }
  1064.         Pop(1);
  1065.     }
  1066.  
  1067.     /* Don't coerce args.  Pick specific routine based only on exponent */
  1068.  
  1069.     (*(Num_Ops.Number_Expt[Get_Number_Tower_Position( Top(1) )]))();
  1070.  
  1071.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1072. }
  1073.  
  1074.  
  1075.  
  1076. Public void Number_Sin()
  1077. {
  1078.     (*(Num_Ops.Number_Sin[Get_Number_Tower_Position( Top(1) )]))();
  1079.  
  1080.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1081. }
  1082.  
  1083.  
  1084.  
  1085.  
  1086. Public void Number_Cos()
  1087. {
  1088.     (*(Num_Ops.Number_Cos[Get_Number_Tower_Position( Top(1) )]))();
  1089.  
  1090.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1091. }
  1092.  
  1093.  
  1094.  
  1095. Public void Number_Tan()
  1096. {
  1097.     (*(Num_Ops.Number_Tan[Get_Number_Tower_Position( Top(1) )]))();
  1098.  
  1099.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1100. }
  1101.  
  1102.  
  1103.  
  1104. Public void Number_Asin()
  1105. {
  1106.     (*(Num_Ops.Number_Asin[Get_Number_Tower_Position( Top(1) )]))();
  1107.  
  1108.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1109. }
  1110.  
  1111.  
  1112.  
  1113. Public void Number_Acos()
  1114. {
  1115.     (*(Num_Ops.Number_Acos[Get_Number_Tower_Position( Top(1) )]))();
  1116.  
  1117.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1118. }
  1119.  
  1120.  
  1121.  
  1122. Public void Number_Atan()
  1123. {
  1124.     (*(Num_Ops.Number_Atan[Get_Number_Tower_Position( Top(1) )]))();
  1125.  
  1126.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1127. }
  1128.  
  1129.  
  1130.  
  1131. Public void Number_Atan2()
  1132. {
  1133.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  1134.  
  1135.     (*(Num_Ops.Number_Atan2[Get_Number_Tower_Position( Top(1) )]))();
  1136.  
  1137.     Demote() ;          /* To lowest possible position (in Value_Register) */
  1138. }
  1139.  
  1140.  
  1141.  
  1142. Public void Number_Exact_To_Inexact()
  1143. {
  1144.     (*(Num_Ops.Number_Exact_To_Inexact[Get_Number_Tower_Position( Top(1) )]))();
  1145.  
  1146.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1147. }
  1148.  
  1149.  
  1150.  
  1151. Public void Number_Inexact_To_Exact()
  1152. {
  1153.     (*(Num_Ops.Number_Inexact_To_Exact[Get_Number_Tower_Position( Top(1) )]))();
  1154.  
  1155.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1156. }
  1157.  
  1158.  
  1159.  
  1160. Public void Number_To_String()
  1161. {
  1162.     (*(Num_Ops.Number_To_String[Get_Number_Tower_Position( Top(2) )]))();
  1163. }
  1164.  
  1165.  
  1166.  
  1167. Public void Number_Make_Rectangular()
  1168. {
  1169.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  1170.  
  1171.     (*(Num_Ops.Number_Make_Rectangular[Get_Number_Tower_Position( Top(1) )]))();
  1172.  
  1173.     Demote() ;          /* To lowest possible position (in Value_Register) */
  1174. }
  1175.  
  1176.  
  1177.  
  1178. Public void Number_Make_Polar()
  1179. {
  1180.     Coerce_Args();      /* Promote arg of lower tower posn to posn of other. */
  1181.  
  1182.     (*(Num_Ops.Number_Make_Polar[Get_Number_Tower_Position( Top(1) )]))();
  1183.  
  1184.     Demote() ;          /* To lowest possible position (in Value_Register) */
  1185. }
  1186.  
  1187.  
  1188.  
  1189. Public void Number_Real_Part()
  1190. {
  1191.     (*(Num_Ops.Number_Real_Part[Get_Number_Tower_Position( Top(1) )]))();
  1192.  
  1193.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1194. }
  1195.  
  1196.  
  1197.  
  1198. Public void Number_Imaginary_Part()
  1199. {
  1200.     (*(Num_Ops.Number_Imaginary_Part[Get_Number_Tower_Position( Top(1) )]))();
  1201.  
  1202.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1203. }
  1204.  
  1205.  
  1206.  
  1207. Public void Number_Magnitude()
  1208. {
  1209.     (*(Num_Ops.Number_Magnitude[Get_Number_Tower_Position( Top(1) )]))();
  1210.  
  1211.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1212. }
  1213.  
  1214.  
  1215.  
  1216. Public void Number_Angle()
  1217. {
  1218.     (*(Num_Ops.Number_Angle[Get_Number_Tower_Position( Top(1) )]))();
  1219.  
  1220.     Demote() ;  /* To lowest possible position (in Value_Register) */
  1221. }
  1222.  
  1223.  
  1224.  
  1225. Public Integer Number_Sign(num)
  1226.     Object num;
  1227.  
  1228. {
  1229.     Tower_Position argtype = Get_Number_Tower_Position(num);
  1230.  
  1231.     if( argtype == FIXNUM_LEVEL )
  1232.     {
  1233.         return ((Integer) (Get_Number_Fixnum_Value(num)) );
  1234.     }
  1235.  
  1236.     else if (argtype == BIGNUM_LEVEL)
  1237.     {
  1238.         return (Get_Number_Digit((num), Get_Number_Length(num) -1));
  1239.     }
  1240.  
  1241.     else
  1242.     {
  1243.         Panic("Incorrect argument for Number_Sign", num);
  1244.         return 0;
  1245.     }
  1246.  
  1247. }
  1248.  
  1249. /* PROMOTION */
  1250.  
  1251. Private void Coerce_Args()
  1252. {
  1253.     /* Coerce Argument of lower tower position to the (higher) position
  1254.        of the other argument.
  1255.     */
  1256.  
  1257.     Tower_Position    p1 = Get_Number_Tower_Position( Top(1) ),
  1258.             p2 = Get_Number_Tower_Position( Top(2) );
  1259.     if (p1 != p2)
  1260.     {
  1261.         if (p1 < p2)
  1262.             Promote( 1 , p2 );
  1263.         else
  1264.             Promote( 2 , p1 );
  1265.     }
  1266. }
  1267.  
  1268. Private void Coerce_Relational_Args()
  1269. {
  1270.     /* Coerce Argument of lower tower position to the (higher) position
  1271.        of the other argument.
  1272.     */
  1273.  
  1274.     Tower_Position    p1 = Get_Number_Tower_Position( Top(1) ),
  1275.             p2 = Get_Number_Tower_Position( Top(2) );
  1276.  
  1277.     if (p1 != p2)
  1278.     {
  1279.         /* If comparing inexacts to exacts then we want to
  1280.            force the inexacts to be exacts */
  1281.  
  1282.         if (p1 == REAL_LEVEL && p2 <= RATIONAL_LEVEL)
  1283.         {
  1284.             Number_Inexact_To_Exact();
  1285.             Replace( 1 , Value_Register );
  1286.         }
  1287.         else if (p2 == REAL_LEVEL && p1 <= RATIONAL_LEVEL)
  1288.         {
  1289.             Push( Top(2) );
  1290.             Number_Inexact_To_Exact(); Pop(1);
  1291.             Replace( 2 , Value_Register );
  1292.         }
  1293.  
  1294.         p1 = Get_Number_Tower_Position( Top(1) );
  1295.         p2 = Get_Number_Tower_Position( Top(2) );
  1296.  
  1297.         if (p1 < p2)
  1298.             Promote( 1 , p2 );
  1299.         else if (p2 < p1)
  1300.             Promote( 2 , p1 );
  1301.     }
  1302. }
  1303.  
  1304.  
  1305. /* Promote a number to the indicated tower_position |level|. */
  1306.  
  1307. Public void Promote( stkpos, level)
  1308.  
  1309.     Integer  stkpos;
  1310.     Tower_Position level;
  1311.  
  1312. {
  1313.  
  1314.     switch (Get_Number_Tower_Position(Top(stkpos)))
  1315.     {
  1316.         case FIXNUM_LEVEL:
  1317.         {
  1318.             if (level == FIXNUM_LEVEL) break;
  1319.  
  1320.  
  1321.             else if (level == REAL_LEVEL)
  1322.             {
  1323.                 Short val ;
  1324.                 val = Get_Number_Fixnum_Value(Top(stkpos));
  1325.                 Make_Real_Number( (Double) val);
  1326.                 Replace( stkpos , Value_Register );
  1327.                 break;
  1328.             }
  1329.             else
  1330.             {
  1331.                 Make_Bignum_Number(1);
  1332.                 Get_Number_Digit(Value_Register,0) =
  1333.                     Get_Number_Fixnum_Value( Top(stkpos) );
  1334.                 Replace( stkpos , Value_Register );
  1335.             }
  1336.         }
  1337.  
  1338.         case BIGNUM_LEVEL:
  1339.         {
  1340.             if (level == BIGNUM_LEVEL) break;
  1341.  
  1342.             else if (level == REAL_LEVEL)
  1343.             {
  1344.                 Double temp_real = 0;
  1345.                 Integer this_digit;
  1346.                 Double    cumulative_radix = 1.0;
  1347.                 Object    num = Top(stkpos);
  1348.  
  1349.                 for (this_digit = 0;
  1350.                     this_digit < Get_Number_Length(num);
  1351.                     this_digit++)
  1352.                 {
  1353.                     temp_real +=
  1354.                     cumulative_radix *
  1355.                       ((Get_Number_Digit(num,this_digit)>=0)
  1356.                        ?  Get_Number_Digit(num,this_digit)
  1357.                        : -Get_Number_Digit(num,this_digit));
  1358.                     cumulative_radix *= RADIX;
  1359.                 }
  1360.  
  1361.                 if (Number_Sign(num) < 0)
  1362.                     temp_real = - temp_real;
  1363.  
  1364.                 Make_Real_Number(temp_real);
  1365.                 Replace( stkpos , Value_Register );
  1366.                 break;
  1367.             }
  1368.             else
  1369.             {
  1370.                 Push( Top(stkpos) );
  1371.                 Make_Small_Bignum( 1 );
  1372.                 Push( Value_Register );
  1373.                 Make_Rational_Number();
  1374.                 Pop( 2 );
  1375.                 Replace( stkpos , Value_Register );
  1376.             }
  1377.         }
  1378.  
  1379.         case RATIONAL_LEVEL:
  1380.         {
  1381.             if (level == RATIONAL_LEVEL) break;
  1382.  
  1383.             Push( Get_Number_Rational_Numerator( Top(stkpos) ) );
  1384.             Push( Get_Number_Rational_Denominator( Top(stkpos+1) ) );
  1385.             Promote( 1 , REAL_LEVEL );
  1386.             Promote( 2 , REAL_LEVEL );
  1387.             Real_Divide();
  1388.             Pop( 2 );
  1389.             Replace( stkpos , Value_Register );
  1390.         }
  1391.  
  1392.         case REAL_LEVEL:
  1393.         {
  1394.             if (level == REAL_LEVEL) break;
  1395.  
  1396.             Make_Complex_Number( Get_Number_Real_Value(Top(stkpos)),
  1397.                          0.0 );
  1398.         }
  1399.         case COMPLEX_LEVEL:
  1400.         {
  1401.             if (level == COMPLEX_LEVEL) break;
  1402.  
  1403.             Panic("Unknown level to promote in promoting routine.");
  1404.         }
  1405.  
  1406.         default:
  1407.             Panic("Unknown tower position in promoting routine");
  1408.  
  1409.     }
  1410.  
  1411. }
  1412.  
  1413.  
  1414. /* DEMOTION */
  1415.  
  1416. /* Demote a number to the lowest tower position such that its value
  1417. does not lose anything, i.e., that if you promoted it again to the same level,
  1418. it would be the same value. */
  1419.  
  1420. Public void Demote()
  1421. {
  1422.  
  1423.     switch (Get_Number_Tower_Position( Value_Register ))
  1424.     {
  1425.         case COMPLEX_LEVEL:
  1426.             Demote_Complex_To_Real();
  1427.             break;
  1428.  
  1429.         case REAL_LEVEL:
  1430.             break;    /* Retaining inexactness */
  1431.  
  1432.         case RATIONAL_LEVEL:
  1433.             Demote_Rational_To_Integer();
  1434.             break;
  1435.  
  1436.         case BIGNUM_LEVEL:
  1437.             Demote_Bignum_To_Fixnum();
  1438.             break;
  1439.  
  1440.         case FIXNUM_LEVEL:
  1441.             break;
  1442.  
  1443.         default: Panic("Unknown tower position in demote routine");
  1444.     }
  1445. }
  1446.  
  1447.  
  1448.  
  1449.  
  1450. Private void Demote_Complex_To_Real()
  1451. {
  1452.  
  1453.     if (Get_Number_Complex_Imaginary_Part(Value_Register) == 0.0)
  1454.     {
  1455.         Make_Real_Number(Get_Number_Complex_Real_Part(Value_Register));
  1456.     }
  1457. }
  1458.  
  1459.  
  1460.  
  1461.  
  1462. Private void Demote_Rational_To_Integer()
  1463. {
  1464.     Object    denominator = Get_Number_Rational_Denominator( Value_Register );
  1465.  
  1466.     if ( Get_Number_Tower_Position( denominator ) == FIXNUM_LEVEL
  1467.         && Get_Number_Fixnum_Value( denominator ) == 1 )
  1468.     {
  1469.         Value_Register = Get_Number_Rational_Numerator(Value_Register);
  1470.     }
  1471. }
  1472.  
  1473.  
  1474.  
  1475. Private void Demote_Bignum_To_Fixnum()
  1476. {
  1477.     if (Get_Number_Length(Value_Register) == 1)
  1478.     {
  1479.         Make_Fixnum_Number(
  1480.             (Short) Get_Number_Digit(Value_Register, 0));
  1481.     }
  1482. }
  1483.  
  1484.  
  1485.  
  1486. /* MISC TRANSFER FUNCTIONS */
  1487.  
  1488. Public void Integer_To_Number(n)
  1489.  
  1490.     Integer n;
  1491. {
  1492.     if ( abs( n ) >= RADIX )
  1493.         Integer_To_Bignum( n );
  1494.     else
  1495.         Make_Fixnum_Number( n );
  1496. }
  1497.  
  1498.  
  1499.  
  1500. Public Integer Number_To_Integer(num)
  1501.  
  1502.    Object num;
  1503.  
  1504. {
  1505.     if ( Get_Number_Tower_Position( num ) == FIXNUM_LEVEL )
  1506.     {
  1507.         return( (Integer) Get_Number_Fixnum_Value( num ));
  1508.     }
  1509.     else if ( Get_Number_Tower_Position( num ) == BIGNUM_LEVEL )
  1510.     {
  1511.         return Bignum_To_Integer(num);
  1512.     }
  1513.     else
  1514.     {
  1515.         Display_Error("Integer wanted where non-integer supplied:",num);
  1516.         return( 0 );
  1517.     }
  1518. }
  1519.  
  1520.  
  1521.  
  1522. Public    String    Integer_To_Cstring( N , S , Radix , Zero_Padding )
  1523.  
  1524.     Integer N;
  1525.     String    S;
  1526.     Integer Radix;
  1527.     Integer Zero_Padding;
  1528. {
  1529.     Boolean negative = ( N < 0 );
  1530.     Integer integral = (N < 0) ? -N : N;
  1531.     Integer quotient = 0;
  1532.     Integer digit;
  1533.     Integer digits = 0;
  1534.     Integer index = MAX_CHARS_PER_INT;
  1535.  
  1536.     S[--index] = '\0';
  1537.  
  1538.     do
  1539.     {
  1540.         quotient = integral / Radix ;
  1541.         digit = integral - (quotient * Radix);
  1542.         integral = quotient;
  1543.         S[--index] = (Character) (digit<=9 ? digit+'0' : digit-10+'a');
  1544.         digits++;
  1545.     } while ( integral );
  1546.     if ( negative ) S[--index] = '-';
  1547.  
  1548.     if ( Zero_Padding )
  1549.     {
  1550.         /* We want to pad the number to the left with 0's  */
  1551.  
  1552.         while ( digits++ < Zero_Padding )
  1553.             S[--index] = '0';
  1554.     }
  1555.  
  1556.     return( &S[index] );
  1557. }
  1558.  
  1559. /* STRING-TO-NUMBER CONVERSION */
  1560.  
  1561. Private String    String_To_Complex();
  1562. Private String    String_To_Ureal();
  1563. Private String    String_To_Uinteger();
  1564. Private String    String_To_Ufractional();
  1565. Private Boolean Legal_Digit();
  1566. Private Integer Digit_Value();
  1567.  
  1568. typedef enum
  1569. {
  1570.     EXACT, INEXACT, UNDEFINED
  1571. } Exacttype;
  1572.  
  1573.  
  1574. Private void String_To_Number()
  1575. {
  1576.     String    S = Get_String_Value( Top(2) );
  1577.     Integer Radix = Number_To_Integer( Top(1) );
  1578.  
  1579.     Cstring_To_Number( S , Radix );
  1580. }
  1581.  
  1582.  
  1583. Public    void Cstring_To_Number( S , Radix )
  1584.  
  1585.     String    S;
  1586.     Integer Radix;
  1587. {
  1588.     /* <num R>    ->  <prefix R> <complex R> */
  1589.  
  1590.     String    original;
  1591.     Integer precision = 0;
  1592.     Exacttype exactness = UNDEFINED;
  1593.     original = S;
  1594.  
  1595.     /* Look for <prefix> */
  1596.  
  1597.     while ( *S == '#' )
  1598.     {
  1599.         S++;
  1600.         switch( *S++ )
  1601.         {
  1602.         case  'b':
  1603.             if ( ! Radix ) Radix = 2;
  1604.             else Error1( "Inconsistent radix in: %s", original );
  1605.             break;
  1606.  
  1607.         case  'o':
  1608.             if ( ! Radix ) Radix = 8;
  1609.             else Error1( "Inconsistent radix in: %s", original );
  1610.             break;
  1611.  
  1612.         case  'd':
  1613.             if ( ! Radix ) Radix = 10;
  1614.             else Error1( "Inconsistent radix in: %s", original );
  1615.             break;
  1616.  
  1617.         case  'x':
  1618.             if ( ! Radix ) Radix = 16;
  1619.             else Error1( "Inconsistent radix in: %s", original );
  1620.             break;
  1621.  
  1622.         case  'i':
  1623.             if ( exactness  != UNDEFINED ) exactness = INEXACT;
  1624.             else Error1( "Inconsistent exactness in: %s", original );
  1625.             break;
  1626.  
  1627.         case  'e':
  1628.             if ( exactness != UNDEFINED ) exactness = EXACT;
  1629.             else Error1( "Inconsistent exactness in: %s", original );
  1630.             break;
  1631.  
  1632.         case  's':
  1633.             if ( ! precision ) precision = 1;
  1634.             else Error1( "Inconsistent precision in: %s", original );
  1635.             break;
  1636.  
  1637.         case  'l':
  1638.             if ( ! precision ) precision = 2;
  1639.             else Error1( "Inconsistent precision in: %s", original );
  1640.             break;
  1641.  
  1642.         default:
  1643.             Error1( "Unknown prefix in: %s", original );
  1644.             break;
  1645.         }
  1646.     }
  1647.     if ( ! Radix ) Radix = 10;      /* by default */
  1648.  
  1649.     S = String_To_Complex( original , S , Radix );
  1650.     Demote();
  1651.  
  1652.     if ( *S )
  1653.     {
  1654.         Error1( "Ill-formed numeric constant: <%s>", original );
  1655.     }
  1656.  
  1657.     /* Finally, take account of any #e/#i prefix */
  1658.  
  1659.     if ( exactness == INEXACT && Is_Exact_Number( Value_Register ) )
  1660.     {
  1661.         Push( Value_Register );
  1662.         Number_Exact_To_Inexact(); Pop(1);
  1663.     }
  1664.     else if ( exactness == EXACT && !Is_Exact_Number( Value_Register ) )
  1665.     {
  1666.         Push( Value_Register );
  1667.         Number_Inexact_To_Exact(); Pop(1);
  1668.     }
  1669. }
  1670.  
  1671.  
  1672.  
  1673. Private String String_To_Complex( Original ,  S , Radix )
  1674.  
  1675.     String    Original;
  1676.     String    S;
  1677.     Integer Radix;
  1678. {
  1679.     /*  <complex R> ->  +i    |  -i  |  <real R>  |  <real R> @ <real R>
  1680.             |   <real R> [+|-] <ureal R> i    |  <real R> [+|-] i
  1681.             |   <real R> i
  1682.  
  1683.         <real R>    ->  {+|-} <ureal R>
  1684.     */
  1685.  
  1686.     Boolean negative1 = FALSE;
  1687.     Boolean negative2 = FALSE;
  1688.  
  1689.     /* Possible sign */
  1690.  
  1691.     if ( *S == '+' )
  1692.     {
  1693.         S++ ;
  1694.         /* Simple imaginary? */
  1695.         if ( *S == 'i' )
  1696.         {
  1697.             S++;
  1698.             Make_Complex_Number( 0.0 , 1.0 );
  1699.             return( S );
  1700.         }
  1701.     }
  1702.     else if ( *S == '-' )
  1703.     {
  1704.         S++;
  1705.         negative1 = TRUE;
  1706.         /* Simple imaginary? */
  1707.         if ( *S == 'i' )
  1708.         {
  1709.             S++;
  1710.             Make_Complex_Number( 0.0 , -1.0 );
  1711.             return( S );
  1712.         }
  1713.     }
  1714.  
  1715.     S = String_To_Ureal( Original , S , Radix );
  1716.  
  1717.     if ( negative1 )
  1718.     {
  1719.         Push( Value_Register );
  1720.         Number_Negate(); Pop(1);
  1721.     }
  1722.  
  1723.     if ( *S )
  1724.     {
  1725.         Push( Value_Register );
  1726.         switch( *S++ )
  1727.         {
  1728.         case  '@':
  1729.             /* Possible sign */
  1730.  
  1731.             if ( *S == '+' )
  1732.                 S++ ;
  1733.             else if ( *S == '-' )
  1734.             {
  1735.                 S++;
  1736.                 negative2 = TRUE;
  1737.             }
  1738.  
  1739.             S = String_To_Ureal( Original , S , Radix );
  1740.             if ( negative2 )
  1741.             {
  1742.                 Push( Value_Register );
  1743.                 Number_Negate(); Pop(1);
  1744.             }
  1745.             Push( Value_Register );
  1746.             Promote( 1 , REAL_LEVEL );
  1747.             Promote( 2 , REAL_LEVEL );
  1748.             Make_Complex_Number(
  1749.                 cos( Get_Number_Real_Value( Top(1) ) )
  1750.                 * Get_Number_Real_Value( Top(2) ),
  1751.                 sin( Get_Number_Real_Value( Top(1) ) )
  1752.                 * Get_Number_Real_Value( Top(2) ) );
  1753.             Pop(2) ;
  1754.             return( S );
  1755.         case  '-':
  1756.             negative2 = TRUE;
  1757.         case  '+':
  1758.             if ( *S == 'i' )
  1759.             {
  1760.                 Make_Real_Number( negative2 ? -1.0 : 1.0 );
  1761.                 Push( Value_Register );
  1762.             }
  1763.             else
  1764.             {
  1765.                 S = String_To_Ureal( Original , S , Radix );
  1766.                 if ( negative2 )
  1767.                 {
  1768.                     Push( Value_Register );
  1769.                     Number_Negate(); Pop(1);
  1770.                 }
  1771.                 Push( Value_Register );
  1772.             }
  1773.             Promote( 1 , REAL_LEVEL );
  1774.             Promote( 2 , REAL_LEVEL );
  1775.             Make_Complex_Number( Get_Number_Real_Value( Top(2) ),
  1776.                          Get_Number_Real_Value( Top(1) ) );
  1777.             Pop(2);
  1778.             if ( *S++ != 'i')
  1779.             {
  1780.                 Error1( "Ill-formed numeric constant: %s" ,
  1781.                     Original );
  1782.             }
  1783.             return( S );
  1784.  
  1785.         case 'i':
  1786.             Promote( 1 , REAL_LEVEL );
  1787.             Make_Complex_Number(0.0, Get_Number_Real_Value(Top(1)));
  1788.             Pop(1);
  1789.             return( S );
  1790.  
  1791.         default:
  1792.             Error1( "Ill-formed constant: <%s>", Original );
  1793.         }
  1794.     }
  1795.     return( S );
  1796. }
  1797.  
  1798.  
  1799. Private String    String_To_Ureal( Original , S , Radix )
  1800.  
  1801.     String    Original;
  1802.     String    S;
  1803.     Integer Radix;
  1804. {
  1805.     /*  <ureal R>    ->  <uinteger R>  |  <uinteger R> / <uinteger R>
  1806.             |   <float R>
  1807.  
  1808.         <float R>    ->  <uinteger R> <suffix>  |  . <ufractional R> <suffix>
  1809.             |   <uinteger R> . <ufractional R> <suffix>
  1810.             |   . #* <suffix>
  1811.  
  1812.         <suffix>    ->  <empty>  |    <exp mark> {+|-} <digit R>+
  1813.  
  1814.         <exp mark>    ->  e  |  s  |    f  |  d  |  l
  1815.     */
  1816.  
  1817.     /* Scan first part of number */
  1818.  
  1819.     if ( *S  == '.' )
  1820.     {
  1821.         Make_Real_Number( 0.0 );
  1822.     }
  1823.     else
  1824.     {
  1825.         S = String_To_Uinteger( Original , S , Radix );
  1826.     }
  1827.  
  1828.     /* Is there more ? */
  1829.  
  1830.     if ( *S == '.' )
  1831.     {
  1832.         Push( Value_Register );
  1833.         if ( Radix != 10 )
  1834.         {
  1835.             Error1( "Non-decimal real: %s" , Original );
  1836.         }
  1837.         S++;
  1838.         S = String_To_Ufractional( Original , S , Radix );
  1839.         Push( Value_Register );
  1840.         Number_Add(); Pop(2);
  1841.     }
  1842.     else if ( *S == '/' )
  1843.     {
  1844.         Push( Value_Register );
  1845.         S++;
  1846.         S = String_To_Uinteger( Original , S , Radix );
  1847.         Push( Value_Register );
  1848.         Make_Rational_Number(); Pop(2);
  1849.         return( S );
  1850.     }
  1851.  
  1852.     if ( *S=='e' || *S=='s' || *S=='f' || *S=='d' || *S=='l' )
  1853.     {
  1854.         /* all exponent marks map to e in UMB Scheme */
  1855.  
  1856.         Boolean negative = FALSE;
  1857.  
  1858.         Push( Value_Register );
  1859.         Promote( 1 , REAL_LEVEL );
  1860.         if ( Radix != 10 )
  1861.         {
  1862.             Error1( "Non-decimal real: %s" , Original );
  1863.         }
  1864.  
  1865.         S++;
  1866.         Integer_To_Number( Radix );
  1867.         Push( Value_Register );                 /* Radix */
  1868.  
  1869.         /* Possible sign */
  1870.  
  1871.         if ( *S == '+' )
  1872.             S++ ;
  1873.         else if ( *S == '-' )
  1874.         {
  1875.             S++;
  1876.             negative = TRUE;
  1877.         }
  1878.         S = String_To_Uinteger( Original , S , Radix );
  1879.         Push( Value_Register );
  1880.         if ( negative )
  1881.         {
  1882.             Number_Negate(); Pop(1);
  1883.             Push( Value_Register );
  1884.         }                    /* Exponent */
  1885.  
  1886.         Number_Expt(); Pop(2);
  1887.         Push( Value_Register );
  1888.         Number_Multiply(); Pop(2);
  1889.     }
  1890.     return( S );
  1891. }
  1892.  
  1893.  
  1894.  
  1895.  
  1896. Private String    String_To_Uinteger( Original , S , Radix )
  1897.  
  1898.     String    Original;
  1899.     String    S;
  1900.     Integer Radix;
  1901. {
  1902.     /*   <uinteger R>  ->  <digit R>+ #*   */
  1903.  
  1904.     if ( ! Legal_Digit( *S , Radix ) )
  1905.     {
  1906.         Error1( "Ill-formed numeric constant: <%s>" , Original );
  1907.     }
  1908.  
  1909.     Integer_To_Number( Digit_Value( *S++ ) );
  1910.     while ( Legal_Digit( *S , Radix ) )
  1911.     {
  1912.         Push( Value_Register );
  1913.         Integer_To_Number( Radix );
  1914.         Push( Value_Register );
  1915.         Number_Multiply(); Pop(2);
  1916.         Push( Value_Register );
  1917.         Integer_To_Number( Digit_Value( *S ) );
  1918.         Push( Value_Register );
  1919.         Number_Add(); Pop(2);
  1920.         S++;
  1921.     }
  1922.     while ( *S == '#' )
  1923.     {
  1924.         Push( Value_Register );
  1925.         Make_Real_Number( (Double) Radix );
  1926.         Push( Value_Register );
  1927.         Number_Multiply(); Pop(2);
  1928.         S++;
  1929.     }
  1930.     return( S );
  1931. }
  1932.  
  1933.  
  1934.  
  1935. Private String    String_To_Ufractional( Original , S , Radix )
  1936.  
  1937.     String    Original;
  1938.     String    S;
  1939.     Integer Radix;
  1940. {
  1941.     Double    fraction = 0.0;
  1942.     Double    factor = 1.0;
  1943.  
  1944.     while ( Legal_Digit( *S , Radix ) )
  1945.     {
  1946.         factor = factor / Radix;
  1947.         fraction += factor * Digit_Value( *S );
  1948.         S++;
  1949.     }
  1950.     while ( *S == '#' ) S++;
  1951.     Make_Real_Number( fraction );
  1952.     return( S );
  1953. }
  1954.  
  1955.  
  1956.  
  1957. Private Boolean Legal_Digit( Char , Radix )
  1958.  
  1959.     Character Char;
  1960.     Integer   Radix;
  1961. {
  1962.     Integer val = Digit_Value( Char );
  1963.     return( val >= 0 && val < Radix );
  1964. }
  1965.  
  1966.  
  1967. Private Boolean Digit_Value( Char )
  1968.  
  1969.     Character Char;
  1970. {
  1971.     return( isdigit( Char ) ? Char - '0' : Char - 'a' + 10 );
  1972. }
  1973.  
  1974. Public void Initialize_Number()
  1975. {
  1976.  
  1977.    Num_Ops.Is_Number_Zero[FIXNUM_LEVEL] = Is_Fixnum_Zero;
  1978.    Num_Ops.Is_Number_Zero[BIGNUM_LEVEL] = Is_Bignum_Zero;
  1979.    Num_Ops.Is_Number_Zero[RATIONAL_LEVEL] = Is_Rational_Zero;
  1980.    Num_Ops.Is_Number_Zero[REAL_LEVEL] = Is_Real_Zero;
  1981.    Num_Ops.Is_Number_Zero[COMPLEX_LEVEL] = Is_Complex_Zero;
  1982.  
  1983.    Num_Ops.Is_Number_Positive[FIXNUM_LEVEL] = Is_Fixnum_Positive;
  1984.    Num_Ops.Is_Number_Positive[BIGNUM_LEVEL] = Is_Bignum_Positive;
  1985.    Num_Ops.Is_Number_Positive[RATIONAL_LEVEL] = Is_Rational_Positive;
  1986.    Num_Ops.Is_Number_Positive[REAL_LEVEL] = Is_Real_Positive;
  1987.    Num_Ops.Is_Number_Positive[COMPLEX_LEVEL] = Is_Complex_Positive;
  1988.  
  1989.    Num_Ops.Is_Number_Negative[FIXNUM_LEVEL] = Is_Fixnum_Negative;
  1990.    Num_Ops.Is_Number_Negative[BIGNUM_LEVEL] = Is_Bignum_Negative;
  1991.    Num_Ops.Is_Number_Negative[RATIONAL_LEVEL] = Is_Rational_Negative;
  1992.    Num_Ops.Is_Number_Negative[REAL_LEVEL] = Is_Real_Negative;
  1993.    Num_Ops.Is_Number_Negative[COMPLEX_LEVEL] = Is_Complex_Negative;
  1994.  
  1995.    Num_Ops.Is_Number_Odd[FIXNUM_LEVEL] = Is_Fixnum_Odd;
  1996.    Num_Ops.Is_Number_Odd[BIGNUM_LEVEL] = Is_Bignum_Odd;
  1997.    Num_Ops.Is_Number_Odd[RATIONAL_LEVEL] = Is_Rational_Odd;
  1998.    Num_Ops.Is_Number_Odd[REAL_LEVEL] = Is_Real_Odd;
  1999.    Num_Ops.Is_Number_Odd[COMPLEX_LEVEL] = Is_Complex_Odd;
  2000.  
  2001.    Num_Ops.Is_Number_Even[FIXNUM_LEVEL] = Is_Fixnum_Even;
  2002.    Num_Ops.Is_Number_Even[BIGNUM_LEVEL] = Is_Bignum_Even;
  2003.    Num_Ops.Is_Number_Even[RATIONAL_LEVEL] = Is_Rational_Even;
  2004.    Num_Ops.Is_Number_Even[REAL_LEVEL] = Is_Real_Even;
  2005.    Num_Ops.Is_Number_Even[COMPLEX_LEVEL] = Is_Complex_Even;
  2006.  
  2007.    Num_Ops.Is_Number_Exact[FIXNUM_LEVEL] = Is_Fixnum_Exact;
  2008.    Num_Ops.Is_Number_Exact[BIGNUM_LEVEL] = Is_Bignum_Exact;
  2009.    Num_Ops.Is_Number_Exact[RATIONAL_LEVEL] = Is_Rational_Exact;
  2010.    Num_Ops.Is_Number_Exact[REAL_LEVEL] = Is_Real_Exact;
  2011.    Num_Ops.Is_Number_Exact[COMPLEX_LEVEL] = Is_Complex_Exact;
  2012.  
  2013.    Num_Ops.Is_Number_Inexact[FIXNUM_LEVEL] = Is_Fixnum_Inexact;
  2014.    Num_Ops.Is_Number_Inexact[BIGNUM_LEVEL] = Is_Bignum_Inexact;
  2015.    Num_Ops.Is_Number_Inexact[RATIONAL_LEVEL] = Is_Rational_Inexact;
  2016.    Num_Ops.Is_Number_Inexact[REAL_LEVEL] = Is_Real_Inexact;
  2017.    Num_Ops.Is_Number_Inexact[COMPLEX_LEVEL] = Is_Complex_Inexact;
  2018.  
  2019.    Num_Ops.Number_Equal[FIXNUM_LEVEL] = Fixnum_Equal;
  2020.    Num_Ops.Number_Equal[BIGNUM_LEVEL] = Bignum_Equal;
  2021.    Num_Ops.Number_Equal[RATIONAL_LEVEL] = Rational_Equal;
  2022.    Num_Ops.Number_Equal[REAL_LEVEL] = Real_Equal;
  2023.    Num_Ops.Number_Equal[COMPLEX_LEVEL] = Complex_Equal;
  2024.  
  2025.    Num_Ops.Number_Less_Than[FIXNUM_LEVEL] = Fixnum_Less_Than;
  2026.    Num_Ops.Number_Less_Than[BIGNUM_LEVEL] = Bignum_Less_Than;
  2027.    Num_Ops.Number_Less_Than[RATIONAL_LEVEL] = Rational_Less_Than;
  2028.    Num_Ops.Number_Less_Than[REAL_LEVEL] = Real_Less_Than;
  2029.    Num_Ops.Number_Less_Than[COMPLEX_LEVEL] = Complex_Less_Than;
  2030.  
  2031.    Num_Ops.Number_Greater_Than[FIXNUM_LEVEL] = Fixnum_Greater_Than;
  2032.    Num_Ops.Number_Greater_Than[BIGNUM_LEVEL] = Bignum_Greater_Than;
  2033.    Num_Ops.Number_Greater_Than[RATIONAL_LEVEL] = Rational_Greater_Than;
  2034.    Num_Ops.Number_Greater_Than[REAL_LEVEL] = Real_Greater_Than;
  2035.    Num_Ops.Number_Greater_Than[COMPLEX_LEVEL] = Complex_Greater_Than;
  2036.  
  2037.    Num_Ops.Number_Less_Than_Or_Equal[FIXNUM_LEVEL] = Fixnum_Less_Than_Or_Equal;
  2038.    Num_Ops.Number_Less_Than_Or_Equal[BIGNUM_LEVEL] = Bignum_Less_Than_Or_Equal;
  2039.    Num_Ops.Number_Less_Than_Or_Equal[RATIONAL_LEVEL] = Rational_Less_Than_Or_Equal;
  2040.    Num_Ops.Number_Less_Than_Or_Equal[REAL_LEVEL] = Real_Less_Than_Or_Equal;
  2041.    Num_Ops.Number_Less_Than_Or_Equal[COMPLEX_LEVEL] = Complex_Less_Than_Or_Equal;
  2042.  
  2043.    Num_Ops.Number_Greater_Than_Or_Equal[FIXNUM_LEVEL] = Fixnum_Greater_Than_Or_Equal;
  2044.    Num_Ops.Number_Greater_Than_Or_Equal[BIGNUM_LEVEL] = Bignum_Greater_Than_Or_Equal;
  2045.    Num_Ops.Number_Greater_Than_Or_Equal[RATIONAL_LEVEL] = Rational_Greater_Than_Or_Equal;
  2046.    Num_Ops.Number_Greater_Than_Or_Equal[REAL_LEVEL] = Real_Greater_Than_Or_Equal;
  2047.    Num_Ops.Number_Greater_Than_Or_Equal[COMPLEX_LEVEL] = Complex_Greater_Than_Or_Equal;
  2048.  
  2049.    Num_Ops.Number_Max[FIXNUM_LEVEL] = Fixnum_Max;
  2050.    Num_Ops.Number_Max[BIGNUM_LEVEL] = Bignum_Max;
  2051.    Num_Ops.Number_Max[RATIONAL_LEVEL] = Rational_Max;
  2052.    Num_Ops.Number_Max[REAL_LEVEL] = Real_Max;
  2053.    Num_Ops.Number_Max[COMPLEX_LEVEL] = Complex_Max;
  2054.  
  2055.    Num_Ops.Number_Min[FIXNUM_LEVEL] = Fixnum_Min;
  2056.    Num_Ops.Number_Min[BIGNUM_LEVEL] = Bignum_Min;
  2057.    Num_Ops.Number_Min[RATIONAL_LEVEL] = Rational_Min;
  2058.    Num_Ops.Number_Min[REAL_LEVEL] = Real_Min;
  2059.    Num_Ops.Number_Min[COMPLEX_LEVEL] = Complex_Min;
  2060.  
  2061.    Num_Ops.Number_Add[FIXNUM_LEVEL] = Fixnum_Add;
  2062.    Num_Ops.Number_Add[BIGNUM_LEVEL] = Bignum_Add;
  2063.    Num_Ops.Number_Add[RATIONAL_LEVEL] = Rational_Add;
  2064.    Num_Ops.Number_Add[REAL_LEVEL] = Real_Add;
  2065.    Num_Ops.Number_Add[COMPLEX_LEVEL] = Complex_Add;
  2066.  
  2067.    Num_Ops.Number_Subtract[FIXNUM_LEVEL] = Fixnum_Subtract;
  2068.    Num_Ops.Number_Subtract[BIGNUM_LEVEL] = Bignum_Subtract;
  2069.    Num_Ops.Number_Subtract[RATIONAL_LEVEL] = Rational_Subtract;
  2070.    Num_Ops.Number_Subtract[REAL_LEVEL] = Real_Subtract;
  2071.    Num_Ops.Number_Subtract[COMPLEX_LEVEL] = Complex_Subtract;
  2072.  
  2073.    Num_Ops.Number_Multiply[FIXNUM_LEVEL] = Fixnum_Multiply;
  2074.    Num_Ops.Number_Multiply[BIGNUM_LEVEL] = Bignum_Multiply;
  2075.    Num_Ops.Number_Multiply[RATIONAL_LEVEL] = Rational_Multiply;
  2076.    Num_Ops.Number_Multiply[REAL_LEVEL] = Real_Multiply;
  2077.    Num_Ops.Number_Multiply[COMPLEX_LEVEL] = Complex_Multiply;
  2078.  
  2079.    Num_Ops.Number_Divide[FIXNUM_LEVEL] = Fixnum_Divide;
  2080.    Num_Ops.Number_Divide[BIGNUM_LEVEL] = Bignum_Divide;
  2081.    Num_Ops.Number_Divide[RATIONAL_LEVEL] = Rational_Divide;
  2082.    Num_Ops.Number_Divide[REAL_LEVEL] = Real_Divide;
  2083.    Num_Ops.Number_Divide[COMPLEX_LEVEL] = Complex_Divide;
  2084.  
  2085.    Num_Ops.Number_Quotient[FIXNUM_LEVEL] = Fixnum_Quotient;
  2086.    Num_Ops.Number_Quotient[BIGNUM_LEVEL] = Bignum_Quotient;
  2087.    Num_Ops.Number_Quotient[RATIONAL_LEVEL] = Rational_Quotient;
  2088.    Num_Ops.Number_Quotient[REAL_LEVEL] = Real_Quotient;
  2089.    Num_Ops.Number_Quotient[COMPLEX_LEVEL] = Complex_Quotient;
  2090.  
  2091.    Num_Ops.Number_Remainder[FIXNUM_LEVEL] = Fixnum_Remainder;
  2092.    Num_Ops.Number_Remainder[BIGNUM_LEVEL] = Bignum_Remainder;
  2093.    Num_Ops.Number_Remainder[RATIONAL_LEVEL] = Rational_Remainder;
  2094.    Num_Ops.Number_Remainder[REAL_LEVEL] = Real_Remainder;
  2095.    Num_Ops.Number_Remainder[COMPLEX_LEVEL] = Complex_Remainder;
  2096.  
  2097.    Num_Ops.Number_Modulo[FIXNUM_LEVEL] = Fixnum_Modulo;
  2098.    Num_Ops.Number_Modulo[BIGNUM_LEVEL] = Bignum_Modulo;
  2099.    Num_Ops.Number_Modulo[RATIONAL_LEVEL] = Rational_Modulo;
  2100.    Num_Ops.Number_Modulo[REAL_LEVEL] = Real_Modulo;
  2101.    Num_Ops.Number_Modulo[COMPLEX_LEVEL] = Complex_Modulo;
  2102.  
  2103.    Num_Ops.Number_Negate[FIXNUM_LEVEL] = Fixnum_Negate;
  2104.    Num_Ops.Number_Negate[BIGNUM_LEVEL] = Bignum_Negate;
  2105.    Num_Ops.Number_Negate[RATIONAL_LEVEL] = Rational_Negate;
  2106.    Num_Ops.Number_Negate[REAL_LEVEL] = Real_Negate;
  2107.    Num_Ops.Number_Negate[COMPLEX_LEVEL] = Complex_Negate;
  2108.  
  2109.    Num_Ops.Number_Abs[FIXNUM_LEVEL] = Fixnum_Abs;
  2110.    Num_Ops.Number_Abs[BIGNUM_LEVEL] = Bignum_Abs;
  2111.    Num_Ops.Number_Abs[RATIONAL_LEVEL] = Rational_Abs;
  2112.    Num_Ops.Number_Abs[REAL_LEVEL] = Real_Abs;
  2113.    Num_Ops.Number_Abs[COMPLEX_LEVEL] = Complex_Abs;
  2114.  
  2115.    Num_Ops.Number_Numerator[FIXNUM_LEVEL] = Fixnum_Numerator;
  2116.    Num_Ops.Number_Numerator[BIGNUM_LEVEL] = Bignum_Numerator;
  2117.    Num_Ops.Number_Numerator[RATIONAL_LEVEL] = Rational_Numerator;
  2118.    Num_Ops.Number_Numerator[REAL_LEVEL] = Real_Numerator;
  2119.    Num_Ops.Number_Numerator[COMPLEX_LEVEL] = Complex_Numerator;
  2120.  
  2121.    Num_Ops.Number_Denominator[FIXNUM_LEVEL] = Fixnum_Denominator;
  2122.    Num_Ops.Number_Denominator[BIGNUM_LEVEL] = Bignum_Denominator;
  2123.    Num_Ops.Number_Denominator[RATIONAL_LEVEL] = Rational_Denominator;
  2124.    Num_Ops.Number_Denominator[REAL_LEVEL] = Real_Denominator;
  2125.    Num_Ops.Number_Denominator[COMPLEX_LEVEL] = Complex_Denominator;
  2126.  
  2127.    Num_Ops.Number_Rationalize[FIXNUM_LEVEL] = Fixnum_Rationalize;
  2128.    Num_Ops.Number_Rationalize[BIGNUM_LEVEL] = Bignum_Rationalize;
  2129.    Num_Ops.Number_Rationalize[RATIONAL_LEVEL] = Rational_Rationalize;
  2130.    Num_Ops.Number_Rationalize[REAL_LEVEL] = Real_Rationalize;
  2131.    Num_Ops.Number_Rationalize[COMPLEX_LEVEL] = Complex_Rationalize;
  2132.  
  2133.    Num_Ops.Number_Max[FIXNUM_LEVEL] = Fixnum_Max;
  2134.    Num_Ops.Number_Max[BIGNUM_LEVEL] = Bignum_Max;
  2135.    Num_Ops.Number_Max[RATIONAL_LEVEL] = Rational_Max;
  2136.    Num_Ops.Number_Max[REAL_LEVEL] = Real_Max;
  2137.    Num_Ops.Number_Max[COMPLEX_LEVEL] = Complex_Max;
  2138.  
  2139.    Num_Ops.Number_Min[FIXNUM_LEVEL] = Fixnum_Min;
  2140.    Num_Ops.Number_Min[BIGNUM_LEVEL] = Bignum_Min;
  2141.    Num_Ops.Number_Min[RATIONAL_LEVEL] = Rational_Min;
  2142.    Num_Ops.Number_Min[REAL_LEVEL] = Real_Min;
  2143.    Num_Ops.Number_Min[COMPLEX_LEVEL] = Complex_Min;
  2144.  
  2145.    Num_Ops.Number_GCD[FIXNUM_LEVEL] = Fixnum_GCD;
  2146.    Num_Ops.Number_GCD[BIGNUM_LEVEL] = Bignum_GCD;
  2147.    Num_Ops.Number_GCD[RATIONAL_LEVEL] = Rational_GCD;
  2148.    Num_Ops.Number_GCD[REAL_LEVEL] = Real_GCD;
  2149.    Num_Ops.Number_GCD[COMPLEX_LEVEL] = Complex_GCD;
  2150.  
  2151.    Num_Ops.Number_LCM[FIXNUM_LEVEL] = Fixnum_LCM;
  2152.    Num_Ops.Number_LCM[BIGNUM_LEVEL] = Bignum_LCM;
  2153.    Num_Ops.Number_LCM[RATIONAL_LEVEL] = Rational_LCM;
  2154.    Num_Ops.Number_LCM[REAL_LEVEL] = Real_LCM;
  2155.    Num_Ops.Number_LCM[COMPLEX_LEVEL] = Complex_LCM;
  2156.  
  2157.    Num_Ops.Number_Floor[FIXNUM_LEVEL] = Fixnum_Floor;
  2158.    Num_Ops.Number_Floor[BIGNUM_LEVEL] = Bignum_Floor;
  2159.    Num_Ops.Number_Floor[RATIONAL_LEVEL] = Rational_Floor;
  2160.    Num_Ops.Number_Floor[REAL_LEVEL] = Real_Floor;
  2161.    Num_Ops.Number_Floor[COMPLEX_LEVEL] = Complex_Floor;
  2162.  
  2163.    Num_Ops.Number_Ceiling[FIXNUM_LEVEL] = Fixnum_Ceiling;
  2164.    Num_Ops.Number_Ceiling[BIGNUM_LEVEL] = Bignum_Ceiling;
  2165.    Num_Ops.Number_Ceiling[RATIONAL_LEVEL] = Rational_Ceiling;
  2166.    Num_Ops.Number_Ceiling[REAL_LEVEL] = Real_Ceiling;
  2167.    Num_Ops.Number_Ceiling[COMPLEX_LEVEL] = Complex_Ceiling;
  2168.  
  2169.    Num_Ops.Number_Truncate[FIXNUM_LEVEL] = Fixnum_Truncate;
  2170.    Num_Ops.Number_Truncate[BIGNUM_LEVEL] = Bignum_Truncate;
  2171.    Num_Ops.Number_Truncate[RATIONAL_LEVEL] = Rational_Truncate;
  2172.    Num_Ops.Number_Truncate[REAL_LEVEL] = Real_Truncate;
  2173.    Num_Ops.Number_Truncate[COMPLEX_LEVEL] = Complex_Truncate;
  2174.  
  2175.    Num_Ops.Number_Round[FIXNUM_LEVEL] = Fixnum_Round;
  2176.    Num_Ops.Number_Round[BIGNUM_LEVEL] = Bignum_Round;
  2177.    Num_Ops.Number_Round[RATIONAL_LEVEL] = Rational_Round;
  2178.    Num_Ops.Number_Round[REAL_LEVEL] = Real_Round;
  2179.    Num_Ops.Number_Round[COMPLEX_LEVEL] = Complex_Round;
  2180.  
  2181.    Num_Ops.Number_Sqrt[FIXNUM_LEVEL] = Fixnum_Sqrt;
  2182.    Num_Ops.Number_Sqrt[BIGNUM_LEVEL] = Bignum_Sqrt;
  2183.    Num_Ops.Number_Sqrt[RATIONAL_LEVEL] = Rational_Sqrt;
  2184.    Num_Ops.Number_Sqrt[REAL_LEVEL] = Real_Sqrt;
  2185.    Num_Ops.Number_Sqrt[COMPLEX_LEVEL] = Complex_Sqrt;
  2186.  
  2187.    Num_Ops.Number_Exp[FIXNUM_LEVEL] = Fixnum_Exp;
  2188.    Num_Ops.Number_Exp[BIGNUM_LEVEL] = Bignum_Exp;
  2189.    Num_Ops.Number_Exp[RATIONAL_LEVEL] = Rational_Exp;
  2190.    Num_Ops.Number_Exp[REAL_LEVEL] = Real_Exp;
  2191.    Num_Ops.Number_Exp[COMPLEX_LEVEL] = Complex_Exp;
  2192.  
  2193.    Num_Ops.Number_Log[FIXNUM_LEVEL] = Fixnum_Log;
  2194.    Num_Ops.Number_Log[BIGNUM_LEVEL] = Bignum_Log;
  2195.    Num_Ops.Number_Log[RATIONAL_LEVEL] = Rational_Log;
  2196.    Num_Ops.Number_Log[REAL_LEVEL] = Real_Log;
  2197.    Num_Ops.Number_Log[COMPLEX_LEVEL] = Complex_Log;
  2198.  
  2199.    Num_Ops.Number_Expt[FIXNUM_LEVEL] = Fixnum_Expt;
  2200.    Num_Ops.Number_Expt[BIGNUM_LEVEL] = Bignum_Expt;
  2201.    Num_Ops.Number_Expt[RATIONAL_LEVEL] = Rational_Expt;
  2202.    Num_Ops.Number_Expt[REAL_LEVEL] = Real_Expt;
  2203.    Num_Ops.Number_Expt[COMPLEX_LEVEL] = Complex_Expt;
  2204.  
  2205.    Num_Ops.Number_Sin[FIXNUM_LEVEL] = Fixnum_Sin;
  2206.    Num_Ops.Number_Sin[BIGNUM_LEVEL] = Bignum_Sin;
  2207.    Num_Ops.Number_Sin[RATIONAL_LEVEL] = Rational_Sin;
  2208.    Num_Ops.Number_Sin[REAL_LEVEL] = Real_Sin;
  2209.    Num_Ops.Number_Sin[COMPLEX_LEVEL] = Complex_Sin;
  2210.  
  2211.    Num_Ops.Number_Cos[FIXNUM_LEVEL] = Fixnum_Cos;
  2212.    Num_Ops.Number_Cos[BIGNUM_LEVEL] = Bignum_Cos;
  2213.    Num_Ops.Number_Cos[RATIONAL_LEVEL] = Rational_Cos;
  2214.    Num_Ops.Number_Cos[REAL_LEVEL] = Real_Cos;
  2215.    Num_Ops.Number_Cos[COMPLEX_LEVEL] = Complex_Cos;
  2216.  
  2217.    Num_Ops.Number_Tan[FIXNUM_LEVEL] = Fixnum_Tan;
  2218.    Num_Ops.Number_Tan[BIGNUM_LEVEL] = Bignum_Tan;
  2219.    Num_Ops.Number_Tan[RATIONAL_LEVEL] = Rational_Tan;
  2220.    Num_Ops.Number_Tan[REAL_LEVEL] = Real_Tan;
  2221.    Num_Ops.Number_Tan[COMPLEX_LEVEL] = Complex_Tan;
  2222.  
  2223.    Num_Ops.Number_Asin[FIXNUM_LEVEL] = Fixnum_Asin;
  2224.    Num_Ops.Number_Asin[BIGNUM_LEVEL] = Bignum_Asin;
  2225.    Num_Ops.Number_Asin[RATIONAL_LEVEL] = Rational_Asin;
  2226.    Num_Ops.Number_Asin[REAL_LEVEL] = Real_Asin;
  2227.    Num_Ops.Number_Asin[COMPLEX_LEVEL] = Complex_Asin;
  2228.  
  2229.    Num_Ops.Number_Acos[FIXNUM_LEVEL] = Fixnum_Acos;
  2230.    Num_Ops.Number_Acos[BIGNUM_LEVEL] = Bignum_Acos;
  2231.    Num_Ops.Number_Acos[RATIONAL_LEVEL] = Rational_Acos;
  2232.    Num_Ops.Number_Acos[REAL_LEVEL] = Real_Acos;
  2233.    Num_Ops.Number_Acos[COMPLEX_LEVEL] = Complex_Acos;
  2234.  
  2235.    Num_Ops.Number_Atan[FIXNUM_LEVEL] = Fixnum_Atan;
  2236.    Num_Ops.Number_Atan[BIGNUM_LEVEL] = Bignum_Atan;
  2237.    Num_Ops.Number_Atan[RATIONAL_LEVEL] = Rational_Atan;
  2238.    Num_Ops.Number_Atan[REAL_LEVEL] = Real_Atan;
  2239.    Num_Ops.Number_Atan[COMPLEX_LEVEL] = Complex_Atan;
  2240.  
  2241.    Num_Ops.Number_Atan2[FIXNUM_LEVEL] = Fixnum_Atan2;
  2242.    Num_Ops.Number_Atan2[BIGNUM_LEVEL] = Bignum_Atan2;
  2243.    Num_Ops.Number_Atan2[RATIONAL_LEVEL] = Rational_Atan2;
  2244.    Num_Ops.Number_Atan2[REAL_LEVEL] = Real_Atan2;
  2245.    Num_Ops.Number_Atan2[COMPLEX_LEVEL] = Complex_Atan2;
  2246.  
  2247.    Num_Ops.Number_Exact_To_Inexact[FIXNUM_LEVEL] = Fixnum_Exact_To_Inexact;
  2248.    Num_Ops.Number_Exact_To_Inexact[BIGNUM_LEVEL] = Bignum_Exact_To_Inexact;
  2249.    Num_Ops.Number_Exact_To_Inexact[RATIONAL_LEVEL] = Rational_Exact_To_Inexact;
  2250.    Num_Ops.Number_Exact_To_Inexact[REAL_LEVEL] = Real_Exact_To_Inexact;
  2251.    Num_Ops.Number_Exact_To_Inexact[COMPLEX_LEVEL] = Complex_Exact_To_Inexact;
  2252.  
  2253.    Num_Ops.Number_Inexact_To_Exact[FIXNUM_LEVEL] = Fixnum_Inexact_To_Exact;
  2254.    Num_Ops.Number_Inexact_To_Exact[BIGNUM_LEVEL] = Bignum_Inexact_To_Exact;
  2255.    Num_Ops.Number_Inexact_To_Exact[RATIONAL_LEVEL] = Rational_Inexact_To_Exact;
  2256.    Num_Ops.Number_Inexact_To_Exact[REAL_LEVEL] = Real_Inexact_To_Exact;
  2257.    Num_Ops.Number_Inexact_To_Exact[COMPLEX_LEVEL] = Complex_Inexact_To_Exact;
  2258.  
  2259.    Num_Ops.Number_To_String[FIXNUM_LEVEL] = Fixnum_To_String;
  2260.    Num_Ops.Number_To_String[BIGNUM_LEVEL] = Bignum_To_String;
  2261.    Num_Ops.Number_To_String[RATIONAL_LEVEL] = Rational_To_String;
  2262.    Num_Ops.Number_To_String[REAL_LEVEL] = Real_To_String;
  2263.    Num_Ops.Number_To_String[COMPLEX_LEVEL] = Complex_To_String;
  2264.  
  2265.    Num_Ops.Number_Make_Rectangular[FIXNUM_LEVEL] = Fixnum_Make_Rectangular;
  2266.    Num_Ops.Number_Make_Rectangular[BIGNUM_LEVEL] = Bignum_Make_Rectangular;
  2267.    Num_Ops.Number_Make_Rectangular[RATIONAL_LEVEL] = Rational_Make_Rectangular;
  2268.    Num_Ops.Number_Make_Rectangular[REAL_LEVEL] = Real_Make_Rectangular;
  2269.    Num_Ops.Number_Make_Rectangular[COMPLEX_LEVEL] = Complex_Make_Rectangular;
  2270.  
  2271.    Num_Ops.Number_Make_Polar[FIXNUM_LEVEL] = Fixnum_Make_Polar;
  2272.    Num_Ops.Number_Make_Polar[BIGNUM_LEVEL] = Bignum_Make_Polar;
  2273.    Num_Ops.Number_Make_Polar[RATIONAL_LEVEL] = Rational_Make_Polar;
  2274.    Num_Ops.Number_Make_Polar[REAL_LEVEL] = Real_Make_Polar;
  2275.    Num_Ops.Number_Make_Polar[COMPLEX_LEVEL] = Complex_Make_Polar;
  2276.  
  2277.    Num_Ops.Number_Real_Part[FIXNUM_LEVEL] = Fixnum_Real_Part;
  2278.    Num_Ops.Number_Real_Part[BIGNUM_LEVEL] = Bignum_Real_Part;
  2279.    Num_Ops.Number_Real_Part[RATIONAL_LEVEL] = Rational_Real_Part;
  2280.    Num_Ops.Number_Real_Part[REAL_LEVEL] = Real_Real_Part;
  2281.    Num_Ops.Number_Real_Part[COMPLEX_LEVEL] = Complex_Real_Part;
  2282.  
  2283.    Num_Ops.Number_Imaginary_Part[FIXNUM_LEVEL] = Fixnum_Imaginary_Part;
  2284.    Num_Ops.Number_Imaginary_Part[BIGNUM_LEVEL] = Bignum_Imaginary_Part;
  2285.    Num_Ops.Number_Imaginary_Part[RATIONAL_LEVEL] = Rational_Imaginary_Part;
  2286.    Num_Ops.Number_Imaginary_Part[REAL_LEVEL] = Real_Imaginary_Part;
  2287.    Num_Ops.Number_Imaginary_Part[COMPLEX_LEVEL] = Complex_Imaginary_Part;
  2288.  
  2289.    Num_Ops.Number_Magnitude[FIXNUM_LEVEL] = Fixnum_Magnitude;
  2290.    Num_Ops.Number_Magnitude[BIGNUM_LEVEL] = Bignum_Magnitude;
  2291.    Num_Ops.Number_Magnitude[RATIONAL_LEVEL] = Rational_Magnitude;
  2292.    Num_Ops.Number_Magnitude[REAL_LEVEL] = Real_Magnitude;
  2293.    Num_Ops.Number_Magnitude[COMPLEX_LEVEL] = Complex_Magnitude;
  2294.  
  2295.    Num_Ops.Number_Angle[FIXNUM_LEVEL] = Fixnum_Angle;
  2296.    Num_Ops.Number_Angle[BIGNUM_LEVEL] = Bignum_Angle;
  2297.    Num_Ops.Number_Angle[RATIONAL_LEVEL] = Rational_Angle;
  2298.    Num_Ops.Number_Angle[REAL_LEVEL] = Real_Angle;
  2299.    Num_Ops.Number_Angle[COMPLEX_LEVEL] = Complex_Angle;
  2300.  
  2301.    Make_Primitive("number?", Number_Predicate, 1, Any_Type, The_Undefined_Type,
  2302.                             The_Undefined_Type);
  2303.  
  2304.    Make_Primitive("integer?", Integer_Predicate, 1, Any_Type, The_Undefined_Type,
  2305.                             The_Undefined_Type);
  2306.  
  2307.    Make_Primitive("rational?", Rational_Predicate, 1, Any_Type, The_Undefined_Type,
  2308.                             The_Undefined_Type);
  2309.  
  2310.    Make_Primitive("real?", Real_Predicate, 1, Any_Type, The_Undefined_Type,
  2311.                             The_Undefined_Type);
  2312.  
  2313.    Make_Primitive("complex?", Complex_Predicate, 1, Any_Type, The_Undefined_Type,
  2314.                             The_Undefined_Type);
  2315.  
  2316.    Make_Primitive("zero?", Is_Number_Zero, 1, Number_Type, The_Undefined_Type,
  2317.                            The_Undefined_Type);
  2318.    Make_Primitive("positive?", Is_Number_Positive, 1, Number_Type,
  2319.                        The_Undefined_Type, The_Undefined_Type);
  2320.    Make_Primitive("negative?", Is_Number_Negative, 1, Number_Type,
  2321.                        The_Undefined_Type, The_Undefined_Type);
  2322.    Make_Primitive("odd?", Is_Number_Odd, 1, Number_Type, The_Undefined_Type,
  2323.                            The_Undefined_Type);
  2324.    Make_Primitive("even?", Is_Number_Even, 1, Number_Type, The_Undefined_Type,
  2325.                            The_Undefined_Type);
  2326.    Make_Primitive("exact?", Is_Number_Exact, 1, Number_Type, The_Undefined_Type,
  2327.                            The_Undefined_Type);
  2328.    Make_Primitive("inexact?", Is_Number_Inexact, 1, Number_Type,
  2329.                        The_Undefined_Type, The_Undefined_Type);
  2330.  
  2331.    Make_Primitive("=", Varying_Number_Equal, VARYING, Number_Type,
  2332.           The_Undefined_Type , The_Undefined_Type );
  2333.  
  2334.  
  2335.    Make_Primitive(">", Varying_Number_Greater_Than, VARYING, Number_Type,
  2336.           The_Undefined_Type , The_Undefined_Type );
  2337.  
  2338.    Make_Primitive(">", Varying_Number_Greater_Than, VARYING, Number_Type,
  2339.           The_Undefined_Type , The_Undefined_Type );
  2340.  
  2341.    Make_Primitive("<", Varying_Number_Less_Than, VARYING, Number_Type,
  2342.           The_Undefined_Type , The_Undefined_Type );
  2343.  
  2344.    Make_Primitive(">=", Varying_Number_Greater_Than_Or_Equal, VARYING,
  2345.           Number_Type, The_Undefined_Type , The_Undefined_Type );
  2346.  
  2347.    Make_Primitive("<=", Varying_Number_Less_Than_Or_Equal, VARYING,
  2348.           Number_Type, The_Undefined_Type , The_Undefined_Type );
  2349.  
  2350.    Make_Primitive("+", Varying_Number_Add, VARYING, Number_Type,
  2351.           The_Undefined_Type, The_Undefined_Type );
  2352.  
  2353.    Make_Primitive("-", Varying_Number_Subtract, VARYING, Number_Type,
  2354.           The_Undefined_Type, The_Undefined_Type );
  2355.  
  2356.    Make_Primitive("*", Varying_Number_Multiply, VARYING, Number_Type,
  2357.           The_Undefined_Type, The_Undefined_Type );
  2358.  
  2359.    Make_Primitive("/", Varying_Number_Divide, VARYING, Number_Type,
  2360.           The_Undefined_Type, The_Undefined_Type );
  2361.  
  2362.    Make_Primitive( "min", Varying_Number_Min, VARYING, Number_Type,
  2363.           The_Undefined_Type, The_Undefined_Type );
  2364.  
  2365.    Make_Primitive( "max", Varying_Number_Max, VARYING, Number_Type,
  2366.           The_Undefined_Type, The_Undefined_Type );
  2367.  
  2368.    Make_Primitive("gcd", Varying_Number_GCD, VARYING, Number_Type,
  2369.           The_Undefined_Type, The_Undefined_Type );
  2370.  
  2371.    Make_Primitive("lcm", Varying_Number_LCM, VARYING, Number_Type,
  2372.           The_Undefined_Type, The_Undefined_Type );
  2373.  
  2374.    Make_Primitive("quotient", Number_Quotient, 2, Number_Type, Number_Type,
  2375.                        The_Undefined_Type);
  2376.    Make_Primitive("remainder", Number_Remainder, 2, Number_Type, Number_Type,
  2377.                        The_Undefined_Type);
  2378.  
  2379.    Make_Primitive("modulo", Number_Modulo, 2, Number_Type, Number_Type,
  2380.                        The_Undefined_Type);
  2381.  
  2382.    Make_Primitive("negate", Number_Negate, 1, Number_Type, The_Undefined_Type,
  2383.                        The_Undefined_Type);
  2384.  
  2385.    Make_Primitive("abs", Number_Abs, 1, Number_Type, The_Undefined_Type,
  2386.                        The_Undefined_Type);
  2387.  
  2388.    Make_Primitive("numerator", Number_Numerator, 1, Number_Type,
  2389.                     The_Undefined_Type,The_Undefined_Type);
  2390.  
  2391.    Make_Primitive("denominator", Number_Denominator,1, Number_Type,
  2392.                     The_Undefined_Type, The_Undefined_Type);
  2393.  
  2394.    Make_Primitive("rationalize", Number_Rationalize, 2, Number_Type,
  2395.                     Number_Type, The_Undefined_Type);
  2396.  
  2397.    Make_Primitive("floor", Number_Floor, 1, Number_Type, The_Undefined_Type,
  2398.                         The_Undefined_Type );
  2399.  
  2400.    Make_Primitive("ceiling", Number_Ceiling, 1, Number_Type, The_Undefined_Type,
  2401.                         The_Undefined_Type );
  2402.  
  2403.    Make_Primitive("truncate", Number_Truncate, 1, Number_Type,
  2404.                     The_Undefined_Type,The_Undefined_Type );
  2405.  
  2406.    Make_Primitive("round", Number_Round, 1, Number_Type, The_Undefined_Type,
  2407.                         The_Undefined_Type );
  2408.  
  2409.    Make_Primitive("sqrt", Number_Sqrt, 1, Number_Type, The_Undefined_Type,
  2410.                         The_Undefined_Type );
  2411.  
  2412.    Make_Primitive("exp", Number_Exp, 1, Number_Type, The_Undefined_Type,
  2413.                         The_Undefined_Type );
  2414.  
  2415.    Make_Primitive("log", Number_Log, 1, Number_Type, The_Undefined_Type,
  2416.                         The_Undefined_Type );
  2417.  
  2418.    Make_Primitive("expt", Number_Expt, 2, Number_Type, Number_Type,
  2419.                         The_Undefined_Type );
  2420.  
  2421.    Make_Primitive("sin", Number_Sin, 1, Number_Type, The_Undefined_Type,
  2422.                         The_Undefined_Type );
  2423.    Make_Primitive("cos", Number_Cos, 1, Number_Type, The_Undefined_Type,
  2424.                         The_Undefined_Type );
  2425.    Make_Primitive("tan", Number_Tan, 1, Number_Type, The_Undefined_Type,
  2426.                         The_Undefined_Type );
  2427.    Make_Primitive("asin", Number_Asin, 1, Number_Type, The_Undefined_Type,
  2428.                         The_Undefined_Type );
  2429.    Make_Primitive("acos", Number_Acos, 1, Number_Type, The_Undefined_Type,
  2430.                         The_Undefined_Type );
  2431.    Make_Primitive("asin", Number_Asin, 1, Number_Type, The_Undefined_Type,
  2432.                         The_Undefined_Type );
  2433.    Make_Primitive("#_atan1", Number_Atan, 1, Number_Type, The_Undefined_Type,
  2434.                         The_Undefined_Type );
  2435.    Make_Primitive("#_atan2", Number_Atan2, 2, Number_Type, Number_Type,
  2436.                         The_Undefined_Type );
  2437.    Make_Primitive("atan", Number_Atan, 1, Number_Type, The_Undefined_Type,
  2438.                         The_Undefined_Type );
  2439.    Make_Primitive("atan2", Number_Atan2, 2, Number_Type, Number_Type,
  2440.                         The_Undefined_Type );
  2441.  
  2442.    Make_Primitive("exact->inexact", Number_Exact_To_Inexact, 1, Number_Type,
  2443.                     The_Undefined_Type, The_Undefined_Type);
  2444.    Make_Primitive("inexact->exact", Number_Inexact_To_Exact, 1, Number_Type,
  2445.                     The_Undefined_Type, The_Undefined_Type);
  2446.  
  2447.    Make_Primitive("#_number->string", Number_To_String, 2, Number_Type,
  2448.                     Number_Type , The_Undefined_Type);
  2449.  
  2450.    Make_Primitive("#_string->number", String_To_Number, 2, String_Type,
  2451.         Number_Type, The_Undefined_Type);
  2452.  
  2453.    Make_Primitive("make-rectangular", Number_Make_Rectangular, 2, Number_Type,
  2454.                     Number_Type, The_Undefined_Type );
  2455.  
  2456.    Make_Primitive("make-polar", Number_Make_Polar, 2, Number_Type,
  2457.                     Number_Type, The_Undefined_Type );
  2458.  
  2459.    Make_Primitive("real-part", Number_Real_Part, 1, Number_Type,
  2460.                 The_Undefined_Type, The_Undefined_Type );
  2461.  
  2462.    Make_Primitive("imag-part", Number_Imaginary_Part, 1, Number_Type,
  2463.                 The_Undefined_Type, The_Undefined_Type );
  2464.  
  2465.    Make_Primitive("magnitude", Number_Magnitude, 1, Number_Type,
  2466.                 The_Undefined_Type, The_Undefined_Type );
  2467.  
  2468.    Make_Primitive("angle", Number_Angle, 1, Number_Type,
  2469.                 The_Undefined_Type, The_Undefined_Type );
  2470.  
  2471.  
  2472. }
  2473.