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/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/ops/intern.c b/src/ops/intern.c index 39e121f..5a81fb3 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -278,19 +278,22 @@ struct cons_pointer interned( struct cons_pointer key, struct cons_pointer store ) { struct cons_pointer result = NIL; + debug_print( L"interned: Checking for interned value of `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"`\n", DEBUG_BIND ); + if ( symbolp( key ) || keywordp( key ) ) { struct cons_space_object *cell = &pointer2cell( store ); switch ( cell->tag.value ) { case CONSTV: for ( struct cons_pointer next = store; - nilp( result ) && consp( next ); - next = c_cdr( next) ) { + nilp( result ) && consp( next ); next = c_cdr( next ) ) { if ( !nilp( next ) ) { // struct cons_space_object entry = // pointer2cell( c_car( next) ); - if ( equal( key, c_car(next) ) ) { + if ( equal( key, c_car( next ) ) ) { result = key; } } @@ -330,6 +333,10 @@ struct cons_pointer interned( struct cons_pointer key, NIL ); } + debug_print( L"interned: returning `", DEBUG_BIND ); + debug_print_object( result, DEBUG_BIND ); + debug_print( L"`\n", DEBUG_BIND ); + return result; } @@ -441,19 +448,23 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp, map->payload.hashmap.buckets[bucket_no] ); } + debug_print(L"hashmap_put:\n", DEBUG_BIND); + debug_dump_object( mapp, DEBUG_BIND); + return mapp; } - /** - * Return a new key/value store containing all the key/value pairs in this - * store with this key/value pair added to the front. - */ +/** + * If this store is modifiable, add this key value pair to it. Otherwise, + * return a new key/value store containing all the key/value pairs in this + * store with this key/value pair added to the front. + */ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value, struct cons_pointer store ) { struct cons_pointer result = NIL; #ifdef DEBUG - bool deep = eq( store, oblist); + bool deep = eq( store, oblist ); debug_print_binding( key, value, deep, DEBUG_BIND ); if ( deep ) { @@ -461,9 +472,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value, pointer2cell( store ).payload.vectorp.tag.bytes ); } #endif - if ( nilp( value ) ) { - result = store; - } else if ( nilp( store ) || consp( store ) ) { + if ( nilp( store ) || consp( store ) ) { result = make_cons( make_cons( key, value ), store ); } else if ( hashmapp( store ) ) { result = hashmap_put( store, key, value ); @@ -479,16 +488,8 @@ struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value ) { debug_print( L"Entering deep_bind\n", DEBUG_BIND ); - struct cons_pointer old = oblist; - oblist = set( key, value, oblist ); - // The oblist is not now an assoc list, and I don't think it will be again. - // if ( consp( oblist ) ) { - // inc_ref( oblist ); - // dec_ref( old ); - // } - debug_print( L"deep_bind returning ", DEBUG_BIND ); debug_print_object( key, DEBUG_BIND ); debug_println( DEBUG_BIND ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index be4227b..4a89d98 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = - ( *fn_cell.payload. - special.executable ) ( get_stack_frame - ( next_pointer ), - next_pointer, env ); + ( *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 ); @@ -850,9 +849,8 @@ struct cons_pointer lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = internedp( frame->arg[0], - nilp( frame-> - arg[1] ) ? oblist : frame-> - arg[1] ); + nilp( frame->arg[1] ) ? oblist : + frame->arg[1] ); if ( exceptionp( result ) ) { struct cons_pointer old = result; @@ -1313,8 +1311,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer message = frame->arg[0]; return exceptionp( message ) ? message : throw_exception( message, - frame-> - previous ); + frame->previous ); } /** @@ -1497,14 +1494,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 ); }