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

Improved (for me) formatting on Mac

Browse source 
Don't yet know whether this will work on Linux.
This commit is contained in:
Simon Brooke 2018-12-08 14:09:57 +00:00
parent 27fd678888
commit 9bfc9074b0
9 changed files with 368 additions and 319 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -11,7 +11,7 @@ TESTS := $(shell find unit-tests -name *.sh)
INC_DIRS := $(shell find $(SRC_DIRS) -type d) INC_DIRS := $(shell find $(SRC_DIRS) -type d)
INC_FLAGS := $(addprefix -I,$(INC_DIRS)) INC_FLAGS := $(addprefix -I,$(INC_DIRS))
INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli0 \ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \
-d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \ -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \
-npsl -nsc -nsob -nss -nut -prs -l79 -ts2 -npsl -nsc -nsob -nss -nut -prs -l79 -ts2

3
src/consspaceobject.c
View file

@ -120,7 +120,8 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
break; break;
case FREETV: case FREETV:
fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset );
break; break;
case INTEGERTV: case INTEGERTV:
fwprintf( output, fwprintf( output,

6
src/equal.c
View file

@ -62,7 +62,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
case CONSTV: case CONSTV:
result = result =
equal( cell_a->payload.cons.car, cell_b->payload.cons.car ) equal( cell_a->payload.cons.car, cell_b->payload.cons.car )
&& equal( cell_a->payload.cons.cdr, cell_b->payload.cons.cdr ); && equal( cell_a->payload.cons.cdr,
cell_b->payload.cons.cdr );
break; break;
case STRINGTV: case STRINGTV:
case SYMBOLTV: case SYMBOLTV:
@ -77,7 +78,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
&& ( equal( cell_a->payload.string.cdr, && ( equal( cell_a->payload.string.cdr,
cell_b->payload.string.cdr ) cell_b->payload.string.cdr )
|| ( end_of_string( cell_a->payload.string.cdr ) || ( end_of_string( cell_a->payload.string.cdr )
&& end_of_string( cell_b->payload.string.cdr ) ) ); && end_of_string( cell_b->payload.string.
cdr ) ) );
break; break;
case INTEGERTV: case INTEGERTV:
case REALTV: case REALTV:

49
src/lispops.c
View file

@ -96,6 +96,38 @@ struct cons_pointer eval_form( struct stack_frame *parent,
return result; return result;
} }
/**
* The Lisp interpreter.
*
* @param frame the stack frame in which the expression is to be interpreted;
* @param lexpr the lambda expression to be interpreted;
* @param env the environment in which it is to be intepreted.
*/
struct cons_pointer
lisp_lambda( struct stack_frame *frame, struct cons_pointer lexpr,
struct cons_pointer env ) {
struct cons_pointer result = NIL;
struct cons_pointer should_be_lambda =
eval_form( frame, c_car( lexpr ), env );
if ( lambdap( should_be_lambda ) ) {
struct cons_pointer new_env = env;
} else {
char *buffer = malloc( 1024 );
memset( buffer, '\0', 1024 );
sprintf( buffer,
"Expected lambda, but found cell with tag %d (%c%c%c%c)",
fn_cell.tag.value, fn_cell.tag.bytes[0],
fn_cell.tag.bytes[1], fn_cell.tag.bytes[2],
fn_cell.tag.bytes[3] );
struct cons_pointer message = c_string_to_lisp_string( buffer );
free( buffer );
result = lisp_throw( message, frame );
}
return result;
}
/** /**
* Internal guts of apply. * Internal guts of apply.
@ -120,7 +152,8 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
switch ( fn_cell.tag.value ) { switch ( fn_cell.tag.value ) {
case SPECIALTV: case SPECIALTV:
{ {
struct stack_frame *next = make_special_frame( frame, args, env ); struct stack_frame *next =
make_special_frame( frame, args, env );
result = ( *fn_cell.payload.special.executable ) ( next, env ); result = ( *fn_cell.payload.special.executable ) ( next, env );
free_stack_frame( next ); free_stack_frame( next );
} }
@ -128,12 +161,18 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
case FUNCTIONTV: case FUNCTIONTV:
{ {
struct stack_frame *next = make_stack_frame( frame, args, env ); struct stack_frame *next =
make_stack_frame( frame, args, env );
result = ( *fn_cell.payload.special.executable ) ( next, env ); result = ( *fn_cell.payload.special.executable ) ( next, env );
free_stack_frame( next ); free_stack_frame( next );
} }
break; break;
case CONSTV:
{
result = lisp_lambda( frame, fn_pointer, env );
}
break;
default: default:
{ {
char *buffer = malloc( 1024 ); char *buffer = malloc( 1024 );
@ -143,7 +182,8 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
fn_cell.tag.value, fn_cell.tag.bytes[0], fn_cell.tag.value, fn_cell.tag.bytes[0],
fn_cell.tag.bytes[1], fn_cell.tag.bytes[2], fn_cell.tag.bytes[1], fn_cell.tag.bytes[2],
fn_cell.tag.bytes[3] ); fn_cell.tag.bytes[3] );
struct cons_pointer message = c_string_to_lisp_string( buffer ); struct cons_pointer message =
c_string_to_lisp_string( buffer );
free( buffer ); free( buffer );
result = lisp_throw( message, frame ); result = lisp_throw( message, frame );
} }
@ -199,7 +239,8 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
case SYMBOLTV: case SYMBOLTV:
{ {
struct cons_pointer canonical = internedp( frame->arg[0], env ); struct cons_pointer canonical =
internedp( frame->arg[0], env );
if ( nilp( canonical ) ) { if ( nilp( canonical ) ) {
struct cons_pointer message = struct cons_pointer message =
c_string_to_lisp_string c_string_to_lisp_string

4
src/peano.c
View file

@ -51,8 +51,8 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) {
is_int = false; is_int = false;
break; break;
default: default:
lisp_throw( c_string_to_lisp_string( "Cannot add: not a number" ), lisp_throw( c_string_to_lisp_string
frame ); ( "Cannot add: not a number" ), frame );
} }
if ( !nilp( frame->more ) ) { if ( !nilp( frame->more ) ) {

19
src/read.c
View file

@ -65,7 +65,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
( "End of input while reading" ), frame ); ( "End of input while reading" ), frame );
break; break;
case '\'': case '\'':
result = c_quote( read_continuation( frame, input, fgetwc( input ) ) ); result =
c_quote( read_continuation( frame, input, fgetwc( input ) ) );
break; break;
case '(': case '(':
result = read_list( frame, input, fgetwc( input ) ); result = read_list( frame, input, fgetwc( input ) );
@ -82,7 +83,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
} else if ( iswblank( next ) ) { } else if ( iswblank( next ) ) {
/* dotted pair. TODO: this isn't right, we /* dotted pair. TODO: this isn't right, we
* really need to backtrack up a level. */ * really need to backtrack up a level. */
result = read_continuation( frame, input, fgetwc( input ) ); result =
read_continuation( frame, input, fgetwc( input ) );
} else { } else {
read_symbol( input, c ); read_symbol( input, c );
} }
@ -91,8 +93,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
} else if ( iswprint( c ) ) { } else if ( iswprint( c ) ) {
result = read_symbol( input, c ); result = read_symbol( input, c );
} else { } else {
fwprintf( stderr, L"Unrecognised start of input character %c\n", fwprintf( stderr,
c ); L"Unrecognised start of input character %c\n", c );
} }
} }
@ -184,7 +186,8 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) {
result = make_string( '\0', NIL ); result = make_string( '\0', NIL );
break; break;
default: default:
result = make_string( initial, read_string( input, fgetwc( input ) ) ); result =
make_string( initial, read_string( input, fgetwc( input ) ) );
break; break;
} }
@ -203,7 +206,8 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
/* /*
* THIS IS NOT A GOOD IDEA, but is legal * THIS IS NOT A GOOD IDEA, but is legal
*/ */
result = make_symbol( initial, read_symbol( input, fgetwc( input ) ) ); result =
make_symbol( initial, read_symbol( input, fgetwc( input ) ) );
break; break;
case ')': case ')':
/* /*
@ -218,7 +222,8 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
default: default:
if ( iswprint( initial ) && !iswblank( initial ) ) { if ( iswprint( initial ) && !iswblank( initial ) ) {
result = result =
make_symbol( initial, read_symbol( input, fgetwc( input ) ) ); make_symbol( initial,
read_symbol( input, fgetwc( input ) ) );
} else { } else {
result = NIL; result = NIL;
/* /*