Ratio arithmetic separated out into its own files.

src/arith/integer.c

@@ -13,7 +13,6 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
-#include "read.h"
 
 /**
  * return the numeric value of this cell, as a C primitive double, not
@@ -41,7 +40,9 @@ struct cons_pointer make_integer( long int value ) {
     struct cons_space_object *cell = &pointer2cell( result );
     cell->payload.integer.value = value;
 
+#ifdef DEBUG
     dump_object( stderr, result );
+#endif
 
     return result;
 }

src/arith/peano.c

@@ -21,6 +21,7 @@
 #include "intern.h"
 #include "lispops.h"
 #include "print.h"
+#include "ratio.h"
 #include "read.h"
 #include "real.h"
 #include "stack.h"
@@ -113,123 +114,6 @@ long int to_long_int( struct cons_pointer arg ) {
     return result;
 }
 
-long int greatest_common_divisor( long int m, long int n ) {
-    int o;
-    while ( m ) {
-        o = m;
-        m = n % m;
-        n = o;
-    }
-
-    return o;
-}
-
-long int least_common_multiple( long int m, long int n ) {
-    return m / greatest_common_divisor( m, n ) * n;
-}
-
-struct cons_pointer simplify_ratio( struct stack_frame *frame,
-                                    struct cons_pointer arg ) {
-    struct cons_pointer result = arg;
-    long int ddrv =
-        pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
-        payload.integer.value, drrv =
-        pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
-        payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
-
-    if ( gcd > 1 ) {
-        if ( drrv / gcd == 1 ) {
-            result = make_integer( ddrv / gcd );
-        } else {
-            result =
-                make_ratio( frame, make_integer( ddrv / gcd ),
-                            make_integer( drrv / gcd ) );
-        }
-    }
-    return result;
-}
-
-
-/**
- * return a cons_pointer indicating a number which is the sum of
-* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
-* this is going to break horribly.
-*/
-struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
-                                     struct cons_pointer arg1,
-                                     struct cons_pointer arg2 ) {
-    fputws( L"add_ratio_ratio( arg1 = ", stderr );
-    print( stderr, arg1 );
-    fputws( L"; arg2 = ", stderr );
-    print( stderr, arg2 );
-
-    struct cons_pointer r, result;
-    struct cons_space_object cell1 = pointer2cell( arg1 );
-    struct cons_space_object cell2 = pointer2cell( arg2 );
-    long int dd1v =
-        pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
-        dd2v =
-        pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
-        dr1v =
-        pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
-        dr2v =
-        pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
-        lcm = least_common_multiple( dr1v, dr2v ),
-        m1 = lcm / dr1v, m2 = lcm / dr2v;
-
-    fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
-
-    if ( dr1v == dr2v ) {
-        r = make_ratio( frame,
-                        make_integer( dd1v + dd2v ),
-                        cell1.payload.ratio.divisor );
-    } else {
-        struct cons_pointer dd1vm = make_integer( dd1v * m1 ),
-            dr1vm = make_integer( dr1v * m1 ),
-            dd2vm = make_integer( dd2v * m2 ),
-            dr2vm = make_integer( dr2v * m2 ),
-            r1 = make_ratio( frame, dd1vm, dr1vm ),
-            r2 = make_ratio( frame, dd2vm, dr2vm );
-
-        r = add_ratio_ratio( frame, r1, r2 );
-
-        /* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
-         * never incremented except when making r1 and r2, decrementing
-         * r1 and r2 should be enought to garbage collect them. */
-        dec_ref( r1 );
-        dec_ref( r2 );
-    }
-
-    result = simplify_ratio( frame, r );
-    if ( !eq( r, result ) ) {
-        dec_ref( r );
-    }
-
-    fputws( L" => ", stderr );
-    print( stderr, result );
-    fputws( L"\n", stderr );
-
-    return result;
-}
-
-
-/**
- * return a cons_pointer indicating a number which is the sum of
-* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
-* this is going to break horribly.
-*/
-struct cons_pointer add_integer_ratio( struct stack_frame *frame,
-                                       struct cons_pointer intarg,
-                                       struct cons_pointer ratarg ) {
-    struct cons_pointer one = make_integer( 1 ),
-        ratio = make_ratio( frame, intarg, one ),
-        result = add_ratio_ratio( frame, ratio, ratarg );
-
-    dec_ref( one );
-    dec_ref( ratio );
-    return result;
-}
-
 
 /**
 * return a cons_pointer indicating a number which is the sum of
@@ -358,58 +242,6 @@ struct cons_pointer lisp_add( struct stack_frame
     return result;
 }
 
-struct cons_pointer multiply_ratio_ratio( struct
-                                          stack_frame
-                                          *frame, struct
-                                          cons_pointer arg1, struct
-                                          cons_pointer arg2 ) {
-    fputws( L"multiply_ratio_ratio( arg1 = ", stderr );
-    print( stderr, arg1 );
-    fputws( L"; arg2 = ", stderr );
-    print( stderr, arg2 );
-
-    struct cons_pointer result;
-    struct cons_space_object cell1 = pointer2cell( arg1 );
-    struct cons_space_object cell2 = pointer2cell( arg2 );
-    long int dd1v =
-        pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
-        dd2v =
-        pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
-        dr1v =
-        pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
-        dr2v =
-        pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
-        ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
-
-    struct cons_pointer unsimplified = make_ratio( frame, make_integer( ddrv ),
-                                                   make_integer( drrv ) );
-    result = simplify_ratio( frame, unsimplified );
-
-    if ( !eq( unsimplified, result ) ) {
-        dec_ref( unsimplified );
-    }
-
-    return result;
-}
-
-/**
- * return a cons_pointer indicating a number which is the sum of
-* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
-* this is going to break horribly.
-*/
-struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
-                                            struct cons_pointer intarg,
-                                            struct cons_pointer ratarg ) {
-    struct cons_pointer one = make_integer( 1 ),
-        ratio = make_ratio( frame, intarg, one ),
-        result = multiply_ratio_ratio( frame, ratio, ratarg );
-
-    dec_ref( one );
-    dec_ref( ratio );
-
-    return result;
-}
-
 
 /**
 * return a cons_pointer indicating a number which is the product of
@@ -543,6 +375,10 @@ struct cons_pointer lisp_multiply( struct
     return result;
 }
 
+/**
+ * return a cons_pointer indicating a number which is the
+ * inverse of the number indicated by `arg`.
+ */
 struct cons_pointer inverse( struct stack_frame *frame,
                              struct cons_pointer arg ) {
     struct cons_pointer result = NIL;
@@ -577,17 +413,6 @@ struct cons_pointer inverse( struct stack_frame *frame,
 }
 
 
-struct cons_pointer subtract_ratio_ratio( struct stack_frame *frame,
-                                          struct cons_pointer arg1,
-                                          struct cons_pointer arg2 ) {
-    struct cons_pointer i = inverse( frame, arg2 ),
-        result = add_ratio_ratio( frame, arg1, i );
-
-    dec_ref( i );
-
-    return result;
-}
-
 /**
  * Subtract one number from another.
  * @param env the evaluation environment - ignored;
@@ -683,26 +508,6 @@ struct cons_pointer lisp_subtract( struct
     return result;
 }
 
-/**
- * return a cons_pointer to a ratio which represents the value of the ratio
- * indicated by `arg1` divided by the ratio indicated by `arg2`. If either
- * of these aren't RTIO cells, something horrid will happen and it is YOUR FAULT.
- */
-struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
-                                        struct cons_pointer arg1,
-                                        struct cons_pointer arg2 ) {
-    struct cons_pointer i = make_ratio( frame,
-                                        pointer2cell( arg2 ).payload.
-                                        ratio.divisor,
-                                        pointer2cell( arg2 ).payload.
-                                        ratio.dividend ), result =
-        multiply_ratio_ratio( frame, arg1, i );
-
-    dec_ref( i );
-
-    return result;
-}
-
 /**
  * Divide one number by another.
  * @param env the evaluation environment - ignored;

src/arith/ratio.c

@@ -0,0 +1,330 @@
+/*
+ * ratio.c
+ *
+ * functions for rational number cells.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#define _GNU_SOURCE
+#include <math.h>
+#include <stdio.h>
+
+#include "conspage.h"
+#include "consspaceobject.h"
+#include "equal.h"
+#include "integer.h"
+#include "lispops.h"
+#include "print.h"
+#include "ratio.h"
+
+
+/*
+ * declared in peano.c, can't include piano.h here because
+ * circularity. TODO: refactor.
+ */
+struct cons_pointer inverse( struct stack_frame *frame,
+                             struct cons_pointer arg );
+
+/**
+ * return, as a long int, the greatest common divisor of `m` and `n`,
+ */
+long int greatest_common_divisor( long int m, long int n ) {
+    int o;
+    while ( m ) {
+        o = m;
+        m = n % m;
+        n = o;
+    }
+
+    return o;
+}
+
+/**
+ * return, as a long int, the least common multiple of `m` and `n`,
+ */
+long int least_common_multiple( long int m, long int n ) {
+    return m / greatest_common_divisor( m, n ) * n;
+}
+
+/**
+ * return a cons_pointer indicating a number which is of the
+ * same value as the ratio indicated by `arg`, but which may
+ * be in a simplified representation. If `arg` isn't a ratio,
+ * will throw exception.
+ */
+struct cons_pointer simplify_ratio( struct stack_frame *frame,
+                                    struct cons_pointer arg ) {
+    struct cons_pointer result = arg;
+
+  if (ratiop(arg)) {
+    long int ddrv =
+        pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
+        payload.integer.value, drrv =
+        pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
+        payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
+
+    if ( gcd > 1 ) {
+        if ( drrv / gcd == 1 ) {
+            result = make_integer( ddrv / gcd );
+        } else {
+            result =
+                make_ratio( frame, make_integer( ddrv / gcd ),
+                            make_integer( drrv / gcd ) );
+        }
+    }
+  } else {
+    result = lisp_throw(
+      c_string_to_lisp_string( "Shouldn't happen: bad arg to simplify_ratio" ),
+                            frame );
+  }
+
+    return result;
+}
+
+
+
+/**
+ * return a cons_pointer indicating a number which is the sum of
+ * the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
+ * this is going to break horribly.
+ */
+struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
+                                     struct cons_pointer arg1,
+                                     struct cons_pointer arg2 ) {
+    struct cons_pointer r, result;
+
+#ifdef DEBUG
+    fputws( L"add_ratio_ratio( arg1 = ", stderr );
+    print( stderr, arg1 );
+    fputws( L"; arg2 = ", stderr );
+    print( stderr, arg2 );
+    fputws( L")\n", stderr);
+#endif
+
+  if ( ratiop(arg1) && ratiop(arg2)) {
+    struct cons_space_object cell1 = pointer2cell( arg1 );
+    struct cons_space_object cell2 = pointer2cell( arg2 );
+    long int dd1v =
+        pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
+        dd2v =
+        pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
+        dr1v =
+        pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
+        dr2v =
+        pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
+        lcm = least_common_multiple( dr1v, dr2v ),
+        m1 = lcm / dr1v, m2 = lcm / dr2v;
+
+#ifdef DEBUG
+    fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
+#endif
+
+    if ( dr1v == dr2v ) {
+        r = make_ratio( frame,
+                        make_integer( dd1v + dd2v ),
+                        cell1.payload.ratio.divisor );
+    } else {
+        struct cons_pointer dd1vm = make_integer( dd1v * m1 ),
+            dr1vm = make_integer( dr1v * m1 ),
+            dd2vm = make_integer( dd2v * m2 ),
+            dr2vm = make_integer( dr2v * m2 ),
+            r1 = make_ratio( frame, dd1vm, dr1vm ),
+            r2 = make_ratio( frame, dd2vm, dr2vm );
+
+        r = add_ratio_ratio( frame, r1, r2 );
+
+        /* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
+         * never incremented except when making r1 and r2, decrementing
+         * r1 and r2 should be enought to garbage collect them. */
+        dec_ref( r1 );
+        dec_ref( r2 );
+    }
+
+    result = simplify_ratio( frame, r );
+    if ( !eq( r, result ) ) {
+        dec_ref( r );
+    }
+  } else {
+    result = lisp_throw(
+      c_string_to_lisp_string( "Shouldn't happen: bad arg to add_ratio_ratio" ),
+                            frame );
+  }
+
+#ifdef DEBUG
+    fputws( L" => ", stderr );
+    print( stderr, result );
+    fputws( L"\n", stderr );
+#endif
+
+    return result;
+}
+
+
+/**
+ * return a cons_pointer indicating a number which is the sum of
+ * the intger indicated by `intarg` and the ratio indicated by
+ * `ratarg`. If you pass other types, this is going to break horribly.
+ */
+struct cons_pointer add_integer_ratio( struct stack_frame *frame,
+                                       struct cons_pointer intarg,
+                                       struct cons_pointer ratarg ) {
+  struct cons_pointer result;
+
+  if (integerp(intarg) && ratiop(ratarg)) {
+    struct cons_pointer one = make_integer( 1 ),
+        ratio = make_ratio( frame, intarg, one );
+
+    result = add_ratio_ratio( frame, ratio, ratarg );
+
+    dec_ref( one );
+    dec_ref( ratio );
+  } else {
+    result = lisp_throw(
+      c_string_to_lisp_string( "Shouldn't happen: bad arg to add_integer_ratio" ),
+                            frame );
+  }
+
+  return result;
+}
+
+/**
+ * return a cons_pointer to a ratio which represents the value of the ratio
+ * indicated by `arg1` divided by the ratio indicated by `arg2`. If either
+ * of these aren't RTIO cells, something horrid will happen and it is YOUR FAULT.
+ */
+struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
+                                        struct cons_pointer arg1,
+                                        struct cons_pointer arg2 ) {
+    struct cons_pointer i = make_ratio( frame,
+                                        pointer2cell( arg2 ).payload.
+                                        ratio.divisor,
+                                        pointer2cell( arg2 ).payload.
+                                        ratio.dividend ), result =
+        multiply_ratio_ratio( frame, arg1, i );
+
+    dec_ref( i );
+
+    return result;
+}
+
+/**
+ * return a cons_pointer indicating a number which is the product of
+ * the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
+ * this is going to break horribly.
+ */
+struct cons_pointer multiply_ratio_ratio( struct
+                                          stack_frame
+                                          *frame, struct
+                                          cons_pointer arg1, struct
+                                          cons_pointer arg2 ) {
+    struct cons_pointer result;
+
+#ifdef DEBUG
+    fputws( L"multiply_ratio_ratio( arg1 = ", stderr );
+    print( stderr, arg1 );
+    fputws( L"; arg2 = ", stderr );
+    print( stderr, arg2 );
+    fputws( L")\n", stderr);
+#endif
+  if ( ratiop(arg1) && ratiop(arg2)) {
+    struct cons_space_object cell1 = pointer2cell( arg1 );
+    struct cons_space_object cell2 = pointer2cell( arg2 );
+    long int dd1v =
+        pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
+        dd2v =
+        pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
+        dr1v =
+        pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
+        dr2v =
+        pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
+        ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
+
+    struct cons_pointer unsimplified = make_ratio( frame, make_integer( ddrv ),
+                                                   make_integer( drrv ) );
+    result = simplify_ratio( frame, unsimplified );
+
+    if ( !eq( unsimplified, result ) ) {
+        dec_ref( unsimplified );
+    }
+  } else {
+    result = lisp_throw(
+      c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
+                            frame );
+  }
+
+    return result;
+}
+
+/**
+ * return a cons_pointer indicating a number which is the product of
+ * the intger indicated by `intarg` and the ratio indicated by
+ * `ratarg`. If you pass other types, this is going to break horribly.
+ */
+struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
+                                            struct cons_pointer intarg,
+                                            struct cons_pointer ratarg ) {
+  struct cons_pointer result;
+
+  if (integerp(intarg) && ratiop(ratarg)) {
+    struct cons_pointer one = make_integer( 1 ),
+        ratio = make_ratio( frame, intarg, one );
+    result = multiply_ratio_ratio( frame, ratio, ratarg );
+
+    dec_ref( one );
+    dec_ref( ratio );
+  } else {
+    result = lisp_throw(
+      c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
+                            frame );
+  }
+
+    return result;
+}
+
+
+/**
+ * return a cons_pointer indicating a number which is the difference of
+ * the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
+ * this is going to break horribly.
+ */
+struct cons_pointer subtract_ratio_ratio( struct stack_frame *frame,
+                                          struct cons_pointer arg1,
+                                          struct cons_pointer arg2 ) {
+    struct cons_pointer i = inverse( frame, arg2 ),
+        result = add_ratio_ratio( frame, arg1, i );
+
+    dec_ref( i );
+
+    return result;
+}
+
+
+/**
+ * Construct a ratio frame from these two pointers, expected to be integers
+ * or (later) bignums, in the context of this stack_frame.
+ */
+struct cons_pointer make_ratio( struct stack_frame *frame,
+                                struct cons_pointer dividend,
+                                struct cons_pointer divisor ) {
+    struct cons_pointer result;
+    if ( integerp( dividend ) && integerp( divisor ) ) {
+        inc_ref( dividend );
+        inc_ref( divisor );
+        result = allocate_cell( RATIOTAG );
+        struct cons_space_object *cell = &pointer2cell( result );
+        cell->payload.ratio.dividend = dividend;
+        cell->payload.ratio.divisor = divisor;
+    } else {
+        result =
+            lisp_throw( c_string_to_lisp_string
+                            ( "Dividend and divisor of a ratio must be integers" ),
+                            frame );
+    }
+#ifdef DEBUG
+    dump_object( stderr, result );
+#endif
+
+    return result;
+}

src/arith/ratio.h

@@ -0,0 +1,48 @@
+/**
+ * ratio.h
+ *
+ * functions for rational number cells.
+ *
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#ifndef __ratio_h
+#define __ratio_h
+
+struct cons_pointer simplify_ratio( struct stack_frame *frame,
+                                    struct cons_pointer arg ) ;
+
+struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
+                                     struct cons_pointer arg1,
+                                     struct cons_pointer arg2 ) ;
+
+struct cons_pointer add_integer_ratio( struct stack_frame *frame,
+                                       struct cons_pointer intarg,
+                                       struct cons_pointer ratarg ) ;
+
+struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
+                                        struct cons_pointer arg1,
+                                        struct cons_pointer arg2 ) ;
+
+struct cons_pointer multiply_ratio_ratio( struct
+                                          stack_frame
+                                          *frame, struct
+                                          cons_pointer arg1, struct
+                                          cons_pointer arg2 ) ;
+
+struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
+                                            struct cons_pointer intarg,
+                                            struct cons_pointer ratarg ) ;
+
+struct cons_pointer subtract_ratio_ratio( struct stack_frame *frame,
+                                          struct cons_pointer arg1,
+                                          struct cons_pointer arg2 ) ;
+
+struct cons_pointer make_ratio( struct stack_frame *frame,
+                                struct cons_pointer dividend,
+                                struct cons_pointer divisor ) ;
+
+
+#endif

src/arith/real.c

@@ -22,5 +22,9 @@ struct cons_pointer make_real( long double value ) {
     struct cons_space_object *cell = &pointer2cell( result );
     cell->payload.real.value = value;
 
-    return result;
+#ifdef DEBUG
+    dump_object( stderr, result );
+#endif
+
+  return result;
 }

src/memory/consspaceobject.c

@@ -247,31 +247,6 @@ struct cons_pointer make_nlambda( struct cons_pointer args,
     return pointer;
 }
 
-/**
- * Construct a ratio frame from these two pointers, expected to be integers
- * or (later) bignums, in the context of this stack_frame.
- */
-struct cons_pointer make_ratio( struct stack_frame *frame,
-                                struct cons_pointer dividend,
-                                struct cons_pointer divisor ) {
-    struct cons_pointer result;
-    if ( integerp( dividend ) && integerp( divisor ) ) {
-        inc_ref( dividend );
-        inc_ref( divisor );
-        result = allocate_cell( RATIOTAG );
-        struct cons_space_object *cell = &pointer2cell( result );
-        cell->payload.ratio.dividend = dividend;
-        cell->payload.ratio.divisor = divisor;
-    } else {
-        result =
-            make_exception( c_string_to_lisp_string
-                            ( "Dividend and divisor of a ratio must be integers" ),
-                            frame );
-    }
-
-    return result;
-}
-
 /**
  * Construct a string from this character (which later will be UTF) and
  * this tail. A string is implemented as a flat list of cells each of which

src/ops/lispops.c

@@ -129,8 +129,7 @@ lisp_oblist( struct stack_frame *frame, struct cons_pointer env ) {
  * used to construct the body for `lambda` and `nlambda` expressions.
  */
 struct cons_pointer compose_body( struct stack_frame *frame ) {
-    struct cons_pointer body =
+    struct cons_pointer body = frame->more;
-        !nilp( frame->arg[args_in_frame - 1] ) ? frame->more : NIL;
 
     for ( int i = args_in_frame - 1; i > 0; i-- ) {
         if ( !nilp( body ) ) {

src/ops/read.c

@@ -22,6 +22,7 @@
 #include "intern.h"
 #include "lispops.h"
 #include "print.h"
+#include "ratio.h"
 #include "read.h"
 #include "real.h"