From 9bfc9074b05cdc5a3275bc11179b0328b6b346cf Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 8 Dec 2018 14:09:57 +0000 Subject: [PATCH] Improved (for me) formatting on Mac Don't yet know whether this will work on Linux. --- Makefile | 2 +- src/conspage.c | 68 ++++++++++----------- src/consspaceobject.c | 79 ++++++++++++------------ src/equal.c | 74 +++++++++++----------- src/init.c | 18 +++--- src/lispops.c | 139 +++++++++++++++++++++++++++--------------- src/peano.c | 44 ++++++------- src/print.c | 128 +++++++++++++++++++------------------- src/read.c | 135 ++++++++++++++++++++-------------------- 9 files changed, 368 insertions(+), 319 deletions(-) diff --git a/Makefile b/Makefile index bf818ac..4797c75 100644 --- a/Makefile +++ b/Makefile @@ -11,7 +11,7 @@ TESTS := $(shell find unit-tests -name *.sh) INC_DIRS := $(shell find $(SRC_DIRS) -type d) INC_FLAGS := $(addprefix -I,$(INC_DIRS)) -INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli0 \ +INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \ -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \ -npsl -nsc -nsob -nss -nut -prs -l79 -ts2 diff --git a/src/conspage.c b/src/conspage.c index f044c93..9845284 100644 --- a/src/conspage.c +++ b/src/conspage.c @@ -56,40 +56,40 @@ void make_cons_page( ) { &conspages[initialised_cons_pages]->cell[i]; if ( initialised_cons_pages == 0 && i < 3 ) { switch ( i ) { - case 0: - /* - * initialise cell as NIL - */ - strncpy( &cell->tag.bytes[0], NILTAG, TAGLENGTH ); - cell->count = MAXREFERENCE; - cell->payload.free.car = NIL; - cell->payload.free.cdr = NIL; - fwprintf( stderr, L"Allocated special cell NIL\n" ); - break; - case 1: - /* - * initialise cell as T - */ - strncpy( &cell->tag.bytes[0], TRUETAG, TAGLENGTH ); - cell->count = MAXREFERENCE; - cell->payload.free.car = ( struct cons_pointer ) { - 0, 1 - }; - cell->payload.free.cdr = ( struct cons_pointer ) { - 0, 1 - }; - fwprintf( stderr, L"Allocated special cell T\n" ); - break; - case 2: - /* - * initialise cell as λ - */ - strncpy( &cell->tag.bytes[0], LAMBDATAG, TAGLENGTH ); - cell->count = MAXREFERENCE; - cell->payload.string.character = ( wint_t ) L'λ'; - cell->payload.free.cdr = NIL; - fwprintf( stderr, L"Allocated special cell LAMBDA\n" ); - break; + case 0: + /* + * initialise cell as NIL + */ + strncpy( &cell->tag.bytes[0], NILTAG, TAGLENGTH ); + cell->count = MAXREFERENCE; + cell->payload.free.car = NIL; + cell->payload.free.cdr = NIL; + fwprintf( stderr, L"Allocated special cell NIL\n" ); + break; + case 1: + /* + * initialise cell as T + */ + strncpy( &cell->tag.bytes[0], TRUETAG, TAGLENGTH ); + cell->count = MAXREFERENCE; + cell->payload.free.car = ( struct cons_pointer ) { + 0, 1 + }; + cell->payload.free.cdr = ( struct cons_pointer ) { + 0, 1 + }; + fwprintf( stderr, L"Allocated special cell T\n" ); + break; + case 2: + /* + * initialise cell as λ + */ + strncpy( &cell->tag.bytes[0], LAMBDATAG, TAGLENGTH ); + cell->count = MAXREFERENCE; + cell->payload.string.character = ( wint_t ) L'λ'; + cell->payload.free.cdr = NIL; + fwprintf( stderr, L"Allocated special cell LAMBDA\n" ); + break; } } else { /* diff --git a/src/consspaceobject.c b/src/consspaceobject.c index 0c2260d..1b6173f 100644 --- a/src/consspaceobject.c +++ b/src/consspaceobject.c @@ -100,45 +100,46 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { cell.tag.value, pointer.page, pointer.offset, cell.count ); switch ( cell.tag.value ) { - case CONSTV: - fwprintf( output, - L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u\n", - cell.payload.cons.car.page, - cell.payload.cons.car.offset, - cell.payload.cons.cdr.page, - cell.payload.cons.cdr.offset, cell.count ); - break; - case EXCEPTIONTV: - fwprintf( output, L"\t\tException cell: " ); - print( output, cell.payload.exception.message ); - fwprintf( output, L"\n" ); - /* TODO: dump the stack trace */ - for ( struct stack_frame * frame = cell.payload.exception.frame; - frame != NULL; frame = frame->previous ) { - dump_frame( output, frame ); - } - break; - case FREETV: - fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", - cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); - break; - case INTEGERTV: - fwprintf( output, - L"\t\tInteger cell: value %ld, count %u\n", - cell.payload.integer.value, cell.count ); - break; - case READTV: - fwprintf( output, L"\t\tInput stream\n" ); - case REALTV: - fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", - cell.payload.real.value, cell.count ); - break; - case STRINGTV: - dump_string_cell( output, L"String", pointer ); - break; - case SYMBOLTV: - dump_string_cell( output, L"Symbol", pointer ); - break; + case CONSTV: + fwprintf( output, + L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u\n", + cell.payload.cons.car.page, + cell.payload.cons.car.offset, + cell.payload.cons.cdr.page, + cell.payload.cons.cdr.offset, cell.count ); + break; + case EXCEPTIONTV: + fwprintf( output, L"\t\tException cell: " ); + print( output, cell.payload.exception.message ); + fwprintf( output, L"\n" ); + /* TODO: dump the stack trace */ + for ( struct stack_frame * frame = cell.payload.exception.frame; + frame != NULL; frame = frame->previous ) { + dump_frame( output, frame ); + } + break; + case FREETV: + fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", + cell.payload.cons.cdr.page, + cell.payload.cons.cdr.offset ); + break; + case INTEGERTV: + fwprintf( output, + L"\t\tInteger cell: value %ld, count %u\n", + cell.payload.integer.value, cell.count ); + break; + case READTV: + fwprintf( output, L"\t\tInput stream\n" ); + case REALTV: + fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", + cell.payload.real.value, cell.count ); + break; + case STRINGTV: + dump_string_cell( output, L"String", pointer ); + break; + case SYMBOLTV: + dump_string_cell( output, L"Symbol", pointer ); + break; } } diff --git a/src/equal.c b/src/equal.c index 43e9424..d06903f 100644 --- a/src/equal.c +++ b/src/equal.c @@ -59,44 +59,46 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { struct cons_space_object *cell_b = &pointer2cell( b ); switch ( cell_a->tag.value ) { - case CONSTV: - result = - equal( cell_a->payload.cons.car, cell_b->payload.cons.car ) - && equal( cell_a->payload.cons.cdr, cell_b->payload.cons.cdr ); - break; - case STRINGTV: - case SYMBOLTV: - /* - * slightly complex because a string may or may not have a '\0' - * cell at the end, but I'll ignore that for now. I think in - * practice only the empty string will. - */ - result = - cell_a->payload.string.character == - cell_b->payload.string.character - && ( 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 ) ) ); - break; - case INTEGERTV: - case REALTV: - { - double num_a = numeric_value( a ); - double num_b = numeric_value( b ); - double max = - fabs( num_a ) > - fabs( num_b ) ? fabs( num_a ) : fabs( num_b ); - + case CONSTV: + result = + equal( cell_a->payload.cons.car, cell_b->payload.cons.car ) + && equal( cell_a->payload.cons.cdr, + cell_b->payload.cons.cdr ); + break; + case STRINGTV: + case SYMBOLTV: /* - * not more different than one part in a million - close enough + * slightly complex because a string may or may not have a '\0' + * cell at the end, but I'll ignore that for now. I think in + * practice only the empty string will. */ - result = fabs( num_a - num_b ) < ( max / 1000000.0 ); - } - break; - default: - result = false; - break; + result = + cell_a->payload.string.character == + cell_b->payload.string.character + && ( 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 ) ) ); + break; + case INTEGERTV: + case REALTV: + { + double num_a = numeric_value( a ); + double num_b = numeric_value( b ); + double max = + fabs( num_a ) > + fabs( num_b ) ? fabs( num_a ) : fabs( num_b ); + + /* + * not more different than one part in a million - close enough + */ + result = fabs( num_a - num_b ) < ( max / 1000000.0 ); + } + break; + default: + result = false; + break; } /* diff --git a/src/init.c b/src/init.c index 3f85b51..8043117 100644 --- a/src/init.c +++ b/src/init.c @@ -48,15 +48,15 @@ int main( int argc, char *argv[] ) { while ( ( option = getopt( argc, argv, "pd" ) ) != -1 ) { switch ( option ) { - case 'd': - dump_at_end = true; - break; - case 'p': - show_prompt = true; - break; - default: - fwprintf( stderr, L"Unexpected option %c\n", option ); - break; + case 'd': + dump_at_end = true; + break; + case 'p': + show_prompt = true; + break; + default: + fwprintf( stderr, L"Unexpected option %c\n", option ); + break; } } diff --git a/src/lispops.c b/src/lispops.c index 1b1eeea..9ecd602 100644 --- a/src/lispops.c +++ b/src/lispops.c @@ -96,6 +96,38 @@ struct cons_pointer eval_form( struct stack_frame *parent, return result; } +/** + * The Lisp interpreter. + * + * @param frame the stack frame in which the expression is to be interpreted; + * @param lexpr the lambda expression to be interpreted; + * @param env the environment in which it is to be intepreted. + */ +struct cons_pointer +lisp_lambda( struct stack_frame *frame, struct cons_pointer lexpr, + struct cons_pointer env ) { + struct cons_pointer result = NIL; + struct cons_pointer should_be_lambda = + eval_form( frame, c_car( lexpr ), env ); + + if ( lambdap( should_be_lambda ) ) { + struct cons_pointer new_env = env; + } else { + char *buffer = malloc( 1024 ); + memset( buffer, '\0', 1024 ); + sprintf( buffer, + "Expected lambda, but found cell with tag %d (%c%c%c%c)", + fn_cell.tag.value, fn_cell.tag.bytes[0], + fn_cell.tag.bytes[1], fn_cell.tag.bytes[2], + fn_cell.tag.bytes[3] ); + struct cons_pointer message = c_string_to_lisp_string( buffer ); + free( buffer ); + result = lisp_throw( message, frame ); + } + return result; +} + + /** * Internal guts of apply. @@ -118,35 +150,43 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer args = c_cdr( frame->arg[0] ); switch ( fn_cell.tag.value ) { - case SPECIALTV: - { - struct stack_frame *next = make_special_frame( frame, args, env ); - result = ( *fn_cell.payload.special.executable ) ( next, env ); - free_stack_frame( next ); - } - break; + case SPECIALTV: + { + struct stack_frame *next = + make_special_frame( frame, args, env ); + result = ( *fn_cell.payload.special.executable ) ( next, env ); + free_stack_frame( next ); + } + break; - case FUNCTIONTV: - { - struct stack_frame *next = make_stack_frame( frame, args, env ); - result = ( *fn_cell.payload.special.executable ) ( next, env ); - free_stack_frame( next ); - } - break; + case FUNCTIONTV: + { + struct stack_frame *next = + make_stack_frame( frame, args, env ); + result = ( *fn_cell.payload.special.executable ) ( next, env ); + free_stack_frame( next ); + } + break; - default: - { - char *buffer = malloc( 1024 ); - memset( buffer, '\0', 1024 ); - sprintf( buffer, - "Unexpected cell with tag %d (%c%c%c%c) in function position", - fn_cell.tag.value, fn_cell.tag.bytes[0], - fn_cell.tag.bytes[1], fn_cell.tag.bytes[2], - fn_cell.tag.bytes[3] ); - struct cons_pointer message = c_string_to_lisp_string( buffer ); - free( buffer ); - result = lisp_throw( message, frame ); - } + case CONSTV: + { + result = lisp_lambda( frame, fn_pointer, env ); + } + break; + default: + { + char *buffer = malloc( 1024 ); + memset( buffer, '\0', 1024 ); + sprintf( buffer, + "Unexpected cell with tag %d (%c%c%c%c) in function position", + fn_cell.tag.value, fn_cell.tag.bytes[0], + fn_cell.tag.bytes[1], fn_cell.tag.bytes[2], + fn_cell.tag.bytes[3] ); + struct cons_pointer message = + c_string_to_lisp_string( buffer ); + free( buffer ); + result = lisp_throw( message, frame ); + } } return result; @@ -193,30 +233,31 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) { dump_frame( stderr, frame ); switch ( cell.tag.value ) { - case CONSTV: - result = c_apply( frame, env ); - break; + case CONSTV: + result = c_apply( frame, env ); + break; - case SYMBOLTV: - { - struct cons_pointer canonical = internedp( frame->arg[0], env ); - if ( nilp( canonical ) ) { - struct cons_pointer message = - c_string_to_lisp_string - ( "Attempt to take value of unbound symbol." ); - result = lisp_throw( message, frame ); - } else { - result = c_assoc( canonical, env ); + case SYMBOLTV: + { + struct cons_pointer canonical = + internedp( frame->arg[0], env ); + if ( nilp( canonical ) ) { + struct cons_pointer message = + c_string_to_lisp_string + ( "Attempt to take value of unbound symbol." ); + result = lisp_throw( message, frame ); + } else { + result = c_assoc( canonical, env ); + } } - } - break; - /* - * the Clojure practice of having a map serve in the function place of - * an s-expression is a good one and I should adopt it; also if the - * object is a consp it could be interpretable source code but in the - * long run I don't want an interpreter, and if I can get away without - * so much the better. - */ + break; + /* + * the Clojure practice of having a map serve in the function place of + * an s-expression is a good one and I should adopt it; also if the + * object is a consp it could be interpretable source code but in the + * long run I don't want an interpreter, and if I can get away without + * so much the better. + */ } fputws( L"Eval returning ", stderr ); diff --git a/src/peano.c b/src/peano.c index 2402440..047b7c8 100644 --- a/src/peano.c +++ b/src/peano.c @@ -42,17 +42,17 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) { struct cons_space_object current = pointer2cell( frame->arg[i] ); switch ( current.tag.value ) { - case INTEGERTV: - i_accumulator += current.payload.integer.value; - d_accumulator += numeric_value( frame->arg[i] ); - break; - case REALTV: - d_accumulator += current.payload.real.value; - is_int = false; - break; - default: - lisp_throw( c_string_to_lisp_string( "Cannot add: not a number" ), - frame ); + case INTEGERTV: + i_accumulator += current.payload.integer.value; + d_accumulator += numeric_value( frame->arg[i] ); + break; + case REALTV: + d_accumulator += current.payload.real.value; + is_int = false; + break; + default: + lisp_throw( c_string_to_lisp_string + ( "Cannot add: not a number" ), frame ); } if ( !nilp( frame->more ) ) { @@ -87,17 +87,17 @@ lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) { struct cons_space_object arg = pointer2cell( frame->arg[i] ); switch ( arg.tag.value ) { - case INTEGERTV: - i_accumulator *= arg.payload.integer.value; - d_accumulator *= numeric_value( frame->arg[i] ); - break; - case REALTV: - d_accumulator *= arg.payload.real.value; - is_int = false; - break; - default: - lisp_throw( c_string_to_lisp_string - ( "Cannot multiply: not a number" ), frame ); + case INTEGERTV: + i_accumulator *= arg.payload.integer.value; + d_accumulator *= numeric_value( frame->arg[i] ); + break; + case REALTV: + d_accumulator *= arg.payload.real.value; + is_int = false; + break; + default: + lisp_throw( c_string_to_lisp_string + ( "Cannot multiply: not a number" ), frame ); } if ( !nilp( frame->more ) ) { diff --git a/src/print.c b/src/print.c index 1988563..ee5a5b3 100644 --- a/src/print.c +++ b/src/print.c @@ -49,19 +49,19 @@ print_list_contents( FILE * output, struct cons_pointer pointer, struct cons_space_object *cell = &pointer2cell( pointer ); switch ( cell->tag.value ) { - case CONSTV: - if ( initial_space ) { - fputwc( btowc( ' ' ), output ); - } - print( output, cell->payload.cons.car ); + case CONSTV: + if ( initial_space ) { + fputwc( btowc( ' ' ), output ); + } + print( output, cell->payload.cons.car ); - print_list_contents( output, cell->payload.cons.cdr, true ); - break; - case NILTV: - break; - default: - fwprintf( output, L" . " ); - print( output, pointer ); + print_list_contents( output, cell->payload.cons.cdr, true ); + break; + case NILTV: + break; + default: + fwprintf( output, L" . " ); + print( output, pointer ); } } @@ -80,58 +80,58 @@ void print( FILE * output, struct cons_pointer pointer ) { * statement can ultimately be replaced by a switch, which will be neater. */ switch ( cell.tag.value ) { - case CONSTV: - print_list( output, pointer ); - break; - case EXCEPTIONTV: - fwprintf( output, L"\nException: " ); - print_string_contents( output, cell.payload.exception.message ); - break; - case INTEGERTV: - fwprintf( output, L"%ld", cell.payload.integer.value ); - break; - case LAMBDATV: - fwprintf( output, L"lambda" /* "λ" */ ); - break; - case NILTV: - fwprintf( output, L"nil" ); - break; - case REALTV: - /* TODO: using the C heap is a bad plan because it will fragment. - * As soon as I have working vector space I'll use a special purpose - * vector space object */ - buffer = ( char * ) malloc( 24 ); - memset( buffer, 0, 24 ); - /* format it really long, then clear the trailing zeros */ - sprintf( buffer, "%-.23Lg", cell.payload.real.value ); - if ( strchr( buffer, '.' ) != NULL ) { - for ( int i = strlen( buffer ) - 1; buffer[i] == '0'; i-- ) { - buffer[i] = '\0'; + case CONSTV: + print_list( output, pointer ); + break; + case EXCEPTIONTV: + fwprintf( output, L"\nException: " ); + print_string_contents( output, cell.payload.exception.message ); + break; + case INTEGERTV: + fwprintf( output, L"%ld", cell.payload.integer.value ); + break; + case LAMBDATV: + fwprintf( output, L"lambda" /* "λ" */ ); + break; + case NILTV: + fwprintf( output, L"nil" ); + break; + case REALTV: + /* TODO: using the C heap is a bad plan because it will fragment. + * As soon as I have working vector space I'll use a special purpose + * vector space object */ + buffer = ( char * ) malloc( 24 ); + memset( buffer, 0, 24 ); + /* format it really long, then clear the trailing zeros */ + sprintf( buffer, "%-.23Lg", cell.payload.real.value ); + if ( strchr( buffer, '.' ) != NULL ) { + for ( int i = strlen( buffer ) - 1; buffer[i] == '0'; i-- ) { + buffer[i] = '\0'; + } } - } - fwprintf( output, L"%s", buffer ); - free( buffer ); - break; - case STRINGTV: - print_string( output, pointer ); - break; - case SYMBOLTV: - print_string_contents( output, pointer ); - break; - case TRUETV: - fwprintf( output, L"t" ); - break; - case FUNCTIONTV: - fwprintf( output, L"(Function)" ); - break; - case SPECIALTV: - fwprintf( output, L"(Special form)" ); - break; - default: - fwprintf( stderr, - L"Error: Unrecognised tag value %d (%c%c%c%c)\n", - cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1], - cell.tag.bytes[2], cell.tag.bytes[3] ); - break; + fwprintf( output, L"%s", buffer ); + free( buffer ); + break; + case STRINGTV: + print_string( output, pointer ); + break; + case SYMBOLTV: + print_string_contents( output, pointer ); + break; + case TRUETV: + fwprintf( output, L"t" ); + break; + case FUNCTIONTV: + fwprintf( output, L"(Function)" ); + break; + case SPECIALTV: + fwprintf( output, L"(Special form)" ); + break; + default: + fwprintf( stderr, + L"Error: Unrecognised tag value %d (%c%c%c%c)\n", + cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1], + cell.tag.bytes[2], cell.tag.bytes[3] ); + break; } } diff --git a/src/read.c b/src/read.c index ad74db6..ff0b51f 100644 --- a/src/read.c +++ b/src/read.c @@ -60,40 +60,42 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input, c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) ); switch ( c ) { - case EOF: - result = lisp_throw( c_string_to_lisp_string - ( "End of input while reading" ), frame ); - break; - case '\'': - result = c_quote( read_continuation( frame, input, fgetwc( input ) ) ); - break; - case '(': - result = read_list( frame, input, fgetwc( input ) ); - break; - case '"': - result = read_string( input, fgetwc( input ) ); - break; - default: - if ( c == '.' ) { - wint_t next = fgetwc( input ); - if ( iswdigit( next ) ) { - ungetwc( next, input ); + case EOF: + result = lisp_throw( c_string_to_lisp_string + ( "End of input while reading" ), frame ); + break; + case '\'': + result = + c_quote( read_continuation( frame, input, fgetwc( input ) ) ); + break; + case '(': + result = read_list( frame, input, fgetwc( input ) ); + break; + case '"': + result = read_string( input, fgetwc( input ) ); + break; + default: + if ( c == '.' ) { + wint_t next = fgetwc( input ); + if ( iswdigit( next ) ) { + ungetwc( next, input ); + result = read_number( input, c ); + } else if ( iswblank( next ) ) { + /* dotted pair. TODO: this isn't right, we + * really need to backtrack up a level. */ + result = + read_continuation( frame, input, fgetwc( input ) ); + } else { + read_symbol( input, c ); + } + } else if ( iswdigit( c ) ) { result = read_number( input, c ); - } else if ( iswblank( next ) ) { - /* dotted pair. TODO: this isn't right, we - * really need to backtrack up a level. */ - result = read_continuation( frame, input, fgetwc( input ) ); + } else if ( iswprint( c ) ) { + result = read_symbol( input, c ); } else { - read_symbol( input, c ); + fwprintf( stderr, + L"Unrecognised start of input character %c\n", c ); } - } else if ( iswdigit( c ) ) { - result = read_number( input, c ); - } else if ( iswprint( c ) ) { - result = read_symbol( input, c ); - } else { - fwprintf( stderr, L"Unrecognised start of input character %c\n", - c ); - } } return result; @@ -177,15 +179,16 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) { struct cons_pointer result; switch ( initial ) { - case '\0': - result = make_string( initial, NIL ); - break; - case '"': - result = make_string( '\0', NIL ); - break; - default: - result = make_string( initial, read_string( input, fgetwc( input ) ) ); - break; + case '\0': + result = make_string( initial, NIL ); + break; + case '"': + result = make_string( '\0', NIL ); + break; + default: + result = + make_string( initial, read_string( input, fgetwc( input ) ) ); + break; } return result; @@ -196,37 +199,39 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) { struct cons_pointer result; switch ( initial ) { - case '\0': - result = make_symbol( initial, NIL ); - break; - case '"': - /* - * THIS IS NOT A GOOD IDEA, but is legal - */ - result = make_symbol( initial, read_symbol( input, fgetwc( input ) ) ); - break; - case ')': - /* - * unquoted strings may not include right-parenthesis - */ - result = make_symbol( '\0', NIL ); - /* - * push back the character read - */ - ungetwc( initial, input ); - break; - default: - if ( iswprint( initial ) && !iswblank( initial ) ) { + case '\0': + result = make_symbol( initial, NIL ); + break; + case '"': + /* + * THIS IS NOT A GOOD IDEA, but is legal + */ result = make_symbol( initial, read_symbol( input, fgetwc( input ) ) ); - } else { - result = NIL; + break; + case ')': + /* + * unquoted strings may not include right-parenthesis + */ + result = make_symbol( '\0', NIL ); /* * push back the character read */ ungetwc( initial, input ); - } - break; + break; + default: + if ( iswprint( initial ) && !iswblank( initial ) ) { + result = + make_symbol( initial, + read_symbol( input, fgetwc( input ) ) ); + } else { + result = NIL; + /* + * push back the character read + */ + ungetwc( initial, input ); + } + break; } fputws( L"Read symbol '", stderr );