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

'Fixed' issue #8; but done so by introducing a goto. Not entirely happy about this.

Browse source
This commit is contained in:
Simon Brooke 2026-03-18 21:35:34 +00:00
parent dc5cac0bd8
commit a20c956288
11 changed files with 63 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

4
lisp/member.lisp
View file

@ -11,8 +11,8 @@
(set! member? (set! member?
(lambda (lambda
(item collection) (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 (cond
((nil? collection) nil) ((nil? collection) nil)
((= item (car collection)) t) ((= item (car collection)) t)
(t (member? item (CDR collection)))))) (t (member? item (cdr collection))))))

3
src/arith/integer.c
View file

@ -245,8 +245,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
debug_print( L"\n", DEBUG_ARITH ); debug_print( L"\n", DEBUG_ARITH );
if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) { if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) {
result = result = acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
break; break;
} else { } else {
struct cons_pointer new = make_integer( 0, NIL ); struct cons_pointer new = make_integer( 0, NIL );

9
src/init.c
View file

@ -74,7 +74,8 @@ void maybe_bind_init_symbols( ) {
privileged_keyword_name = c_string_to_lisp_keyword( L"name" ); privileged_keyword_name = c_string_to_lisp_keyword( L"name" );
} }
if ( nilp( privileged_keyword_primitive ) ) { 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 ) ) { if ( nilp( privileged_symbol_nil ) ) {
privileged_symbol_nil = c_string_to_lisp_symbol( L"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_primitive, TRUE ),
make_cons( make_cons( privileged_keyword_name, n ), make_cons( make_cons( privileged_keyword_name, n ),
make_cons( make_cons make_cons( make_cons
( privileged_keyword_documentation, d ), ( privileged_keyword_documentation,
d ),
NIL ) ) ); NIL ) ) );
struct cons_pointer r = 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_primitive, TRUE ),
make_cons( make_cons( privileged_keyword_name, n ), make_cons( make_cons( privileged_keyword_name, n ),
make_cons( make_cons make_cons( make_cons
( privileged_keyword_documentation, d ), ( privileged_keyword_documentation,
d ),
NIL ) ) ); NIL ) ) );
struct cons_pointer r = struct cons_pointer r =

4
src/io/io.c
View file

@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( readp( frame->arg[0] ) ) { if ( readp( frame->arg[0] ) ) {
result = result =
make_string( url_fgetwc make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload. ( pointer2cell( frame->arg[0] ).payload.stream.
stream.stream ), NIL ); stream ), NIL );
} }
return result; return result;

4
src/memory/conspage.c
View file

@ -121,7 +121,9 @@ void make_cons_page( ) {
initialised_cons_pages++; initialised_cons_pages++;
} else { } else {
fwide( stderr, 1 ); 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 ); exit( 1 );
} }
} }

8
src/memory/dump.c
View file

@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
case RATIOTV: case RATIOTV:
url_fwprintf( output, url_fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n", L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ). pointer2cell( cell.payload.ratio.dividend ).payload.
payload.integer.value, integer.value,
pointer2cell( cell.payload.ratio.divisor ). pointer2cell( cell.payload.ratio.divisor ).payload.
payload.integer.value, cell.count ); integer.value, cell.count );
break; break;
case READTV: case READTV:
url_fputws( L"\t\tInput stream; metadata: ", output ); url_fputws( L"\t\tInput stream; metadata: ", output );

3
src/memory/stack.c
View file

@ -66,7 +66,8 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
// debug_printf( DEBUG_STACK, // debug_printf( DEBUG_STACK,
// L"\nget_stack_frame: all good, returning %p\n", result ); // L"\nget_stack_frame: all good, returning %p\n", result );
} else { } 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; return result;

10
src/ops/intern.c
View file

@ -338,13 +338,11 @@ struct cons_pointer search_store( struct cons_pointer key,
result = result =
return_key ? c_car( entry_ptr ) return_key ? c_car( entry_ptr )
: c_cdr( entry_ptr ); : c_cdr( entry_ptr );
break; goto found;
} }
break; break;
case HASHTV: case HASHTV:
case NAMESPACETV: case NAMESPACETV:
// TODO: I think this should be impossible, and we should maybe
// throw an exception.
result = result =
hashmap_get( entry_ptr, key, hashmap_get( entry_ptr, key,
return_key ); return_key );
@ -414,6 +412,8 @@ struct cons_pointer search_store( struct cons_pointer key,
c_type( key ) ), NIL ); c_type( key ) ), NIL );
} }
found:
debug_print( L"search-store: returning `", DEBUG_BIND ); debug_print( L"search-store: returning `", DEBUG_BIND );
debug_print_object( result, DEBUG_BIND ); debug_print_object( result, DEBUG_BIND );
debug_print( L"`\n", DEBUG_BIND ); debug_print( L"`\n", DEBUG_BIND );
@ -438,8 +438,8 @@ struct cons_pointer internedp( struct cons_pointer key,
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
if ( consp( store ) ) { if ( consp( store ) ) {
for ( struct cons_pointer pair = c_car( store ); eq( result, NIL) && !nilp( pair ); for ( struct cons_pointer pair = c_car( store );
pair = c_car( store ) ) { eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) {
if ( consp( pair ) ) { 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 // yes, this should be `eq`, but if symbols are correctly

23
src/ops/lispops.c
View file

@ -363,8 +363,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
pointer2cell( result ).payload.exception.payload = pointer2cell( result ).payload.exception.payload =
make_cons( make_cons( privileged_keyword_location, make_cons( make_cons( privileged_keyword_location,
c_assoc( privileged_keyword_name, c_assoc( privileged_keyword_name,
fn_cell->payload.function. fn_cell->payload.
meta ) ), function.meta ) ),
make_cons( make_cons make_cons( make_cons
( privileged_keyword_payload, ( privileged_keyword_payload,
payload ), NIL ) ); payload ), NIL ) );
@ -416,7 +416,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
get_stack_frame( next_pointer ); get_stack_frame( next_pointer );
result = maybe_fixup_exception_location( ( * result = maybe_fixup_exception_location( ( *
( fn_cell->payload.function.executable ) ) ( fn_cell->
payload.
function.
executable ) )
( next, ( next,
next_pointer, next_pointer,
env ), env ),
@ -490,7 +493,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer; result = next_pointer;
} else { } else {
result = maybe_fixup_exception_location( ( * 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 ); ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
@ -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 ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
if ( nilp( c_cdr( l1 ) ) ) { if ( nilp( c_cdr( l1 ) ) ) {
return return
make_string_like_thing( ( pointer2cell( l1 ). make_string_like_thing( ( pointer2cell( l1 ).payload.
payload.string.character ), string.character ), l2,
l2,
pointer2cell( l1 ).tag.value ); pointer2cell( l1 ).tag.value );
} else { } else {
return return
make_string_like_thing( ( pointer2cell( l1 ). make_string_like_thing( ( pointer2cell( l1 ).payload.
payload.string.character ), string.character ),
c_append( c_cdr( l1 ), l2 ), c_append( c_cdr( l1 ), l2 ),
pointer2cell( l1 ).tag.value ); pointer2cell( l1 ).tag.value );
} }