diff --git a/lisp/member.lisp b/lisp/member.lisp index 1e0df38..b1225cd 100644 --- a/lisp/member.lisp +++ b/lisp/member.lisp @@ -11,8 +11,8 @@ (set! member? (lambda (item collection) - (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*) + ;; (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*) (cond ((nil? collection) nil) ((= item (car collection)) t) - (t (member? item (CDR collection)))))) + (t (member? item (cdr collection)))))) diff --git a/src/arith/integer.c b/src/arith/integer.c index 3688ff5..682efd0 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -245,8 +245,7 @@ struct cons_pointer add_integers( struct cons_pointer a, debug_print( L"\n", DEBUG_ARITH ); if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) { - result = - acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); + result = acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); break; } else { struct cons_pointer new = make_integer( 0, NIL ); @@ -262,7 +261,7 @@ struct cons_pointer add_integers( struct cons_pointer a, is_first_cell = false; } } - + debug_print( L"add_integers returning: ", DEBUG_ARITH ); debug_print_object( result, DEBUG_ARITH ); debug_println( DEBUG_ARITH ); diff --git a/src/debug.h b/src/debug.h index 6c7c8cb..d08df7e 100644 --- a/src/debug.h +++ b/src/debug.h @@ -84,7 +84,7 @@ * * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v. */ - #define DEBUG_EQUAL 512 +#define DEBUG_EQUAL 512 extern int verbosity; diff --git a/src/init.c b/src/init.c index b0042fb..48e4efa 100644 --- a/src/init.c +++ b/src/init.c @@ -50,9 +50,9 @@ struct cons_pointer check_exception( struct cons_pointer pointer, struct cons_pointer result = pointer; if ( exceptionp( pointer ) ) { - struct cons_space_object * object = &pointer2cell( pointer); + struct cons_space_object *object = &pointer2cell( pointer ); result = NIL; - + fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor ); URL_FILE *ustderr = file_to_url_file( stderr ); fwide( stderr, 1 ); @@ -74,7 +74,8 @@ void maybe_bind_init_symbols( ) { privileged_keyword_name = c_string_to_lisp_keyword( L"name" ); } if ( nilp( privileged_keyword_primitive ) ) { - privileged_keyword_primitive = c_string_to_lisp_keyword( L"primitive" ); + privileged_keyword_primitive = + c_string_to_lisp_keyword( L"primitive" ); } if ( nilp( privileged_symbol_nil ) ) { privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" ); @@ -122,7 +123,8 @@ struct cons_pointer bind_function( wchar_t *name, make_cons( make_cons( privileged_keyword_primitive, TRUE ), make_cons( make_cons( privileged_keyword_name, n ), make_cons( make_cons - ( privileged_keyword_documentation, d ), + ( privileged_keyword_documentation, + d ), NIL ) ) ); struct cons_pointer r = @@ -151,7 +153,8 @@ struct cons_pointer bind_special( wchar_t *name, make_cons( make_cons( privileged_keyword_primitive, TRUE ), make_cons( make_cons( privileged_keyword_name, n ), make_cons( make_cons - ( privileged_keyword_documentation, d ), + ( privileged_keyword_documentation, + d ), NIL ) ) ); struct cons_pointer r = diff --git a/src/io/io.c b/src/io/io.c index cf0894f..51a05cc 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( readp( frame->arg[0] ) ) { result = make_string( url_fgetwc - ( pointer2cell( frame->arg[0] ).payload. - stream.stream ), NIL ); + ( pointer2cell( frame->arg[0] ).payload.stream. + stream ), NIL ); } return result; diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 9c6ea20..31ab050 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -67,7 +67,7 @@ struct cons_page *conspages[NCONSPAGES]; void make_cons_page( ) { struct cons_page *result = NULL; - if ( initialised_cons_pages < NCONSPAGES) { + if ( initialised_cons_pages < NCONSPAGES ) { result = malloc( sizeof( struct cons_page ) ); } @@ -121,7 +121,9 @@ void make_cons_page( ) { initialised_cons_pages++; } else { fwide( stderr, 1 ); - fwprintf( stderr, L"FATAL: Failed to allocate memory for cons page %d\n", initialised_cons_pages ); + fwprintf( stderr, + L"FATAL: Failed to allocate memory for cons page %d\n", + initialised_cons_pages ); exit( 1 ); } } diff --git a/src/memory/dump.c b/src/memory/dump.c index 3a83866..b065661 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) { case RATIOTV: url_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: url_fputws( L"\t\tInput stream; metadata: ", output ); diff --git a/src/memory/stack.c b/src/memory/stack.c index 6cc68a0..0188e6b 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -66,7 +66,8 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) { // debug_printf( DEBUG_STACK, // L"\nget_stack_frame: all good, returning %p\n", result ); } else { - debug_print( L"\nget_stack_frame: fail, returning NULL\n", DEBUG_STACK ); + debug_print( L"\nget_stack_frame: fail, returning NULL\n", + DEBUG_STACK ); } return result; @@ -133,8 +134,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) { if ( stack_limit == 0 || stack_limit > depth ) { result = in_make_empty_frame( previous, depth ); } else { - debug_printf( DEBUG_STACK, - L"WARNING: Exceeded stack limit of %d\n", stack_limit); + debug_printf( DEBUG_STACK, + L"WARNING: Exceeded stack limit of %d\n", stack_limit ); result = make_exception( c_string_to_lisp_string ( L"Stack limit exceeded." ), previous ); @@ -187,7 +188,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous, debug_printf( DEBUG_STACK, L"\tSetting argument %d to ", frame->args ); debug_print_object( cell.payload.cons.car, DEBUG_STACK ); - debug_print(L"\n", DEBUG_STACK); + debug_print( L"\n", DEBUG_STACK ); set_reg( frame, frame->args, val ); } diff --git a/src/ops/intern.c b/src/ops/intern.c index 6221b2a..989686b 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -338,13 +338,11 @@ struct cons_pointer search_store( struct cons_pointer key, result = return_key ? c_car( entry_ptr ) : c_cdr( entry_ptr ); - break; + goto found; } break; case HASHTV: case NAMESPACETV: - // TODO: I think this should be impossible, and we should maybe - // throw an exception. result = hashmap_get( entry_ptr, key, return_key ); @@ -414,6 +412,8 @@ struct cons_pointer search_store( struct cons_pointer key, c_type( key ) ), NIL ); } + found: + debug_print( L"search-store: returning `", DEBUG_BIND ); debug_print_object( result, DEBUG_BIND ); debug_print( L"`\n", DEBUG_BIND ); @@ -438,19 +438,19 @@ struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer result = NIL; if ( consp( store ) ) { - for ( struct cons_pointer pair = c_car( store ); eq( result, NIL) && !nilp( pair ); - pair = c_car( store ) ) { + for ( struct cons_pointer pair = c_car( store ); + eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) { if ( consp( pair ) ) { - if ( equal( c_car( pair), key)) { + if ( equal( c_car( pair ), key ) ) { // yes, this should be `eq`, but if symbols are correctly // interned this will work efficiently, and if not it will // still work. - result = TRUE; + result = TRUE; } } else if ( hashmapp( pair ) ) { - result=internedp( key, pair); - } - + result = internedp( key, pair ); + } + store = c_cdr( store ); } } else if ( hashmapp( store ) ) { @@ -459,7 +459,7 @@ struct cons_pointer internedp( struct cons_pointer key, for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) { for ( struct cons_pointer c = map->payload.hashmap.buckets[i]; !nilp( c ); c = c_cdr( c ) ) { - result = internedp( key, c); + result = internedp( key, c ); } } } diff --git a/src/ops/intern.h b/src/ops/intern.h index e54ae7b..0b8f657 100644 --- a/src/ops/intern.h +++ b/src/ops/intern.h @@ -76,6 +76,6 @@ struct cons_pointer intern( struct cons_pointer key, struct cons_pointer environment ); struct cons_pointer internedp( struct cons_pointer key, - struct cons_pointer store ); + struct cons_pointer store ); #endif diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 98c518f..3c0c55b 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -363,8 +363,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r, pointer2cell( result ).payload.exception.payload = make_cons( make_cons( privileged_keyword_location, c_assoc( privileged_keyword_name, - fn_cell->payload.function. - meta ) ), + fn_cell->payload. + function.meta ) ), make_cons( make_cons ( privileged_keyword_payload, payload ), NIL ) ); @@ -416,7 +416,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, get_stack_frame( next_pointer ); result = maybe_fixup_exception_location( ( * - ( fn_cell->payload.function.executable ) ) + ( fn_cell-> + payload. + function. + executable ) ) ( next, next_pointer, env ), @@ -490,7 +493,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = maybe_fixup_exception_location( ( * - ( fn_cell->payload.special.executable ) ) + ( fn_cell-> + payload. + special. + executable ) ) ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer ); debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); @@ -921,13 +927,13 @@ struct cons_pointer c_keys( struct cons_pointer store ) { if ( consp( store ) ) { for ( struct cons_pointer pair = c_car( store ); !nilp( pair ); - pair = c_car( store ) ) { + pair = c_car( store ) ) { if ( consp( pair ) ) { - result = make_cons( c_car( pair), result); + result = make_cons( c_car( pair ), result ); } else if ( hashmapp( pair ) ) { - result=c_append( hashmap_keys( pair), result); - } - + result = c_append( hashmap_keys( pair ), result ); + } + store = c_cdr( store ); } } else if ( hashmapp( store ) ) { @@ -1270,14 +1276,14 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause, env ) ); #ifdef DEBUG - debug_print( L"\n\t\tCond clause ", DEBUG_EVAL); - debug_print_object( clause, DEBUG_EVAL); + debug_print( L"\n\t\tCond clause ", DEBUG_EVAL ); + debug_print_object( clause, DEBUG_EVAL ); debug_print( L" succeeded; returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); } else { - debug_print( L"\n\t\tCond clause ", DEBUG_EVAL); - debug_print_object( clause, DEBUG_EVAL); + debug_print( L"\n\t\tCond clause ", DEBUG_EVAL ); + debug_print_object( clause, DEBUG_EVAL ); debug_print( L" failed.\n", DEBUG_EVAL ); #endif } @@ -1626,14 +1632,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) { if ( nilp( c_cdr( l1 ) ) ) { return - make_string_like_thing( ( pointer2cell( l1 ). - payload.string.character ), - l2, + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), l2, pointer2cell( l1 ).tag.value ); } else { return - make_string_like_thing( ( pointer2cell( l1 ). - payload.string.character ), + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), c_append( c_cdr( l1 ), l2 ), pointer2cell( l1 ).tag.value ); }