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

Reformatted code; made paths in generated documentation relative.

Browse source
This commit is contained in:
Simon Brooke 2026-02-14 15:32:59 +00:00
parent 222368bf64
commit 08a7c4153c
24 changed files with 496 additions and 716 deletions
Download patch file Download diff file Expand all files Collapse all files

60
src/ops/intern.c
View file

@ -191,20 +191,20 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
pair = c_car( assoc ) ) {
/* TODO: this is really hammering the memory management system, because
* it will make a new lone for every key/value pair added. Fix. */
if (consp( pair)) {
if ( consp( pair ) ) {
mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
} else if (hashmapp( pair)) {
hashmap_put_all( mapp, pair);
} else if ( hashmapp( pair ) ) {
hashmap_put_all( mapp, pair );
} else {
hashmap_put( mapp, pair, TRUE);
hashmap_put( mapp, pair, TRUE );
}
assoc = c_cdr( assoc);
assoc = c_cdr( assoc );
}
} else if (hashmapp( assoc)) {
for (struct cons_pointer keys = hashmap_keys( assoc); !nilp( keys);
keys = c_cdr( keys)) {
struct cons_pointer key = c_car( keys);
hashmap_put( mapp, key, hashmap_get( assoc, key));
} else if ( hashmapp( assoc ) ) {
for ( struct cons_pointer keys = hashmap_keys( assoc );
!nilp( keys ); keys = c_cdr( keys ) ) {
struct cons_pointer key = c_car( keys );
hashmap_put( mapp, key, hashmap_get( assoc, key ) );
}
}
}
@ -246,7 +246,8 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
result =
make_hashmap( from_pl.n_buckets, from_pl.hash_fn,
from_pl.write_acl );
struct vector_space_object const *to = pointer_to_vso( result );
struct vector_space_object const *to =
pointer_to_vso( result );
struct hashmap_payload to_pl = to->payload.hashmap;
for ( int i = 0; i < to_pl.n_buckets; i++ ) {
@ -257,9 +258,9 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
}
} else {
result =
make_exception( c_string_to_lisp_string
( L"Arg to `clone_hashmap` must "
L"be a readable hashmap.`" ), NIL );
make_exception( c_string_to_lisp_string
( L"Arg to `clone_hashmap` must "
L"be a readable hashmap.`" ), NIL );
}
return result;
@ -299,9 +300,9 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
// if ( equal( key, entry.payload.cons.car ) ) {
// result = entry.payload.cons.car;
// }
if (!nilp( c_assoc( key, store))) {
if ( !nilp( c_assoc( key, store ) ) ) {
result = key;
} else if ( equal( key, privileged_symbol_nil)) {
} else if ( equal( key, privileged_symbol_nil ) ) {
result = privileged_symbol_nil;
}
} else {
@ -349,9 +350,10 @@ struct cons_pointer c_assoc( struct cons_pointer key,
result = hashmap_get( entry_ptr, key );
break;
default:
throw_exception( c_append(
c_string_to_lisp_string( L"Store entry is of unknown type: " ),
c_type( entry_ptr)), NIL);
throw_exception( c_append
( c_string_to_lisp_string
( L"Store entry is of unknown type: " ),
c_type( entry_ptr ) ), NIL );
}
}
}
@ -359,13 +361,13 @@ struct cons_pointer c_assoc( struct cons_pointer key,
result = hashmap_get( store, key );
} else if ( !nilp( store ) ) {
debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
debug_print_object( c_type( store), DEBUG_BIND );
debug_print_object( c_type( store ), DEBUG_BIND );
debug_print( L"`\n", DEBUG_BIND );
result =
throw_exception(
c_append(
c_string_to_lisp_string( L"Store is of unknown type: " ),
c_type( store)), NIL );
throw_exception( c_append
( c_string_to_lisp_string
( L"Store is of unknown type: " ),
c_type( store ) ), NIL );
}
debug_print( L"c_assoc returning ", DEBUG_BIND );
@ -419,14 +421,14 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
debug_dump_object( store, DEBUG_BIND );
debug_println( DEBUG_BIND );
debug_printf( DEBUG_BIND, L"set: store is %s\n`", lisp_string_to_c_string( c_type( store)) );
if (nilp( value)) {
debug_printf( DEBUG_BIND, L"set: store is %s\n`",
lisp_string_to_c_string( c_type( store ) ) );
if ( nilp( value ) ) {
result = store;
}
else if ( nilp( store ) || consp( store ) ) {
} else if ( nilp( store ) || consp( store ) ) {
result = make_cons( make_cons( key, value ), store );
} else if ( hashmapp( store ) ) {
debug_print( L"set: storing in hashmap\n", DEBUG_BIND);
debug_print( L"set: storing in hashmap\n", DEBUG_BIND );
result = hashmap_put( store, key, value );
}

2
src/ops/intern.h
View file

@ -36,7 +36,7 @@ struct cons_pointer hashmap_get( struct cons_pointer mapp,
struct cons_pointer hashmap_put( struct cons_pointer mapp,
struct cons_pointer key,
struct cons_pointer val );
struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
struct cons_pointer assoc );

53
src/ops/lispops.c
View file

@ -446,9 +446,10 @@ 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 );
@ -1245,7 +1246,8 @@ 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 );
}
/**
@ -1264,34 +1266,36 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) {
struct cons_pointer expr = NIL;
debug_printf(DEBUG_REPL, L"Entering new inner REPL\n");
debug_printf( DEBUG_REPL, L"Entering new inner REPL\n" );
struct cons_pointer input = get_default_stream( true, env );
struct cons_pointer output = get_default_stream( false, env );
// struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
struct cons_pointer old_oblist = oblist;
struct cons_pointer new_env = env;
if (truep(frame->arg[0])) {
new_env = set( prompt_name, frame->arg[0], new_env);
if ( truep( frame->arg[0] ) ) {
new_env = set( prompt_name, frame->arg[0], new_env );
}
if (readp(frame->arg[1])) {
new_env = set( c_string_to_lisp_symbol(L"*in*"), frame->arg[1], new_env);
if ( readp( frame->arg[1] ) ) {
new_env =
set( c_string_to_lisp_symbol( L"*in*" ), frame->arg[1], new_env );
input = frame->arg[1];
}
if (readp(frame->arg[2])) {
new_env = set( c_string_to_lisp_symbol(L"*out*"), frame->arg[2], new_env);
if ( readp( frame->arg[2] ) ) {
new_env =
set( c_string_to_lisp_symbol( L"*out*" ), frame->arg[2], new_env );
output = frame->arg[2];
}
inc_ref( input );
inc_ref( output );
inc_ref( prompt_name );
URL_FILE *os = pointer2cell( output ).payload.stream.stream;
/* \todo this is subtly wrong. If we were evaluating
* (print (eval (read)))
* then the stack frame for read would have the stack frame for
@ -1353,10 +1357,10 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
dec_ref( input );
dec_ref( output );
dec_ref( prompt_name );
dec_ref( new_env);
dec_ref( new_env );
debug_printf( DEBUG_REPL, L"Leaving inner repl\n" );
debug_printf(DEBUG_REPL, L"Leaving inner repl\n");
return expr;
}
@ -1426,13 +1430,14 @@ 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 );
}
@ -1588,8 +1593,8 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
// }
// }
// }
// return result;
// }
// }