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?
(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))))))

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 );
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 );

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" );
}
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 =

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] ) ) {
result =
make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload.
stream.stream ), NIL );
( pointer2cell( frame->arg[0] ).payload.stream.
stream ), NIL );
}
return result;

4
src/memory/conspage.c
View file

@ -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 );
}
}

8
src/memory/dump.c
View file

@ -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 );

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,
// 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;

10
src/ops/intern.c
View file

@ -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,8 +438,8 @@ 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 ) ) {
// 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 =
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 );
@ -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 );
}