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

Better exceptions, investigation on failure to read/print wide chars.

Browse source
This commit is contained in:
Simon Brooke 2018-12-25 15:32:45 +00:00
parent 9ff2f14c7d
commit ae8ba67ed7
13 changed files with 217 additions and 183 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -28,3 +28,5 @@ log*
\.project
\.settings/language\.settings\.xml
utils_src/readprintwc/out

4
src/arith/peano.c
View file

@ -406,8 +406,8 @@ struct cons_pointer inverse( struct stack_frame *frame,
case RATIOTV:
result = make_ratio( frame,
make_integer( 0 -
to_long_int( cell.payload.
ratio.dividend ) ),
to_long_int( cell.payload.ratio.
dividend ) ),
cell.payload.ratio.divisor );
break;
case REALTV:

50
src/arith/ratio.c
View file

@ -60,10 +60,10 @@ struct cons_pointer simplify_ratio( struct stack_frame *frame,
if ( ratiop( arg ) ) {
int64_t 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 );
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 ) {
@ -75,9 +75,10 @@ struct cons_pointer simplify_ratio( struct stack_frame *frame,
}
}
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to simplify_ratio" ),
frame );
result =
lisp_throw( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to simplify_ratio" ),
arg ), frame );
}
return result;
@ -147,8 +148,11 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
dec_ref( r );
}
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to add_ratio_ratio" ),
result =
lisp_throw( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_ratio_ratio" ),
make_cons( arg1,
make_cons( arg2, NIL ) ) ),
frame );
}
@ -181,8 +185,11 @@ struct cons_pointer add_integer_ratio( struct stack_frame *frame,
dec_ref( one );
dec_ref( ratio );
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to add_integer_ratio" ),
result =
lisp_throw( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_integer_ratio" ),
make_cons( intarg,
make_cons( ratarg, NIL ) ) ),
frame );
}
@ -198,10 +205,10 @@ 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 =
pointer2cell( arg2 ).payload.ratio.
divisor,
pointer2cell( arg2 ).payload.ratio.
dividend ), result =
multiply_ratio_ratio( frame, arg1, i );
dec_ref( i );
@ -241,7 +248,8 @@ struct cons_pointer multiply_ratio_ratio( struct
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
struct cons_pointer unsimplified = make_ratio( frame, make_integer( ddrv ),
struct cons_pointer unsimplified =
make_ratio( frame, make_integer( ddrv ),
make_integer( drrv ) );
result = simplify_ratio( frame, unsimplified );
@ -249,8 +257,9 @@ struct cons_pointer multiply_ratio_ratio( struct
dec_ref( unsimplified );
}
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
result =
lisp_throw( c_string_to_lisp_string
( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
frame );
}
@ -275,8 +284,9 @@ struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
dec_ref( one );
dec_ref( ratio );
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
result =
lisp_throw( c_string_to_lisp_string
( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
frame );
}

1
src/init.c
View file

@ -111,6 +111,7 @@ int main( int argc, char *argv[] ) {
*/
bind_special( "cond", &lisp_cond );
bind_special( "lambda", &lisp_lambda );
/* bind_special( "λ", &lisp_lambda ); */
bind_special( "nlambda", &lisp_nlambda );
bind_special( "progn", &lisp_progn );
bind_special( "quote", &lisp_quote );

8
src/memory/consspaceobject.c
View file

@ -136,10 +136,10 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
case RATIOTV:
fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ).
payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ).
payload.integer.value, cell.count );
pointer2cell( cell.payload.ratio.dividend ).payload.
integer.value,
pointer2cell( cell.payload.ratio.divisor ).payload.
integer.value, cell.count );
break;
case READTV:
fwprintf( output, L"\t\tInput stream\n" );

4
src/ops/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 =

3
src/ops/lispops.c
View file

@ -683,7 +683,8 @@ struct cons_pointer c_reverse( struct cons_pointer arg) {
* (reverse sequence)
* Return a sequence like this sequence but with the members in the reverse order.
*/
struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer lisp_reverse( struct stack_frame *frame,
struct cons_pointer env ) {
return c_reverse( frame->arg[0] );
}

15
src/ops/print.c
View file

@ -118,7 +118,12 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
case EXCEPTIONTV:
fwprintf( output, L"\n%sException: ",
print_use_colours ? "\x1B[31m" : "" );
print_string_contents( output, cell.payload.exception.message );
if ( stringp( cell.payload.exception.message ) ) {
print_string_contents( output,
cell.payload.exception.message );
} else {
print( output, cell.payload.exception.message );
}
break;
case FUNCTIONTV:
fwprintf( output, L"(Function)" );
@ -132,8 +137,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 +146,8 @@ 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 );

6
src/ops/read.c
View file

@ -119,8 +119,9 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
result = read_symbol( input, c );
} else {
result =
make_exception( c_string_to_lisp_string
make_exception( make_cons( c_string_to_lisp_string
( "Unrecognised start of input character" ),
make_string( c, NIL ) ),
frame );
}
break;
@ -147,9 +148,6 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
if ( negative ) {
initial = fgetwc( input );
}
#ifdef DEBUG
fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial );
#endif

17
utils_src/readprintwc/readprintwc.c Normal file
View file

@ -0,0 +1,17 @@
#include <stdio.h>
#include <stdlib.h>
#include <wchar.h>
#include <wctype.h>
int main( int argc, char *argv[] ) {
fwide( stdin, 1 );
fwide( stdout, 1 );
for (wchar_t c = fgetwc( stdin ); !feof( stdin); c = fgetwc( stdin )) {
if (c != '\n') {
fwprintf( stdout, L"Read character %d, %C\t", (int)c, c);
fputwc( c, stdout);
fputws(L"\n", stdout);
}
}
}