src/arith/integer.c

@@ -521,3 +521,21 @@ bool equal_integer_integer( struct cons_pointer a, struct cons_pointer b ) {
 
     return result;
 }
+
+/**
+ * true if `a` is an integer, and `b` is a real number whose value is the
+ * value of that integer.
+ */
+bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ) {
+    bool result = false;
+
+    if ( integerp( a ) && realp( b ) ) {
+        long double bv = pointer2cell( b ).payload.real.value;
+
+        if ( floor( bv ) == bv ) {
+            result = pointer2cell( a ).payload.integer.value == ( int64_t ) bv;
+        }
+    }
+
+    return result;
+}

src/arith/peano.c

@@ -748,29 +748,3 @@ struct cons_pointer lisp_divide( struct
 
     return result;
 }
-
-/**
- * @brief Function: return a real (approcimately) equal in value to the ratio 
- * which is the first argument.
- * 
- * @param frame 
- * @param frame_pointer 
- * @param env 
- * @return struct cons_pointer a pointer to a real
- */
-// struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
-//            struct cons_pointer env )
-struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
-    struct cons_pointer env) {
-    struct cons_pointer result = NIL;
-    struct cons_pointer rat = frame->arg[0];
-
-    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
-    debug_print_object( rat, DEBUG_ARITH);
-
-    if ( ratiop( rat)) {
-        result = make_real( c_ratio_to_ld( rat));
-    } // TODO: else throw an exception?
-
-    return result;
-}

src/arith/peano.h

@@ -75,7 +75,4 @@ struct cons_pointer
 lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
              struct cons_pointer env );
 
-struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
-    struct cons_pointer env);
-
 #endif /* PEANO_H */

src/arith/ratio.c

@@ -11,17 +11,15 @@
 #include <math.h>
 #include <stdio.h>
 
-#include "arith/integer.h"
-#include "arith/peano.h"
-#include "arith/ratio.h"
-#include "arith/real.h"
-#include "debug.h"
-#include "io/print.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
-#include "memory/stack.h"
+#include "debug.h"
 #include "ops/equal.h"
+#include "arith/integer.h"
 #include "ops/lispops.h"
+#include "arith/peano.h"
+#include "io/print.h"
+#include "arith/ratio.h"
 
 
 /**
@@ -93,10 +91,11 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                      struct cons_pointer arg2 ) {
     struct cons_pointer r, result;
 
-    debug_print( L"\naadd_ratio_ratio: ", DEBUG_ARITH);
+    debug_print( L"add_ratio_ratio( arg1 = ", DEBUG_ARITH );
-    debug_print_object( arg1, DEBUG_ARITH);
+    debug_print_object( arg1, DEBUG_ARITH );
-    debug_print( L" + ", DEBUG_ARITH);
+    debug_print( L"; arg2 = ", DEBUG_ARITH );
-    debug_print_object( arg2, DEBUG_ARITH);
+    debug_print_object( arg2, DEBUG_ARITH );
+    debug_print( L")\n", DEBUG_ARITH );
 
     if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
         struct cons_space_object cell1 = pointer2cell( arg1 );
@@ -112,7 +111,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
             lcm = least_common_multiple( dr1v, dr2v ),
             m1 = lcm / dr1v, m2 = lcm / dr2v;
 
-        debug_printf( DEBUG_ARITH, L"; lcm = %ld; m1 = %ld; m2 = %ld", lcm,
+        debug_printf( DEBUG_ARITH, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm,
                       m1, m2 );
 
         if ( dr1v == dr2v ) {
@@ -171,11 +170,6 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
                                        struct cons_pointer ratarg ) {
     struct cons_pointer result;
 
-    debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH);
-    debug_print_object( intarg, DEBUG_ARITH);
-    debug_print( L" + ", DEBUG_ARITH);
-    debug_print_object( ratarg, DEBUG_ARITH);
-
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: not longer works
         struct cons_pointer one = acquire_integer( 1, NIL ),
@@ -194,10 +188,6 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
                                                               NIL ) ) ), NIL );
     }
 
-    debug_print( L" => ", DEBUG_ARITH );
-    debug_print_object( result, DEBUG_ARITH );
-    debug_print( L"\n", DEBUG_ARITH );
-
     return result;
 }
 
@@ -209,10 +199,6 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
  */
 struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
                                         struct cons_pointer arg2 ) {
-    debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH);
-    debug_print_object( arg1, DEBUG_ARITH);
-    debug_print( L" / ", DEBUG_ARITH);
-    debug_print_object( arg2, DEBUG_ARITH);
     // TODO: this now has to work if `arg1` is an integer
     struct cons_pointer i =
         make_ratio( pointer2cell( arg2 ).payload.ratio.divisor,
@@ -221,10 +207,6 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
 
     dec_ref( i );
 
-    debug_print( L" => ", DEBUG_ARITH );
-    debug_print_object( result, DEBUG_ARITH );
-    debug_print( L"\n", DEBUG_ARITH );
-
     return result;
 }
 
@@ -277,10 +259,6 @@ struct cons_pointer multiply_ratio_ratio( struct
                              NIL );
     }
 
-    debug_print( L" => ", DEBUG_ARITH );
-    debug_print_object( result, DEBUG_ARITH );
-    debug_print( L"\n", DEBUG_ARITH );
-
     return result;
 }
 
@@ -294,11 +272,6 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
                                             struct cons_pointer ratarg ) {
     struct cons_pointer result;
 
-    debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH);
-    debug_print_object( intarg, DEBUG_ARITH);
-    debug_print( L" * ", DEBUG_ARITH);
-    debug_print_object( ratarg, DEBUG_ARITH);
-
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: no longer works; fix
         struct cons_pointer one = acquire_integer( 1, NIL ),
@@ -313,10 +286,6 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
                              NIL );
     }
 
-    debug_print( L" => ", DEBUG_ARITH );
-    debug_print_object( result, DEBUG_ARITH );
-    debug_print( L"\n", DEBUG_ARITH );
-
     return result;
 }
 
@@ -329,11 +298,6 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
  */
 struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
                                           struct cons_pointer arg2 ) {
-    debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH);
-    debug_print_object( arg1, DEBUG_ARITH);
-    debug_print( L" * ", DEBUG_ARITH);
-    debug_print_object( arg2, DEBUG_ARITH);
-
     struct cons_pointer i = negative( arg2 ),
         result = add_ratio_ratio( arg1, i );
 
@@ -397,35 +361,3 @@ bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
 
     return result;
 }
-
-/**
- * @brief convert a ratio to an equivalent long double.
- * 
- * @param rat a pointer to a ratio.
- * @return long double 
- */
-long double c_ratio_to_ld( struct cons_pointer rat) {
-    long double result = NAN;
-
-    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
-    debug_print_object( rat, DEBUG_ARITH);
-
-    if ( ratiop( rat)) {
-        struct cons_space_object * cell_a = & pointer2cell( rat);
-        struct cons_pointer dv = cell_a->payload.ratio.divisor;
-        struct cons_space_object * dv_cell = &pointer2cell( dv);
-        struct cons_pointer dd = cell_a->payload.ratio.dividend;
-        struct cons_space_object * dd_cell = &pointer2cell( dd);
-        
-        if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) {
-            result = ((long double) dd_cell->payload.integer.value) / ((long double) dv_cell->payload.integer.value);;
-        } else {
-            fwprintf( stderr, L"real conversion is not yet implemented for bignums rationals.");
-        } 
-    }
-
-    debug_printf( DEBUG_ARITH, L"\nc_ratio_to_ld returning %d\n", result );
-
-    return result;
-}
-

src/arith/ratio.h

@@ -36,6 +36,4 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
 
 bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b );
 
-long double c_ratio_to_ld( struct cons_pointer rat);
-
 #endif

src/init.c

@@ -20,7 +20,6 @@
 /* libcurl, used for io */
 #include <curl/curl.h>
 
-#include "arith/ratio.h"
 #include "version.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
@@ -348,7 +347,6 @@ int main( int argc, char *argv[] ) {
     bind_function( L"print", &lisp_print );
     bind_function( L"put!", lisp_hashmap_put );
     bind_function( L"put-all!", &lisp_hashmap_put_all );
-    bind_function( L"ratio->real", &lisp_ratio_to_real );
     bind_function( L"read", &lisp_read );
     bind_function( L"read-char", &lisp_read_char );
     bind_function( L"repl", &lisp_repl );

src/ops/equal.c

@@ -15,7 +15,6 @@
 #include "arith/integer.h"
 #include "arith/peano.h"
 #include "arith/ratio.h"
-#include "debug.h"
 
 /**
  * Shallow, and thus cheap, equality: true if these two objects are
@@ -49,198 +48,11 @@ bool end_of_string( struct cons_pointer string ) {
         pointer2cell( string ).payload.string.character == '\0';
 }
 
-/**
- * @brief compare two long doubles and returns true if they are the same to
- * within a tolerance of one part in a billion.
- * 
- * @param a 
- * @param b 
- * @return true if `a` and `b` are equal to within one part in a billion.
- * @return false otherwise.
- */
-bool equal_ld_ld( long double a, long double b) {
-    long double fa = fabsl( a);
-    long double fb = fabsl( b);
-    /* difference of magnitudes */
-    long double diff = fabsl( fa - fb);
-    /* average magnitude of the two */
-    long double av = (fa > fb) ? ( fa - diff) : ( fb - diff);
-    /* amount of difference we will tolerate for equality */
-    long double tolerance = av * 0.000000001;
-
-    bool result = ( fabsl( a - b) < tolerance);
-
-    debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result );
-
-    return result;
-}
-
-/**
- * @brief Private function, don't use. It depends on its arguments being 
- * numbers and doesn't sanity check them.
- * 
- * @param a a lisp integer -- if it isn't an integer, things will break.
- * @param b a lisp real -- if it isn't a real, things will break.
- * @return true if the two numbers have equal value.
- * @return false if they don't.
- */
-bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){
-    debug_print( L"\nequal_integer_real: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
-    bool result = false;
-    struct cons_space_object * cell_a = &pointer2cell( a);
-    struct cons_space_object * cell_b = & pointer2cell( b);
-
-    if (nilp( cell_a->payload.integer.more)) {
-        result = equal_ld_ld( (long double) cell_a->payload.integer.value, cell_b->payload.real.value);
-    } else {
-        fwprintf( stderr, L"\nequality is not yet implemented for bignums compared to reals.");
-    }
-
-    debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n", result );
-
-    return result;
-}
-
-/**
- * @brief Private function, don't use. It depends on its arguments being 
- * numbers and doesn't sanity check them.
- * 
- * @param a a lisp integer -- if it isn't an integer, things will break.
- * @param b a lisp number.
- * @return true if the two numbers have equal value.
- * @return false if they don't.
- */
-bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) {
-    debug_print( L"\nequal_integer_number: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
-    bool result = false;
-    struct cons_space_object * cell_b = & pointer2cell( b);
-
-    switch ( cell_b->tag.value) {
-        case INTEGERTV:
-            result = equal_integer_integer( a, b);
-            break;
-        case REALTV: 
-            result = equal_integer_real( a, b);
-            break;
-        case RATIOTV:
-            result = false;
-            break;
-    }
-        
-    debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n", result );
-
-    return result;
-}
-
-/**
- * @brief Private function, don't use. It depends on its arguments being 
- * numbers and doesn't sanity check them.
- * 
- * @param a a lisp real -- if it isn't an real, things will break.
- * @param b a lisp number.
- * @return true if the two numbers have equal value.
- * @return false if they don't.
- */
-bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
-    debug_print( L"\nequal_real_number: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
-    bool result = false;
-    struct cons_space_object * cell_b = & pointer2cell( b);
-
-    switch ( cell_b->tag.value) {
-        case INTEGERTV:
-            result = equal_integer_real( b, a);
-            break;
-        case REALTV: {
-                struct cons_space_object * cell_a = & pointer2cell( a);
-                result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value);
-            }
-            break;
-        case RATIOTV: 
-                struct cons_space_object * cell_a = & pointer2cell( a);
-                result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value);
-            break;
-        }
-
-        debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result );
-
-    return result;
-}
-
-/**
- * @brief Private function, don't use. It depends on its arguments being 
- * numbers and doesn't sanity check them.
- * 
- * @param a a number
- * @param b a number
- * @return true if the two numbers have equal value.
- * @return false if they don't.
- */
-bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
-    bool result = eq( a, b );
-
-    debug_print( L"\nequal_number_number: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
-
-    if ( !result ) {
-        struct cons_space_object * cell_a = & pointer2cell( a);
-        struct cons_space_object * cell_b = & pointer2cell( b);
-
-        switch ( cell_a->tag.value) {
-            case INTEGERTV: 
-                result = equal_integer_number( a, b);
-                break;
-            case REALTV:
-                result = equal_real_number( a, b);
-                break;
-            case RATIOTV:
-                switch( cell_b->tag.value) {
-                    case INTEGERTV:
-                        /* as all ratios are simplified by make_ratio, any
-                         * ratio that would simplify to an integer is an
-                         * integer, */
-                        result = false;
-                        break;
-                    case REALTV:
-                        result = equal_real_number( b, a);
-                        break;
-                    case RATIOTV:
-                        result = equal_ratio_ratio( a, b);
-                        break;
-                    /* can't throw an exception from here, but non-numbers
-                     * shouldn't have been passed in anyway, so no default. */
-                }
-                break;
-                /* can't throw an exception from here, but non-numbers
-                 * shouldn't have been passed in anyway, so no default. */
-        }
-    }
-
-    debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n", result );
-
-    return result;
-}
- 
 /**
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
  */
 bool equal( struct cons_pointer a, struct cons_pointer b ) {
-    debug_print( L"\nequal: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
-
     bool result = eq( a, b );
 
     if ( !result && same_type( a, b ) ) {
@@ -309,7 +121,11 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 break;
         }
     } else if ( numberp( a ) && numberp( b ) ) {
-        result = equal_number_number( a, b);
+        if ( integerp( a ) ) {
+            result = equal_integer_real( a, b );
+        } else if ( integerp( b ) ) {
+            result = equal_integer_real( b, a );
+        }
     }
 
     /*
@@ -320,7 +136,5 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
      * I'll ignore them, too, for now.
      */
 
-    debug_printf( DEBUG_ARITH, L"\nequal returning %d\n", result );
-
     return result;
 }