simon/post-scarcity
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Added ratio numbers

Browse source 
(but some arithmetic is now broken)
This commit is contained in:
Simon Brooke 2018-12-23 20:02:00 +00:00
parent ea1d4ce7ed
commit 4c9fdfc3db
11 changed files with 176 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/conspage.c
View file

@ -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;

25
src/consspaceobject.c
View file

@ -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

36
src/consspaceobject.h
View file

@ -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,

4
src/equal.c
View file

@ -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 =

6
src/lispops.c
View file

@ -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;
}

72
src/peano.c
View file

@ -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 );
}

15
src/print.c
View file

@ -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;
}

35
src/read.c
View file

@ -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 );
}

1
src/repl.c
View file

@ -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 );
}

9
utils_src/tagvalcalc/tagvalcalc.c Normal file
View file

@ -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]);
}
}

BIN
utils_src/tagvalcalc/tvc Executable file
View file

Binary file not shown.