Added ratio numbers

(but some arithmetic is now broken)

src/conspage.c

@@ -145,6 +145,10 @@ void free_cell( struct cons_pointer pointer ) {
             dec_ref( cell->payload.lambda.args );
             dec_ref( cell->payload.lambda.body );
             break;
+        case RATIOTV:
+            dec_ref( cell->payload.ratio.dividend );
+            dec_ref( cell->payload.ratio.divisor );
+            break;
         case SPECIALTV:
             dec_ref( cell->payload.special.source );
             break;

src/consspaceobject.c

@@ -239,6 +239,31 @@ 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/consspaceobject.h

@@ -91,6 +91,12 @@
 #define REALTAG     "REAL"
 #define REALTV      1279346002
 
+/**
+ * A ratio.
+ */
+#define RATIOTAG    "RTIO"
+#define RATIOTV     1330205778
+
 /**
  * A special form - one whose arguments are not pre-evaluated but passed as a
  * s-expression. 1296453715
@@ -197,6 +203,11 @@
  */
 #define integerp(conspoint) (check_tag(conspoint,INTEGERTAG))
 
+/**
+ * true if conspointer points to a rational number cell, else false
+ */
+#define ratiop(conspoint) (check_tag(conspoint,RATIOTAG))
+
 /**
  * true if conspointer points to a read stream cell, else false
  */
@@ -317,10 +328,19 @@ struct lambda_payload {
     struct cons_pointer body;
 };
 
+/**
+ * payload for ratio cells. Both dividend and divisor must point to integer (or, later, bignum) cells.
+ */
+struct ratio_payload {
+    struct cons_pointer dividend;
+    struct cons_pointer divisor;
+};
+
 /**
  * payload for a real number cell. Internals of this liable to change to give 128 bits
  * precision, but I'm not sure of the detail.
- */ struct real_payload {
+ */
+struct real_payload {
     long double value;
 };
 
@@ -418,6 +438,10 @@ struct cons_space_object {
          * if tag == NILTAG; we'll treat the special cell NIL as just a cons
          */
         struct cons_payload nil;
+        /*
+         * if tag == RATIOTAG
+         */
+        struct ratio_payload ratio;
         /*
          * if tag == READTAG || tag == WRITETAG
          */
@@ -496,7 +520,15 @@ struct cons_pointer make_lambda( struct cons_pointer args,
 struct cons_pointer make_nlambda( struct cons_pointer args,
                                   struct cons_pointer body );
 
-  /**
+/**
+ * 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 );
+
+/**
  * Construct a cell which points to an executable Lisp special form.
  */
 struct cons_pointer make_special( struct cons_pointer src,

src/equal.c

@@ -80,8 +80,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     && ( equal( cell_a->payload.string.cdr,
                                 cell_b->payload.string.cdr )
                          || ( end_of_string( cell_a->payload.string.cdr )
-                              && end_of_string( cell_b->payload.
+                              && end_of_string( cell_b->payload.string.
-                                                string.cdr ) ) );
+                                                cdr ) ) );
                 break;
             case INTEGERTV:
                 result =

src/lispops.c

@@ -659,9 +659,9 @@ lisp_print( struct stack_frame *frame, struct cons_pointer env ) {
 
     result = print( output, frame->arg[0] );
 
-  fputws( L"Print returning ", stderr);
+    fputws( L"Print returning ", stderr );
-  print(stderr, result);
+    print( stderr, result );
-  fputws( L"\n", stderr);
+    fputws( L"\n", stderr );
 
     return result;
 }

src/peano.c

@@ -27,6 +27,8 @@
 
 long double to_long_double( struct cons_pointer arg );
 long int to_long_int( struct stack_frame *frame, struct cons_pointer arg );
+struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
+                           struct cons_pointer arg2 );
 
 
 bool zerop( struct cons_pointer arg ) {
@@ -118,6 +120,52 @@ long int least_common_multiplier( long int m, long int n ) {
     return m / greatest_common_divisor( m, n ) * n;
 }
 
+/**
+ * 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 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_multiplier(dr1v, dr2v),
+  m1 = lcm/dr2v,
+  m2 = lcm/dr1v;
+
+  if (dr1v == dr2v) {
+    result = make_ratio( frame, add_2(frame, cell1.payload.ratio.dividend, cell2.payload.ratio.dividend),
+                        cell1.payload.ratio.divisor);
+  } else {
+  result = make_ratio( frame,
+                      make_integer((dd1v * m1) + (dd2v * m2)),
+                    make_integer((dr1v * m1) + (dr2v * m2)));
+    }
+
+    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 ) {
+  return add_ratio_ratio( frame,
+                         make_ratio( frame, intarg, make_integer( 1)),
+                         ratarg);
+}
+
+
 /**
 * return a cons_pointer indicating a number which is the sum of
 * the numbers indicated by `arg1` and `arg2`.
@@ -136,23 +184,23 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
 
         switch ( cell1.tag.value ) {
             case EXCEPTIONTV:
-                result = cell1;
+                result = arg1;
                 break;
             case INTEGERTV:
                 switch ( cell2.tag.value ) {
                     case EXCEPTIONTV:
-                        result = cell2;
+                        result = arg2;
                         break;
                     case INTEGERTV:
                         make_integer( cell1.payload.integer.value +
                                       cell2.payload.integer.value );
                         break;
                     case RATIOTV:
-                        result = add_integer_ratio( arg1, arg2 );
+                        result = add_integer_ratio( frame, arg1, arg2 );
                         break;
                     case REALTV:
                         result =
-                            make_real( cell1.payload.integer.value +
+                            make_real( to_long_double(arg1) +
                                        cell2.payload.real.value );
                         break;
                     default:
@@ -164,17 +212,18 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
             case RATIOTV:
                 switch ( cell2.tag.value ) {
                     case EXCEPTIONTV:
-                        result = cell2;
+                        result = arg2;
                         break;
                     case INTEGERTV:
-                        result = add_integer_ratio( arg1, arg2 );
+                        result = add_integer_ratio( frame, arg2, arg1 );
                         break;
                     case RATIOTV:
+                        result = add_ratio_ratio( frame, arg1, arg2);
                         break;
                     case REALTV:
                         result =
                             make_real( cell2.payload.real.value +
-                                       ratio_to_long_double( arg1 ) );
+                                       to_long_double( arg1 ) );
                         break;
                 }
         }
@@ -192,15 +241,14 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
 struct cons_pointer lisp_add( struct stack_frame
                               *frame, struct
                               cons_pointer env ) {
-    struct cons_pointer result = NIL;
     struct cons_pointer result = make_integer( 0 );
-    for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
+    for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i]) && !exceptionp(result); i++ ) {
-        result = add_q( frame, result, frame->arg[i] );
+        result = add_2( frame, result, frame->arg[i] );
     }
 
     struct cons_pointer more = frame->more;
-    while ( consp( more ) ) {
+    while ( consp( more )  && !exceptionp(result) ) {
-        result = add_2( frame, result, c _car( more ) );
+        result = add_2( frame, result, c_car( more ) );
         more = c_cdr( more );
     }
 

src/print.c

@@ -132,8 +132,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
         case LAMBDATV:
             print( output, make_cons( c_string_to_lisp_symbol( "lambda" ),
                                       make_cons( cell.payload.lambda.args,
-                                                 cell.payload.lambda.
+                                                 cell.payload.
-                                                 body ) ) );
+                                                 lambda.body ) ) );
             break;
         case NILTV:
             fwprintf( output, L"nil" );
@@ -141,8 +141,13 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
         case NLAMBDATV:
             print( output, make_cons( c_string_to_lisp_symbol( "nlambda" ),
                                       make_cons( cell.payload.lambda.args,
-                                                 cell.payload.lambda.
+                                                 cell.payload.
-                                                 body ) ) );
+                                                 lambda.body ) ) );
+            break;
+        case RATIOTV:
+            print( output, cell.payload.ratio.dividend );
+            fputws( L"/", output );
+            print( output, cell.payload.ratio.divisor );
             break;
         case READTV:
             fwprintf( output, L"(Input stream)" );

src/read.c

@@ -31,7 +31,8 @@
  * atoms because I don't yet know what an atom is or how it's stored.
  */
 
-struct cons_pointer read_number( FILE * input, wint_t initial );
+struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
+                                 wint_t initial, bool seen_period );
 struct cons_pointer read_list( struct stack_frame *frame, FILE * input,
                                wint_t initial );
 struct cons_pointer read_string( FILE * input, wint_t initial );
@@ -89,7 +90,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
                     wint_t next = fgetwc( input );
                     if ( iswdigit( next ) ) {
                         ungetwc( next, input );
-                        result = read_number( input, c );
+                        result = read_number( frame, input, c, true );
                     } else if ( iswblank( next ) ) {
                         /* dotted pair. TODO: this isn't right, we
                          * really need to backtrack up a level. */
@@ -102,7 +103,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
                 break;
             default:
                 if ( iswdigit( c ) ) {
-                    result = read_number( input, c );
+                    result = read_number( frame, input, c, false );
                 } else if ( iswprint( c ) ) {
                     result = read_symbol( input, c );
                 } else {
@@ -120,17 +121,33 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
 /**
  * read a number from this input stream, given this initial character.
  */
-struct cons_pointer read_number( FILE * input, wint_t initial ) {
+struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
+                                 wint_t initial, bool seen_period ) {
     struct cons_pointer result = NIL;
     long int accumulator = 0;
+    long int dividend = 0;
     int places_of_decimals = 0;
-    bool seen_period = false;
     wint_t c;
     fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial );
     for ( c = initial; iswdigit( c )
-          || c == btowc( '.' ); c = fgetwc( input ) ) {
+          || c == btowc( '.' ) || c == btowc( '/' ); c = fgetwc( input ) ) {
         if ( c == btowc( '.' ) ) {
+            if ( seen_period || dividend > 0 ) {
+                return make_exception( c_string_to_lisp_string
+                                       ( "Malformed number: too many periods" ),
+                                       frame );
+            } else {
                 seen_period = true;
+            }
+        } else if ( c == btowc( '/' ) ) {
+            if ( seen_period || dividend > 0 ) {
+                return make_exception( c_string_to_lisp_string
+                                       ( "Malformed number: dividend must be integer" ),
+                                       frame );
+            } else {
+                dividend = accumulator;
+                accumulator = 0;
+            }
         } else {
             accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
             fwprintf( stderr,
@@ -151,6 +168,10 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
             ( accumulator / pow( 10, places_of_decimals ) );
         fwprintf( stderr, L"read_numer returning %Lf\n", rv );
         result = make_real( rv );
+    } else if ( dividend > 0 ) {
+        result =
+            make_ratio( frame, make_integer( dividend ),
+                        make_integer( accumulator ) );
     } else {
         result = make_integer( accumulator );
     }

src/repl.c

@@ -96,6 +96,7 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
         inc_ref( input );
 
         if ( exceptionp( input ) ) {
+            /* suppress the end-of-stream exception */
             if ( !feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
                 repl_print( output_stream, input );
             }

utils_src/tagvalcalc/tagvalcalc.c

@@ -0,0 +1,9 @@
+#include <stdint.h>
+#include <stdio.h>
+
+int main( int argc, char *argv[] ) {
+
+  for (int i = 1; i < argc; i++) {
+    printf( "%4.4s:\t%u\n", argv[i], (uint32_t)*argv[i]);
+  }
+}