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

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
Download patch file Download diff file Expand all files Collapse all files

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 =

39
src/ops/lispops.c
View file

@ -172,7 +172,7 @@ void log_binding( struct cons_pointer name, struct cons_pointer val ) {
#ifdef DEBUG
fputws( L"\n\tBinding ", stderr );
print( stderr, name );
fputws( L" to ", stderr);
fputws( L" to ", stderr );
print( stderr, val );
fputws( L"\"\n", stderr );
#endif
@ -657,25 +657,25 @@ lisp_read( struct stack_frame *frame, struct cons_pointer env ) {
/**
* reverse a sequence.
*/
struct cons_pointer c_reverse( struct cons_pointer arg) {
struct cons_pointer result = NIL;
struct cons_pointer c_reverse( struct cons_pointer arg ) {
struct cons_pointer result = NIL;
for (struct cons_pointer p = arg; sequencep(p); p = c_cdr(p)) {
struct cons_space_object o = pointer2cell(p);
switch (o.tag.value) {
case CONSTV:
result = make_cons(o.payload.cons.car, result);
break;
case STRINGTV:
result = make_string(o.payload.string.character, result);
break;
case SYMBOLTV:
result = make_symbol(o.payload.string.character, result);
break;
for ( struct cons_pointer p = arg; sequencep( p ); p = c_cdr( p ) ) {
struct cons_space_object o = pointer2cell( p );
switch ( o.tag.value ) {
case CONSTV:
result = make_cons( o.payload.cons.car, result );
break;
case STRINGTV:
result = make_string( o.payload.string.character, result );
break;
case SYMBOLTV:
result = make_symbol( o.payload.string.character, result );
break;
}
}
}
return result;
return result;
}
@ -683,8 +683,9 @@ 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 ) {
return c_reverse( frame->arg[0]);
struct cons_pointer lisp_reverse( struct stack_frame *frame,
struct cons_pointer env ) {
return c_reverse( frame->arg[0] );
}

4
src/ops/lispops.h
View file

@ -40,7 +40,7 @@ struct cons_pointer c_car( struct cons_pointer arg );
*/
struct cons_pointer c_cdr( struct cons_pointer arg );
struct cons_pointer c_reverse( struct cons_pointer arg);
struct cons_pointer c_reverse( struct cons_pointer arg );
/**
* Useful building block; evaluate this single form in the context of this
@ -123,7 +123,7 @@ struct cons_pointer lisp_print( struct stack_frame *frame,
struct cons_pointer lisp_read( struct stack_frame *frame,
struct cons_pointer env );
struct cons_pointer lisp_reverse( struct stack_frame *frame,
struct cons_pointer env );
struct cons_pointer env );
/**
* Function: Get the Lisp type of the single argument.
* @param frame My stack frame.

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

44
src/ops/read.c
View file

@ -86,15 +86,15 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
case '"':
result = read_string( input, fgetwc( input ) );
break;
case '-': {
case '-':{
wint_t next = fgetwc( input );
ungetwc( next, input );
if ( iswdigit( next ) ) {
result = read_number( frame, input, c, false );
result = read_number( frame, input, c, false );
} else {
result = read_symbol( input, c );
result = read_symbol( input, c );
}
}
}
break;
case '.':
{
@ -119,11 +119,12 @@ 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
( "Unrecognised start of input character" ),
make_exception( make_cons( c_string_to_lisp_string
( "Unrecognised start of input character" ),
make_string( c, NIL ) ),
frame );
}
break;
break;
}
}
@ -142,14 +143,11 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
int64_t dividend = 0;
int places_of_decimals = 0;
wint_t c;
bool negative = initial == btowc( '-');
bool negative = initial == btowc( '-' );
if (negative) {
initial = fgetwc( input );
if ( negative ) {
initial = fgetwc( input );
}
#ifdef DEBUG
fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial );
#endif
@ -171,7 +169,7 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
} else {
dividend = negative ? 0 - accumulator : accumulator;
accumulator = 0;
accumulator = 0;
}
} else {
accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
@ -193,9 +191,9 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
if ( seen_period ) {
long double rv = ( long double )
( accumulator / pow( 10, places_of_decimals ) );
if (negative) {
rv = 0 - rv;
}
if ( negative ) {
rv = 0 - rv;
}
#ifdef DEBUG
fwprintf( stderr, L"read_numer returning %Lf\n", rv );
#endif
@ -205,9 +203,9 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
make_ratio( frame, make_integer( dividend ),
make_integer( accumulator ) );
} else {
if (negative) {
accumulator = 0 - accumulator;
}
if ( negative ) {
accumulator = 0 - accumulator;
}
result = make_integer( accumulator );
}
@ -224,15 +222,15 @@ struct cons_pointer read_list( struct
struct cons_pointer result = NIL;
if ( initial != ')' ) {
#ifdef DEBUG
fwprintf( stderr,
fwprintf( stderr,
L"read_list starting '%C' (%d)\n", initial, initial );
#endif
struct cons_pointer car = read_continuation( frame, input,
struct cons_pointer car = read_continuation( frame, input,
initial );
result = make_cons( car, read_list( frame, input, fgetwc( input ) ) );
}
#ifdef DEBUG
else {
else {
fwprintf( stderr, L"End of list detected\n" );
}
#endif