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_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 \
-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;
case FREETV:
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;
case INTEGERTV:
fwprintf( output,

6
src/equal.c
View file

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

49
src/lispops.c
View file

@ -96,6 +96,38 @@ struct cons_pointer eval_form( struct stack_frame *parent,
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.
@ -120,7 +152,8 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
switch ( fn_cell.tag.value ) {
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 );
free_stack_frame( next );
}
@ -128,12 +161,18 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
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 );
free_stack_frame( next );
}
break;
case CONSTV:
{
result = lisp_lambda( frame, fn_pointer, env );
}
break;
default:
{
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.bytes[1], fn_cell.tag.bytes[2],
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 );
result = lisp_throw( message, frame );
}
@ -199,7 +239,8 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
case SYMBOLTV:
{
struct cons_pointer canonical = internedp( frame->arg[0], env );
struct cons_pointer canonical =
internedp( frame->arg[0], env );
if ( nilp( canonical ) ) {
struct cons_pointer message =
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;
break;
default:
lisp_throw( c_string_to_lisp_string( "Cannot add: not a number" ),
frame );
lisp_throw( c_string_to_lisp_string
( "Cannot add: not a number" ), frame );
}
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 );
break;
case '\'':
result = c_quote( read_continuation( frame, input, fgetwc( input ) ) );
result =
c_quote( read_continuation( frame, input, fgetwc( input ) ) );
break;
case '(':
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 ) ) {
/* dotted pair. TODO: this isn't right, we
* really need to backtrack up a level. */
result = read_continuation( frame, input, fgetwc( input ) );
result =
read_continuation( frame, input, fgetwc( input ) );
} else {
read_symbol( input, c );
}
@ -91,8 +93,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
} else if ( iswprint( c ) ) {
result = read_symbol( input, c );
} else {
fwprintf( stderr, L"Unrecognised start of input character %c\n",
c );
fwprintf( stderr,
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 );
break;
default:
result = make_string( initial, read_string( input, fgetwc( input ) ) );
result =
make_string( initial, read_string( input, fgetwc( input ) ) );
break;
}
@ -203,7 +206,8 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
/*
* 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;
case ')':
/*
@ -218,7 +222,8 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
default:
if ( iswprint( initial ) && !iswblank( initial ) ) {
result =
make_symbol( initial, read_symbol( input, fgetwc( input ) ) );
make_symbol( initial,
read_symbol( input, fgetwc( input ) ) );
} else {
result = NIL;
/*