Whitespace only changes
This commit is contained in:
parent
8231c74bae
commit
40e1f3ca64
17 changed files with 283 additions and 269 deletions
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -57,22 +57,22 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
|
|||
struct cons_space_object entry =
|
||||
pointer2cell( pointer2cell( next ).payload.cons.car );
|
||||
|
||||
debug_print( L"Internedp: checking whether `", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L"` equals `", DEBUG_BIND );
|
||||
debug_print_object( entry.payload.cons.car, DEBUG_BIND );
|
||||
debug_print( L"`\n", DEBUG_BIND );
|
||||
debug_print( L"Internedp: checking whether `", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L"` equals `", DEBUG_BIND );
|
||||
debug_print_object( entry.payload.cons.car, DEBUG_BIND );
|
||||
debug_print( L"`\n", DEBUG_BIND );
|
||||
|
||||
if ( equal( key, entry.payload.cons.car ) ) {
|
||||
result = entry.payload.cons.car;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
debug_print( L"`", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L"` is a ", DEBUG_BIND );
|
||||
debug_print_object( c_type( key ), DEBUG_BIND );
|
||||
debug_print( L", not a SYMB", DEBUG_BIND );
|
||||
debug_print( L"`", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L"` is a ", DEBUG_BIND );
|
||||
debug_print_object( c_type( key ), DEBUG_BIND );
|
||||
debug_print( L", not a SYMB", DEBUG_BIND );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -111,11 +111,11 @@ struct cons_pointer c_assoc( struct cons_pointer key,
|
|||
struct cons_pointer
|
||||
bind( struct cons_pointer key, struct cons_pointer value,
|
||||
struct cons_pointer store ) {
|
||||
debug_print(L"Binding ", DEBUG_BIND);
|
||||
debug_print_object(key, DEBUG_BIND);
|
||||
debug_print(L" to ", DEBUG_BIND);
|
||||
debug_print_object(value, DEBUG_BIND);
|
||||
debug_println( DEBUG_BIND);
|
||||
debug_print( L"Binding ", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L" to ", DEBUG_BIND );
|
||||
debug_print_object( value, DEBUG_BIND );
|
||||
debug_println( DEBUG_BIND );
|
||||
|
||||
return make_cons( make_cons( key, value ), store );
|
||||
}
|
||||
|
|
@ -127,11 +127,11 @@ bind( struct cons_pointer key, struct cons_pointer value,
|
|||
*/
|
||||
struct cons_pointer
|
||||
deep_bind( struct cons_pointer key, struct cons_pointer value ) {
|
||||
debug_print( L"Entering deep_bind\n", DEBUG_BIND );
|
||||
debug_print( L"Entering deep_bind\n", DEBUG_BIND );
|
||||
|
||||
oblist = bind( key, value, oblist );
|
||||
|
||||
debug_print( L"Leaving deep_bind\n", DEBUG_BIND );
|
||||
debug_print( L"Leaving deep_bind\n", DEBUG_BIND );
|
||||
|
||||
return oblist;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -212,7 +212,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
|
|||
|
||||
names = c_cdr( names );
|
||||
}
|
||||
/* TODO: if there's more than `args_in_frame` arguments, bind those too. */
|
||||
/* TODO: if there's more than `args_in_frame` arguments, bind those too. */
|
||||
} else if ( symbolp( names ) ) {
|
||||
/* if `names` is a symbol, rather than a list of symbols,
|
||||
* then bind a list of the values of args to that symbol. */
|
||||
|
|
@ -255,8 +255,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
|
|||
struct cons_pointer
|
||||
c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
debug_print(L"Entering c_apply\n", DEBUG_EVAL);
|
||||
struct cons_pointer result = NIL;
|
||||
debug_print( L"Entering c_apply\n", DEBUG_EVAL );
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
struct cons_pointer fn_pointer =
|
||||
eval_form( frame, frame_pointer, c_car( frame->arg[0] ), env );
|
||||
|
|
@ -264,103 +264,107 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
|||
if ( exceptionp( fn_pointer ) ) {
|
||||
result = fn_pointer;
|
||||
} else {
|
||||
struct cons_space_object fn_cell = pointer2cell( fn_pointer );
|
||||
struct cons_pointer args = c_cdr( frame->arg[0] );
|
||||
struct cons_space_object fn_cell = pointer2cell( fn_pointer );
|
||||
struct cons_pointer args = c_cdr( frame->arg[0] );
|
||||
|
||||
switch ( fn_cell.tag.value ) {
|
||||
case EXCEPTIONTV:
|
||||
/* just pass exceptions straight back */
|
||||
result = fn_pointer;
|
||||
break;
|
||||
case FUNCTIONTV:
|
||||
{
|
||||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
struct stack_frame *next = get_stack_frame( next_pointer );
|
||||
switch ( fn_cell.tag.value ) {
|
||||
case EXCEPTIONTV:
|
||||
/* just pass exceptions straight back */
|
||||
result = fn_pointer;
|
||||
break;
|
||||
case FUNCTIONTV:
|
||||
{
|
||||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
struct stack_frame *next =
|
||||
get_stack_frame( next_pointer );
|
||||
|
||||
result =
|
||||
( *fn_cell.payload.function.executable ) ( next,
|
||||
next_pointer,
|
||||
env );
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
break;
|
||||
case LAMBDATV:
|
||||
{
|
||||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
struct stack_frame *next = get_stack_frame( next_pointer );
|
||||
result = eval_lambda( fn_cell, next, next_pointer, env );
|
||||
if ( !exceptionp( result ) ) {
|
||||
result =
|
||||
( *fn_cell.payload.function.executable ) ( next,
|
||||
next_pointer,
|
||||
env );
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
case NLAMBDATV:
|
||||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_special_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
struct stack_frame *next =
|
||||
get_stack_frame( next_pointer );
|
||||
result = eval_lambda( fn_cell, next, next_pointer, env );
|
||||
break;
|
||||
case LAMBDATV:
|
||||
{
|
||||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
struct stack_frame *next =
|
||||
get_stack_frame( next_pointer );
|
||||
result =
|
||||
eval_lambda( fn_cell, next, next_pointer, env );
|
||||
if ( !exceptionp( result ) ) {
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
case NLAMBDATV:
|
||||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_special_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
struct stack_frame *next =
|
||||
get_stack_frame( next_pointer );
|
||||
result =
|
||||
eval_lambda( fn_cell, next, next_pointer, env );
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
case SPECIALTV:
|
||||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_special_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
result =
|
||||
( *fn_cell.payload.special.executable ) ( get_stack_frame( next_pointer ),
|
||||
next_pointer,
|
||||
env );
|
||||
debug_print(L"Special form returning: ", DEBUG_EVAL);
|
||||
debug_print_object(result, DEBUG_EVAL);
|
||||
debug_println(DEBUG_EVAL);
|
||||
dec_ref( next_pointer );
|
||||
break;
|
||||
case SPECIALTV:
|
||||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_special_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
result =
|
||||
( *fn_cell.payload.special.
|
||||
executable ) ( get_stack_frame( next_pointer ),
|
||||
next_pointer, env );
|
||||
debug_print( L"Special form returning: ", DEBUG_EVAL );
|
||||
debug_print_object( result, DEBUG_EVAL );
|
||||
debug_println( DEBUG_EVAL );
|
||||
dec_ref( next_pointer );
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
default:
|
||||
{
|
||||
int bs = sizeof(wchar_t) * 1024;
|
||||
wchar_t *buffer = malloc( bs );
|
||||
memset( buffer, '\0', bs );
|
||||
swprintf( buffer, bs,
|
||||
L"Unexpected cell with tag %d (%4.4s) in function position",
|
||||
fn_cell.tag.value, &fn_cell.tag.bytes[0] );
|
||||
struct cons_pointer message =
|
||||
c_string_to_lisp_string( buffer );
|
||||
free( buffer );
|
||||
result = throw_exception( message, frame_pointer );
|
||||
}
|
||||
}
|
||||
break;
|
||||
default:
|
||||
{
|
||||
int bs = sizeof( wchar_t ) * 1024;
|
||||
wchar_t *buffer = malloc( bs );
|
||||
memset( buffer, '\0', bs );
|
||||
swprintf( buffer, bs,
|
||||
L"Unexpected cell with tag %d (%4.4s) in function position",
|
||||
fn_cell.tag.value, &fn_cell.tag.bytes[0] );
|
||||
struct cons_pointer message =
|
||||
c_string_to_lisp_string( buffer );
|
||||
free( buffer );
|
||||
result = throw_exception( message, frame_pointer );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
debug_print(L"c_apply: returning: ", DEBUG_EVAL);
|
||||
debug_print_object(result, DEBUG_EVAL);
|
||||
debug_println(DEBUG_EVAL);
|
||||
debug_print( L"c_apply: returning: ", DEBUG_EVAL );
|
||||
debug_print_object( result, DEBUG_EVAL );
|
||||
debug_println( DEBUG_EVAL );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -375,9 +379,8 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
|
|||
struct cons_pointer result = NIL;
|
||||
struct cons_space_object cell = pointer2cell( pointer );
|
||||
|
||||
for (int i = TAGLENGTH -1; i >= 0; i--)
|
||||
{
|
||||
result = make_string((wchar_t)cell.tag.bytes[i], result);
|
||||
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
|
||||
result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
|
|||
|
|
@ -133,8 +133,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
|
|||
case LAMBDATV:
|
||||
print( output, make_cons( c_string_to_lisp_symbol( L"lambda" ),
|
||||
make_cons( cell.payload.lambda.args,
|
||||
cell.payload.lambda.
|
||||
body ) ) );
|
||||
cell.payload.
|
||||
lambda.body ) ) );
|
||||
break;
|
||||
case NILTV:
|
||||
fwprintf( output, L"nil" );
|
||||
|
|
@ -142,8 +142,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
|
|||
case NLAMBDATV:
|
||||
print( output, make_cons( c_string_to_lisp_symbol( L"nlambda" ),
|
||||
make_cons( cell.payload.lambda.args,
|
||||
cell.payload.lambda.
|
||||
body ) ) );
|
||||
cell.payload.
|
||||
lambda.body ) ) );
|
||||
break;
|
||||
case RATIOTV:
|
||||
print( output, cell.payload.ratio.dividend );
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
|
|||
if ( feof( input ) ) {
|
||||
result =
|
||||
throw_exception( c_string_to_lisp_string
|
||||
( L"End of file while reading" ), frame_pointer );
|
||||
( L"End of file while reading" ), frame_pointer );
|
||||
} else {
|
||||
switch ( c ) {
|
||||
case ';':
|
||||
|
|
@ -137,9 +137,9 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
|
|||
} else {
|
||||
result =
|
||||
throw_exception( make_cons( c_string_to_lisp_string
|
||||
( L"Unrecognised start of input character" ),
|
||||
make_string( c, NIL ) ),
|
||||
frame_pointer );
|
||||
( L"Unrecognised start of input character" ),
|
||||
make_string( c, NIL ) ),
|
||||
frame_pointer );
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
|
@ -171,23 +171,24 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
initial = fgetwc( input );
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_IO, L"read_number starting '%c' (%d)\n", initial, initial );
|
||||
debug_printf( DEBUG_IO, L"read_number starting '%c' (%d)\n", initial,
|
||||
initial );
|
||||
|
||||
for ( c = initial; iswdigit( c )
|
||||
|| c == btowc( '.' ) || c == btowc( '/' ); c = fgetwc( input ) ) {
|
||||
if ( c == btowc( '.' ) ) {
|
||||
if ( seen_period || dividend != 0 ) {
|
||||
return throw_exception( c_string_to_lisp_string
|
||||
( L"Malformed number: too many periods" ),
|
||||
frame_pointer );
|
||||
( L"Malformed number: too many periods" ),
|
||||
frame_pointer );
|
||||
} else {
|
||||
seen_period = true;
|
||||
}
|
||||
} else if ( c == btowc( '/' ) ) {
|
||||
if ( seen_period || dividend > 0 ) {
|
||||
return throw_exception( c_string_to_lisp_string
|
||||
( L"Malformed number: dividend of rational must be integer" ),
|
||||
frame_pointer );
|
||||
( L"Malformed number: dividend of rational must be integer" ),
|
||||
frame_pointer );
|
||||
} else {
|
||||
dividend = negative ? 0 - accumulator : accumulator;
|
||||
|
||||
|
|
@ -197,8 +198,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
|
||||
|
||||
debug_printf( DEBUG_IO,
|
||||
L"Added character %c, accumulator now %ld\n",
|
||||
c, accumulator );
|
||||
L"Added character %c, accumulator now %ld\n",
|
||||
c, accumulator );
|
||||
|
||||
if ( seen_period ) {
|
||||
places_of_decimals++;
|
||||
|
|
@ -244,7 +245,7 @@ struct cons_pointer read_list( struct stack_frame *frame,
|
|||
struct cons_pointer result = NIL;
|
||||
if ( initial != ')' ) {
|
||||
debug_printf( DEBUG_IO,
|
||||
L"read_list starting '%C' (%d)\n", initial, initial );
|
||||
L"read_list starting '%C' (%d)\n", initial, initial );
|
||||
struct cons_pointer car =
|
||||
read_continuation( frame, frame_pointer, input,
|
||||
initial );
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue