diff --git a/src/conspage.c b/src/conspage.c index ad83680..0e6532f 100644 --- a/src/conspage.c +++ b/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; diff --git a/src/consspaceobject.c b/src/consspaceobject.c index ef96c1f..38a2934 100644 --- a/src/consspaceobject.c +++ b/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 diff --git a/src/consspaceobject.h b/src/consspaceobject.h index ed5cbd1..de4d635 100644 --- a/src/consspaceobject.h +++ b/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, diff --git a/src/equal.c b/src/equal.c index 0f0597c..ebb085e 100644 --- a/src/equal.c +++ b/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. - string.cdr ) ) ); + && end_of_string( cell_b->payload.string. + cdr ) ) ); break; case INTEGERTV: result = diff --git a/src/lispops.c b/src/lispops.c index f29c658..371779c 100644 --- a/src/lispops.c +++ b/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); - print(stderr, result); - fputws( L"\n", stderr); + fputws( L"Print returning ", stderr ); + print( stderr, result ); + fputws( L"\n", stderr ); return result; } diff --git a/src/peano.c b/src/peano.c index 9d272df..7fffcb0 100644 --- a/src/peano.c +++ b/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++ ) { - result = add_q( frame, result, frame->arg[i] ); + for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i]) && !exceptionp(result); i++ ) { + result = add_2( frame, result, frame->arg[i] ); } struct cons_pointer more = frame->more; - while ( consp( more ) ) { - result = add_2( frame, result, c _car( more ) ); + while ( consp( more ) && !exceptionp(result) ) { + result = add_2( frame, result, c_car( more ) ); more = c_cdr( more ); } diff --git a/src/print.c b/src/print.c index 0ab42b2..6101c37 100644 --- a/src/print.c +++ b/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. - body ) ) ); + cell.payload. + 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. - body ) ) ); + cell.payload. + 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)" ); @@ -197,5 +202,5 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { fputws( L"\x1B[39m", output ); } - return pointer; + return pointer; } diff --git a/src/read.c b/src/read.c index 3bee19f..458c3f8 100644 --- a/src/read.c +++ b/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( '.' ) ) { - seen_period = true; + 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 ); } diff --git a/src/repl.c b/src/repl.c index 2ebf79d..f9ca5d5 100644 --- a/src/repl.c +++ b/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 ); } diff --git a/utils_src/tagvalcalc/tagvalcalc.c b/utils_src/tagvalcalc/tagvalcalc.c new file mode 100644 index 0000000..1159187 --- /dev/null +++ b/utils_src/tagvalcalc/tagvalcalc.c @@ -0,0 +1,9 @@ +#include +#include + +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]); + } +} diff --git a/utils_src/tagvalcalc/tvc b/utils_src/tagvalcalc/tvc new file mode 100755 index 0000000..8fb6cb3 Binary files /dev/null and b/utils_src/tagvalcalc/tvc differ