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

Standardised format (with make format)

Browse source
This commit is contained in:
Simon Brooke 2021-09-12 15:06:05 +01:00
parent 2b8f31d2ce
commit 40e3502247
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
8 changed files with 97 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/init.c
View file

@ -238,7 +238,7 @@ int main( int argc, char *argv[] ) {
bind_function( L"hashmap", lisp_make_hashmap ); bind_function( L"hashmap", lisp_make_hashmap );
bind_function( L"inspect", &lisp_inspect ); bind_function( L"inspect", &lisp_inspect );
bind_function( L"keys", &lisp_keys ); bind_function( L"keys", &lisp_keys );
bind_function( L"list", &lisp_list); bind_function( L"list", &lisp_list );
bind_function( L"mapcar", &lisp_mapcar ); bind_function( L"mapcar", &lisp_mapcar );
bind_function( L"meta", &lisp_metadata ); bind_function( L"meta", &lisp_metadata );
bind_function( L"metadata", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata );
@ -272,7 +272,7 @@ int main( int argc, char *argv[] ) {
bind_special( L"cond", &lisp_cond ); bind_special( L"cond", &lisp_cond );
bind_special( L"lambda", &lisp_lambda ); bind_special( L"lambda", &lisp_lambda );
bind_special( L"\u03bb", &lisp_lambda ); // λ bind_special( L"\u03bb", &lisp_lambda ); // λ
bind_special(L"let", &lisp_let); bind_special( L"let", &lisp_let );
bind_special( L"nlambda", &lisp_nlambda ); bind_special( L"nlambda", &lisp_nlambda );
bind_special( L"n\u03bb", &lisp_nlambda ); bind_special( L"n\u03bb", &lisp_nlambda );
bind_special( L"progn", &lisp_progn ); bind_special( L"progn", &lisp_progn );
@ -290,7 +290,7 @@ int main( int argc, char *argv[] ) {
dump_pages( file_to_url_file( stdout ) ); dump_pages( file_to_url_file( stdout ) );
} }
summarise_allocation(); summarise_allocation( );
curl_global_cleanup( ); curl_global_cleanup( );
return ( 0 ); return ( 0 );
} }

4
src/io/io.c
View file

@ -502,8 +502,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;

10
src/memory/conspage.c
View file

@ -193,7 +193,7 @@ void free_cell( struct cons_pointer pointer ) {
cell->payload.free.car = NIL; cell->payload.free.car = NIL;
cell->payload.free.cdr = freelist; cell->payload.free.cdr = freelist;
freelist = pointer; freelist = pointer;
total_cells_freed ++; total_cells_freed++;
} else { } else {
debug_printf( DEBUG_ALLOC, debug_printf( DEBUG_ALLOC,
L"ERROR: Attempt to free cell with %d dangling references at page %d, offset %d\n", L"ERROR: Attempt to free cell with %d dangling references at page %d, offset %d\n",
@ -235,7 +235,7 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
cell->payload.cons.car = NIL; cell->payload.cons.car = NIL;
cell->payload.cons.cdr = NIL; cell->payload.cons.cdr = NIL;
total_cells_allocated ++; total_cells_allocated++;
debug_printf( DEBUG_ALLOC, debug_printf( DEBUG_ALLOC,
L"Allocated cell of type '%4.4s' at %d, %d \n", tag, L"Allocated cell of type '%4.4s' at %d, %d \n", tag,
@ -265,6 +265,8 @@ void initialise_cons_pages( ) {
} }
} }
void summarise_allocation() { void summarise_allocation( ) {
fwprintf(stderr, L"Allocation summary: allocated %lld; deallocated %lld.\n", total_cells_allocated, total_cells_freed ); fwprintf( stderr,
L"Allocation summary: allocated %lld; deallocated %lld.\n",
total_cells_allocated, total_cells_freed );
} }

2
src/memory/conspage.h
View file

@ -61,6 +61,6 @@ void initialise_cons_pages( );
void dump_pages( URL_FILE * output ); void dump_pages( URL_FILE * output );
void summarise_allocation(); void summarise_allocation( );
#endif #endif

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

4
src/memory/hashmap.c
View file

@ -180,8 +180,8 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
map->payload.hashmap.buckets[bucket_no] = map->payload.hashmap.buckets[bucket_no] =
inc_ref( make_cons( make_cons( key, val ), inc_ref( make_cons( make_cons( key, val ),
map->payload. map->payload.hashmap.
hashmap.buckets[bucket_no] ) ); buckets[bucket_no] ) );
} }
} }
} }

142
src/ops/lispops.c
View file

@ -61,7 +61,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
struct cons_pointer env ) { struct cons_pointer env ) {
debug_print( L"eval_form: ", DEBUG_EVAL ); debug_print( L"eval_form: ", DEBUG_EVAL );
debug_print_object( form, DEBUG_EVAL ); debug_print_object( form, DEBUG_EVAL );
debug_println(DEBUG_EVAL); debug_println( DEBUG_EVAL );
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_pointer next_pointer = make_empty_frame( parent_pointer ); struct cons_pointer next_pointer = make_empty_frame( parent_pointer );
@ -82,7 +82,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
debug_print( L"eval_form returning: ", DEBUG_EVAL ); debug_print( L"eval_form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
debug_println(DEBUG_EVAL); debug_println( DEBUG_EVAL );
return result; return result;
} }
@ -416,9 +416,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer; result = next_pointer;
} else { } else {
result = result =
( *fn_cell.payload.special. ( *fn_cell.payload.
executable ) ( get_stack_frame( next_pointer ), special.executable ) ( get_stack_frame
next_pointer, env ); ( next_pointer ),
next_pointer, env );
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 );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );
@ -594,10 +595,10 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
} else { } else {
result = result =
throw_exception( make_cons throw_exception( make_cons
( c_string_to_lisp_string ( c_string_to_lisp_string
( L"The first argument to `set` is not a symbol: " ), ( L"The first argument to `set` is not a symbol: " ),
make_cons( frame->arg[0], NIL ) ), make_cons( frame->arg[0], NIL ) ),
frame_pointer ); frame_pointer );
} }
return result; return result;
@ -633,10 +634,10 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
} else { } else {
result = result =
throw_exception( make_cons throw_exception( make_cons
( c_string_to_lisp_string ( c_string_to_lisp_string
( L"The first argument to `set!` is not a symbol: " ), ( L"The first argument to `set!` is not a symbol: " ),
make_cons( frame->arg[0], NIL ) ), make_cons( frame->arg[0], NIL ) ),
frame_pointer ); frame_pointer );
} }
return result; return result;
@ -1213,7 +1214,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer message = frame->arg[0]; struct cons_pointer message = frame->arg[0];
return exceptionp( message ) ? message : throw_exception( message, return exceptionp( message ) ? message : throw_exception( message,
frame->previous ); frame->
previous );
} }
/** /**
@ -1380,13 +1382,14 @@ 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 ).payload. make_string_like_thing( ( pointer2cell( l1 ).
string.character ), l2, payload.string.character ),
l2,
pointer2cell( l1 ).tag.value ); pointer2cell( l1 ).tag.value );
} else { } else {
return return
make_string_like_thing( ( pointer2cell( l1 ).payload. make_string_like_thing( ( pointer2cell( l1 ).
string.character ), payload.string.character ),
c_append( c_cdr( l1 ), l2 ), c_append( c_cdr( l1 ), l2 ),
pointer2cell( l1 ).tag.value ); pointer2cell( l1 ).tag.value );
} }
@ -1408,13 +1411,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
struct cons_pointer lisp_append( struct stack_frame *frame, struct cons_pointer lisp_append( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer result = fetch_arg(frame, (frame->args - 1)); struct cons_pointer result = fetch_arg( frame, ( frame->args - 1 ) );
for (int a = frame->args - 2; a >= 0; a--) { for ( int a = frame->args - 2; a >= 0; a-- ) {
result = c_append(fetch_arg(frame, a), result); result = c_append( fetch_arg( frame, a ), result );
} }
return result; return result;
} }
struct cons_pointer lisp_mapcar( struct stack_frame *frame, struct cons_pointer lisp_mapcar( struct stack_frame *frame,
@ -1426,34 +1429,35 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame,
int i = 0; int i = 0;
for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) { for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) {
struct cons_pointer expr = make_cons(frame->arg[0], make_cons(c_car(c), NIL)); struct cons_pointer expr =
inc_ref(expr); make_cons( frame->arg[0], make_cons( c_car( c ), NIL ) );
inc_ref( expr );
debug_printf(DEBUG_EVAL, L"Mapcar %d, evaluating ", i); debug_printf( DEBUG_EVAL, L"Mapcar %d, evaluating ", i );
debug_print_object( expr, DEBUG_EVAL); debug_print_object( expr, DEBUG_EVAL );
debug_println(DEBUG_EVAL); debug_println( DEBUG_EVAL );
struct cons_pointer r = eval_form(frame, frame_pointer, expr, env); struct cons_pointer r = eval_form( frame, frame_pointer, expr, env );
if ( exceptionp( r ) ) { if ( exceptionp( r ) ) {
result = r; result = r;
inc_ref( expr ); // to protect exception from the later dec_ref inc_ref( expr ); // to protect exception from the later dec_ref
break; break;
} else { } else {
result = make_cons( r, result ); result = make_cons( r, result );
} }
debug_printf(DEBUG_EVAL, L"Mapcar %d, result is ", i++); debug_printf( DEBUG_EVAL, L"Mapcar %d, result is ", i++ );
debug_print_object( result, DEBUG_EVAL); debug_print_object( result, DEBUG_EVAL );
debug_println(DEBUG_EVAL); debug_println( DEBUG_EVAL );
dec_ref( expr ); dec_ref( expr );
} }
result = consp(result) ? c_reverse( result ) : result; result = consp( result ) ? c_reverse( result ) : result;
debug_print( L"Mapcar returning: ", DEBUG_EVAL ); debug_print( L"Mapcar returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
debug_println(DEBUG_EVAL); debug_println( DEBUG_EVAL );
return result; return result;
} }
@ -1461,14 +1465,14 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame,
struct cons_pointer lisp_list( struct stack_frame *frame, struct cons_pointer lisp_list( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer result = frame->more; struct cons_pointer result = frame->more;
for ( int a = nilp(result) ? frame->args - 1: args_in_frame - 1; for ( int a = nilp( result ) ? frame->args - 1 : args_in_frame - 1;
a >= 0; a-- ) { a >= 0; a-- ) {
result = make_cons(fetch_arg(frame, a), result); result = make_cons( fetch_arg( frame, a ), result );
} }
return result; return result;
} }
/** /**
@ -1477,38 +1481,42 @@ struct cons_pointer lisp_list( struct stack_frame *frame,
* This is `let*` in Common Lisp parlance; `let` in Clojure parlance. * This is `let*` in Common Lisp parlance; `let` in Clojure parlance.
*/ */
struct cons_pointer lisp_let( struct stack_frame *frame, struct cons_pointer lisp_let( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env) { struct cons_pointer env ) {
struct cons_pointer bindings = env; struct cons_pointer bindings = env;
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
for (struct cons_pointer cursor = frame->arg[0]; for ( struct cons_pointer cursor = frame->arg[0];
truep(cursor); truep( cursor ); cursor = c_cdr( cursor ) ) {
cursor = c_cdr(cursor)) { struct cons_pointer pair = c_car( cursor );
struct cons_pointer pair = c_car(cursor); struct cons_pointer symbol = c_car( pair );
struct cons_pointer symbol = c_car(pair);
if (symbolp(symbol)) { if ( symbolp( symbol ) ) {
bindings = make_cons( bindings =
make_cons(symbol, eval_form(frame, frame_pointer, c_cdr(pair), bindings)), make_cons( make_cons
bindings); ( symbol,
eval_form( frame, frame_pointer, c_cdr( pair ),
bindings ) ), bindings );
} else { } else {
result = throw_exception( result =
c_string_to_lisp_string(L"Let: cannot bind, not a symbol"), throw_exception( c_string_to_lisp_string
frame_pointer); ( L"Let: cannot bind, not a symbol" ),
break; frame_pointer );
} break;
} }
}
/* i.e., no exception yet */ /* i.e., no exception yet */
for (int form = 1; !exceptionp(result) && form < frame->args; form++) { for ( int form = 1; !exceptionp( result ) && form < frame->args; form++ ) {
result = eval_form(frame, frame_pointer, fetch_arg(frame, form), bindings); result =
} eval_form( frame, frame_pointer, fetch_arg( frame, form ),
bindings );
}
return result; return result;
} }
// /** // /**
// * Function; print the internal representation of the object indicated by `frame->arg[0]` to the // * Function; print the internal representation of the object indicated by `frame->arg[0]` to the

6
src/ops/lispops.h
View file

@ -212,11 +212,11 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
struct cons_pointer lisp_list( struct stack_frame *frame, struct cons_pointer lisp_list( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
struct cons_pointer lisp_let( struct stack_frame *frame, struct cons_pointer lisp_let( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env); struct cons_pointer env );
#endif #endif