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

Trying to get to the point where make format works the same

Browse source 
on Linux and MacOS
This commit is contained in:
Simon Brooke 2018-12-07 20:53:09 +00:00
parent 93b84087ce
commit d620542ee5
13 changed files with 191 additions and 176 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -18,3 +18,5 @@ src/\.#*
post-scarcity\.iml post-scarcity\.iml
doc/ doc/
log*

10
Makefile
View file

@ -1,4 +1,3 @@
TARGET ?= target/psse TARGET ?= target/psse
SRC_DIRS ?= ./src SRC_DIRS ?= ./src
@ -11,7 +10,10 @@ 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 := -kr -br -brf -brs -ce -cdw -npsl -nut -prs -l79 -ts2
INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli0 \
-d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \
-npsl -nsc -nsob -nss -nut -prs -l79 -ts2
VERSION := "0.0.2" VERSION := "0.0.2"
@ -25,7 +27,11 @@ doc: $(SRCS) Makefile
doxygen doxygen
format: $(SRCS) $(HDRS) Makefile format: $(SRCS) $(HDRS) Makefile
ifeq ($(shell uname -s), Darwin)
gindent $(INDENT_FLAGS) $(SRCS) $(HDRS)
else
indent $(INDENT_FLAGS) $(SRCS) $(HDRS) indent $(INDENT_FLAGS) $(SRCS) $(HDRS)
endif
test: $(OBJS) $(TESTS) Makefile test: $(OBJS) $(TESTS) Makefile
bash ./unit-tests.sh bash ./unit-tests.sh

13
src/conspage.c
View file

@ -55,7 +55,7 @@ void make_cons_page( ) {
struct cons_space_object *cell = struct cons_space_object *cell =
&conspages[initialised_cons_pages]->cell[i]; &conspages[initialised_cons_pages]->cell[i];
if ( initialised_cons_pages == 0 && i < 3 ) { if ( initialised_cons_pages == 0 && i < 3 ) {
switch ( i) { switch ( i ) {
case 0: case 0:
/* /*
* initialise cell as NIL * initialise cell as NIL
@ -73,9 +73,11 @@ void make_cons_page( ) {
strncpy( &cell->tag.bytes[0], TRUETAG, TAGLENGTH ); strncpy( &cell->tag.bytes[0], TRUETAG, TAGLENGTH );
cell->count = MAXREFERENCE; cell->count = MAXREFERENCE;
cell->payload.free.car = ( struct cons_pointer ) { cell->payload.free.car = ( struct cons_pointer ) {
0, 1}; 0, 1
};
cell->payload.free.cdr = ( struct cons_pointer ) { cell->payload.free.cdr = ( struct cons_pointer ) {
0, 1}; 0, 1
};
fwprintf( stderr, L"Allocated special cell T\n" ); fwprintf( stderr, L"Allocated special cell T\n" );
break; break;
case 2: case 2:
@ -84,7 +86,7 @@ void make_cons_page( ) {
*/ */
strncpy( &cell->tag.bytes[0], LAMBDATAG, TAGLENGTH ); strncpy( &cell->tag.bytes[0], LAMBDATAG, TAGLENGTH );
cell->count = MAXREFERENCE; cell->count = MAXREFERENCE;
cell->payload.string.character = (wint_t)L'λ'; cell->payload.string.character = ( wint_t ) L'λ';
cell->payload.free.cdr = NIL; cell->payload.free.cdr = NIL;
fwprintf( stderr, L"Allocated special cell LAMBDA\n" ); fwprintf( stderr, L"Allocated special cell LAMBDA\n" );
break; break;
@ -120,7 +122,8 @@ void dump_pages( FILE * output ) {
for ( int j = 0; j < CONSPAGESIZE; j++ ) { for ( int j = 0; j < CONSPAGESIZE; j++ ) {
dump_object( output, ( struct cons_pointer ) { dump_object( output, ( struct cons_pointer ) {
i, j} ); i, j
} );
} }
} }
} }

90
src/consspaceobject.c
View file

@ -63,6 +63,29 @@ void dec_ref( struct cons_pointer pointer ) {
} }
} }
void dump_string_cell( FILE * output, wchar_t *prefix,
struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
if ( cell.payload.string.character == 0 ) {
fwprintf( output,
L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n",
prefix,
cell.payload.string.cdr.page, cell.payload.string.cdr.offset,
cell.count );
} else {
fwprintf( output,
L"\t\t%ls cell: character '%lc' (%d) next at page %d offset %d, count %u\n",
prefix,
( wint_t ) cell.payload.string.character,
cell.payload.string.character,
cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count );
fwprintf( output, L"\t\t value: " );
print( output, pointer );
fwprintf( output, L"\n" );
}
}
/** /**
* dump the object at this cons_pointer to this output stream. * dump the object at this cons_pointer to this output stream.
*/ */
@ -85,17 +108,16 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
cell.payload.cons.cdr.page, cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset, cell.count ); cell.payload.cons.cdr.offset, cell.count );
break; break;
case EXCEPTIONTV: case EXCEPTIONTV:
fwprintf(output, L"\t\tException cell: "); fwprintf( output, L"\t\tException cell: " );
print(output, cell.payload.exception.message); print( output, cell.payload.exception.message );
fwprintf( output, L"\n"); fwprintf( output, L"\n" );
/* TODO: dump the stack trace */ /* TODO: dump the stack trace */
for (struct stack_frame * frame = cell.payload.exception.frame; for ( struct stack_frame * frame = cell.payload.exception.frame;
frame != NULL; frame != NULL; frame = frame->previous ) {
frame = frame->previous){ dump_frame( output, frame );
dump_frame(output, frame); }
} 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 );
@ -105,40 +127,17 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
L"\t\tInteger cell: value %ld, count %u\n", L"\t\tInteger cell: value %ld, count %u\n",
cell.payload.integer.value, cell.count ); cell.payload.integer.value, cell.count );
break; break;
case READTV: case READTV:
fwprintf( output, L"\t\tInput stream\n"); fwprintf( output, L"\t\tInput stream\n" );
case REALTV: case REALTV:
fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n",
cell.payload.real.value, cell.count ); cell.payload.real.value, cell.count );
break; break;
case STRINGTV: case STRINGTV:
if (cell.payload.string.character == 0) { dump_string_cell( output, L"String", pointer );
fwprintf( output,
L"\t\tString cell: termination; next at page %d offset %d, count %u\n",
cell.payload.string.character,
cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count );
}else {
fwprintf( output,
L"\t\tString cell: character '%lc' (%d) next at page %d offset %d, count %u\n",
cell.payload.string.character,
cell.payload.string.character,
cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count );
fwprintf( output, L"\t\t value: " );
print( output, pointer );
fwprintf( output, L"\n" );}
break; break;
case SYMBOLTV: case SYMBOLTV:
fwprintf( output, dump_string_cell( output, L"Symbol", pointer );
L"\t\tSymbol cell: character '%lc' (%d) next at page %d offset %d, count %u\n",
cell.payload.string.character,
cell.payload.string.character,
cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count );
fwprintf( output, L"\t\t value:" );
print( output, pointer );
fwprintf( output, L"\n" );
break; break;
} }
} }
@ -168,7 +167,8 @@ struct cons_pointer make_cons( struct cons_pointer car,
* @param message should be a lisp string describing the problem, but actually any cons pointer will do; * @param message should be a lisp string describing the problem, but actually any cons pointer will do;
* @param frame should be the frame in which the exception occurred. * @param frame should be the frame in which the exception occurred.
*/ */
struct cons_pointer make_exception( struct cons_pointer message, struct stack_frame * frame) { struct cons_pointer make_exception( struct cons_pointer message,
struct stack_frame *frame ) {
struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG ); struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
@ -259,26 +259,26 @@ make_special( struct cons_pointer src, struct cons_pointer ( *executable )
* Construct a cell which points to a stream open for reading. * Construct a cell which points to a stream open for reading.
* @param input the C stream to wrap. * @param input the C stream to wrap.
*/ */
struct cons_pointer make_read_stream( FILE * input) { struct cons_pointer make_read_stream( FILE * input ) {
struct cons_pointer pointer = allocate_cell( READTAG ); struct cons_pointer pointer = allocate_cell( READTAG );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
cell->payload.stream.stream = input; cell->payload.stream.stream = input;
return pointer; return pointer;
} }
/** /**
* Construct a cell which points to a stream open for writeing. * Construct a cell which points to a stream open for writeing.
* @param output the C stream to wrap. * @param output the C stream to wrap.
*/ */
struct cons_pointer make_write_stream( FILE * output) { struct cons_pointer make_write_stream( FILE * output ) {
struct cons_pointer pointer = allocate_cell( WRITETAG ); struct cons_pointer pointer = allocate_cell( WRITETAG );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
cell->payload.stream.stream = output; cell->payload.stream.stream = output;
return pointer; return pointer;
} }
/** /**

11
src/consspaceobject.h
View file

@ -272,8 +272,8 @@ struct cons_payload {
* Message should be a Lisp string; frame should be a pointer to an (unfreed) stack frame. * Message should be a Lisp string; frame should be a pointer to an (unfreed) stack frame.
*/ */
struct exception_payload { struct exception_payload {
struct cons_pointer message; struct cons_pointer message;
struct stack_frame * frame; struct stack_frame *frame;
}; };
/** /**
@ -461,7 +461,8 @@ struct cons_pointer make_cons( struct cons_pointer car,
* @param message should be a lisp string describing the problem, but actually any cons pointer will do; * @param message should be a lisp string describing the problem, but actually any cons pointer will do;
* @param frame should be the frame in which the exception occurred. * @param frame should be the frame in which the exception occurred.
*/ */
struct cons_pointer make_exception( struct cons_pointer message, struct stack_frame * frame); struct cons_pointer make_exception( struct cons_pointer message,
struct stack_frame *frame );
/** /**
* Construct a cell which points to an executable Lisp special form. * Construct a cell which points to an executable Lisp special form.
@ -496,13 +497,13 @@ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail );
* Construct a cell which points to a stream open for reading. * Construct a cell which points to a stream open for reading.
* @param input the C stream to wrap. * @param input the C stream to wrap.
*/ */
struct cons_pointer make_read_stream( FILE * input); struct cons_pointer make_read_stream( FILE * input );
/** /**
* Construct a cell which points to a stream open for writeing. * Construct a cell which points to a stream open for writeing.
* @param output the C stream to wrap. * @param output the C stream to wrap.
*/ */
struct cons_pointer make_write_stream( FILE * output); struct cons_pointer make_write_stream( FILE * output );
/** /**

2
src/init.c
View file

@ -74,7 +74,7 @@ int main( int argc, char *argv[] ) {
deep_bind( c_string_to_lisp_symbol( "nil" ), NIL ); deep_bind( c_string_to_lisp_symbol( "nil" ), NIL );
deep_bind( c_string_to_lisp_symbol( "t" ), TRUE ); deep_bind( c_string_to_lisp_symbol( "t" ), TRUE );
/* deep_bind( c_string_to_lisp_symbol( L"λ"), LAMBDA ); */ /* deep_bind( c_string_to_lisp_symbol( L"λ"), LAMBDA ); */
deep_bind( c_string_to_lisp_symbol( "lambda"), LAMBDA ); deep_bind( c_string_to_lisp_symbol( "lambda" ), LAMBDA );
/* /*
* primitive function operations * primitive function operations

15
src/lispops.c
View file

@ -475,7 +475,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer env ) {
done = true; done = true;
} else { } else {
result = lisp_throw( c_string_to_lisp_string result = lisp_throw( c_string_to_lisp_string
( "Arguments to `cond` must be lists" ), frame ); ( "Arguments to `cond` must be lists" ),
frame );
} }
} }
/* TODO: if there are more than 8 clauses we need to continue into the /* TODO: if there are more than 8 clauses we need to continue into the
@ -495,11 +496,11 @@ lisp_throw( struct cons_pointer message, struct stack_frame *frame ) {
struct cons_space_object cell = pointer2cell( message ); struct cons_space_object cell = pointer2cell( message );
if ( cell.tag.value == EXCEPTIONTV) { if ( cell.tag.value == EXCEPTIONTV ) {
result = message; result = message;
} else { } else {
result = make_exception( message, frame); result = make_exception( message, frame );
} }
return result; return result;
} }

33
src/peano.c
View file

@ -144,9 +144,9 @@ lisp_subtract( struct stack_frame *frame, struct cons_pointer env ) {
make_real( arg0.payload.real.value - make_real( arg0.payload.real.value -
numeric_value( frame->arg[1] ) ); numeric_value( frame->arg[1] ) );
} else { } else {
/* TODO: throw an exception */ /* TODO: throw an exception */
lisp_throw( c_string_to_lisp_string lisp_throw( c_string_to_lisp_string
( "Cannot subtract: not a number" ), frame ); ( "Cannot subtract: not a number" ), frame );
} }
// and if not nilp[frame->arg[2]) we also have an error. // and if not nilp[frame->arg[2]) we also have an error.
@ -167,21 +167,20 @@ lisp_divide( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_space_object arg0 = pointer2cell( frame->arg[0] ); struct cons_space_object arg0 = pointer2cell( frame->arg[0] );
struct cons_space_object arg1 = pointer2cell( frame->arg[1] ); struct cons_space_object arg1 = pointer2cell( frame->arg[1] );
if ( numberp(frame->arg[1]) && numeric_value(frame->arg[1]) == 0) { if ( numberp( frame->arg[1] ) && numeric_value( frame->arg[1] ) == 0 ) {
lisp_throw( c_string_to_lisp_string lisp_throw( c_string_to_lisp_string
( "Cannot divide: divisor is zero" ), frame ); ( "Cannot divide: divisor is zero" ), frame );
} else if ( integerp( frame->arg[0] ) && integerp( frame->arg[1] ) ) { } else if ( integerp( frame->arg[0] ) && integerp( frame->arg[1] ) ) {
result = make_integer( arg0.payload.integer.value / result = make_integer( arg0.payload.integer.value /
arg1.payload.integer.value ); arg1.payload.integer.value );
} else if ( numberp(frame->arg[0]) && numberp(frame->arg[1])) { } else if ( numberp( frame->arg[0] ) && numberp( frame->arg[1] ) ) {
result = make_real( numeric_value(frame->arg[0]) / numeric_value(frame->arg[1])); result =
make_real( numeric_value( frame->arg[0] ) /
numeric_value( frame->arg[1] ) );
} else { } else {
lisp_throw( c_string_to_lisp_string lisp_throw( c_string_to_lisp_string
( "Cannot divide: not a number" ), frame ); ( "Cannot divide: not a number" ), frame );
} }
return result; return result;
} }

80
src/print.c
View file

@ -78,45 +78,45 @@ void print( FILE * output, struct cons_pointer pointer ) {
* statement can ultimately be replaced by a switch, which will be neater. * statement can ultimately be replaced by a switch, which will be neater.
*/ */
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case CONSTV: case CONSTV:
print_list( output, pointer ); print_list( output, pointer );
break; break;
case EXCEPTIONTV: case EXCEPTIONTV:
fwprintf( output, L"\nException: "); fwprintf( output, L"\nException: " );
print_string_contents( output, cell.payload.exception.message); print_string_contents( output, cell.payload.exception.message );
break; break;
case INTEGERTV: case INTEGERTV:
fwprintf( output, L"%ld", cell.payload.integer.value ); fwprintf( output, L"%ld", cell.payload.integer.value );
break; break;
case LAMBDATV: case LAMBDATV:
fwprintf( output, L"lambda" /* "λ" */); fwprintf( output, L"lambda" /* "λ" */ );
break; break;
case NILTV: case NILTV:
fwprintf( output, L"nil" ); fwprintf( output, L"nil" );
break; break;
case REALTV: case REALTV:
fwprintf( output, L"%Lf", cell.payload.real.value ); fwprintf( output, L"%Lf", cell.payload.real.value );
break; break;
case STRINGTV: case STRINGTV:
print_string( output, pointer ); print_string( output, pointer );
break; break;
case SYMBOLTV: case SYMBOLTV:
print_string_contents( output, pointer ); print_string_contents( output, pointer );
break; break;
case TRUETV: case TRUETV:
fwprintf( output, L"t" ); fwprintf( output, L"t" );
break; break;
case FUNCTIONTV: case FUNCTIONTV:
fwprintf( output, L"(Function)" ); fwprintf( output, L"(Function)" );
break; break;
case SPECIALTV: case SPECIALTV:
fwprintf( output, L"(Special form)" ); fwprintf( output, L"(Special form)" );
break; break;
default: default:
fwprintf( stderr, fwprintf( stderr,
L"Error: Unrecognised tag value %d (%c%c%c%c)\n", L"Error: Unrecognised tag value %d (%c%c%c%c)\n",
cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1], cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1],
cell.tag.bytes[2], cell.tag.bytes[3] ); cell.tag.bytes[2], cell.tag.bytes[3] );
break; break;
} }
} }

19
src/read.c
View file

@ -32,7 +32,8 @@
*/ */
struct cons_pointer read_number( FILE * input, wint_t initial ); struct cons_pointer read_number( FILE * input, wint_t initial );
struct cons_pointer read_list( struct stack_frame *frame, FILE * input, wint_t initial ); struct cons_pointer read_list( struct stack_frame *frame, FILE * input,
wint_t initial );
struct cons_pointer read_string( FILE * input, wint_t initial ); struct cons_pointer read_string( FILE * input, wint_t initial );
struct cons_pointer read_symbol( FILE * input, wint_t initial ); struct cons_pointer read_symbol( FILE * input, wint_t initial );
@ -49,7 +50,8 @@ struct cons_pointer c_quote( struct cons_pointer arg ) {
* treating this initial character as the first character of the object * treating this initial character as the first character of the object
* representation. * representation.
*/ */
struct cons_pointer read_continuation(struct stack_frame *frame, FILE * input, wint_t initial ) { struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
wint_t initial ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
wint_t c; wint_t c;
@ -58,10 +60,10 @@ struct cons_pointer read_continuation(struct stack_frame *frame, FILE * input, w
c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) ); c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) );
switch ( c ) { switch ( c ) {
case EOF: case EOF:
result = lisp_throw( c_string_to_lisp_string result = lisp_throw( c_string_to_lisp_string
( "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;
@ -147,7 +149,8 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
* Read a list from this input stream, which no longer contains the opening * Read a list from this input stream, which no longer contains the opening
* left parenthesis. * left parenthesis.
*/ */
struct cons_pointer read_list( struct stack_frame *frame, FILE * input, wint_t initial ) { struct cons_pointer read_list( struct stack_frame *frame, FILE * input,
wint_t initial ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
if ( initial != ')' ) { if ( initial != ')' ) {
@ -236,6 +239,6 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
/** /**
* Read the next object on this input stream and return a cons_pointer to it. * Read the next object on this input stream and return a cons_pointer to it.
*/ */
struct cons_pointer read(struct stack_frame *frame, FILE * input ) { struct cons_pointer read( struct stack_frame *frame, FILE * input ) {
return read_continuation( frame, input, fgetwc( input ) ); return read_continuation( frame, input, fgetwc( input ) );
} }

2
src/read.h
View file

@ -14,6 +14,6 @@
/** /**
* read the next object on this input stream and return a cons_pointer to it. * read the next object on this input stream and return a cons_pointer to it.
*/ */
struct cons_pointer read(struct stack_frame *frame, FILE * input ); struct cons_pointer read( struct stack_frame *frame, FILE * input );
#endif #endif

60
src/repl.c
View file

@ -30,41 +30,42 @@
/** /**
* Dummy up a Lisp read call with its own stack frame. * Dummy up a Lisp read call with its own stack frame.
*/ */
struct cons_pointer repl_read( struct cons_pointer stream_pointer) { struct cons_pointer repl_read( struct cons_pointer stream_pointer ) {
struct stack_frame *frame = make_empty_frame( NULL, oblist ); struct stack_frame *frame = make_empty_frame( NULL, oblist );
frame->arg[0] = stream_pointer; frame->arg[0] = stream_pointer;
struct cons_pointer result = lisp_read( frame, oblist); struct cons_pointer result = lisp_read( frame, oblist );
free_stack_frame( frame ); free_stack_frame( frame );
return result; return result;
} }
/** /**
* Dummy up a Lisp eval call with its own stack frame. * Dummy up a Lisp eval call with its own stack frame.
*/ */
struct cons_pointer repl_eval( struct cons_pointer input) { struct cons_pointer repl_eval( struct cons_pointer input ) {
struct stack_frame *frame = make_empty_frame( NULL, oblist ); struct stack_frame *frame = make_empty_frame( NULL, oblist );
frame->arg[0] = NIL /* input */; frame->arg[0] = NIL /* input */ ;
struct cons_pointer result = lisp_eval( frame, oblist); struct cons_pointer result = lisp_eval( frame, oblist );
free_stack_frame( frame ); free_stack_frame( frame );
return result; return result;
} }
/** /**
* Dummy up a Lisp print call with its own stack frame. * Dummy up a Lisp print call with its own stack frame.
*/ */
struct cons_pointer repl_print( struct cons_pointer stream_pointer, struct cons_pointer value) { struct cons_pointer repl_print( struct cons_pointer stream_pointer,
struct stack_frame *frame = make_empty_frame( NULL, oblist ); struct cons_pointer value ) {
struct stack_frame *frame = make_empty_frame( NULL, oblist );
frame->arg[0] = value; frame->arg[0] = value;
frame->arg[1] = NIL /* stream_pointer */; frame->arg[1] = NIL /* stream_pointer */ ;
struct cons_pointer result = lisp_print( frame, oblist); struct cons_pointer result = lisp_print( frame, oblist );
free_stack_frame( frame ); free_stack_frame( frame );
return result; return result;
} }
/** /**
@ -77,21 +78,20 @@ struct cons_pointer repl_print( struct cons_pointer stream_pointer, struct cons_
void void
repl( FILE * in_stream, FILE * out_stream, FILE * error_stream, repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
bool show_prompt ) { bool show_prompt ) {
struct cons_pointer input_stream = make_read_stream(in_stream); struct cons_pointer input_stream = make_read_stream( in_stream );
struct cons_pointer output_stream = make_write_stream(out_stream); struct cons_pointer output_stream = make_write_stream( out_stream );
while ( !feof( pointer2cell(input_stream).payload.stream.stream ) ) { while ( !feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
if ( show_prompt ) { if ( show_prompt ) {
fwprintf( out_stream, L"\n:: " ); fwprintf( out_stream, L"\n:: " );
} }
struct cons_pointer val = repl_eval( repl_read( input_stream)); struct cons_pointer val = repl_eval( repl_read( input_stream ) );
/* suppress the 'end of stream' exception */ /* suppress the 'end of stream' exception */
if ( exceptionp(val) && if ( exceptionp( val ) &&
!feof( pointer2cell( input_stream).payload.stream.stream ) ) !feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
{ repl_print( output_stream, val );
repl_print( output_stream, val);
} }
} }
} }

30
src/stack.c
View file

@ -84,25 +84,25 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
struct stack_frame *arg_frame = make_empty_frame( previous, env ); struct stack_frame *arg_frame = make_empty_frame( previous, env );
arg_frame->arg[0] = cell.payload.cons.car; arg_frame->arg[0] = cell.payload.cons.car;
inc_ref( arg_frame->arg[0] ); inc_ref( arg_frame->arg[0] );
struct cons_pointer val = lisp_eval( arg_frame, env ); struct cons_pointer val = lisp_eval( arg_frame, env );
if (pointer2cell(val).tag.value == EXCEPTIONTV) { if ( pointer2cell( val ).tag.value == EXCEPTIONTV ) {
result->arg[0] = val; result->arg[0] = val;
break; break;
} else { } else {
result->arg[i] = val; result->arg[i] = val;
} }
inc_ref(val); inc_ref( val );
free_stack_frame( arg_frame ); free_stack_frame( arg_frame );
args = cell.payload.cons.cdr; args = cell.payload.cons.cdr;
} }
if (!nilp( args)) { if ( !nilp( args ) ) {
/* /*
* TODO: this isn't right. These args should also each be evaled. * TODO: this isn't right. These args should also each be evaled.
*/ */
result->more = args; result->more = args;
inc_ref( result->more ); inc_ref( result->more );
} }
return result; return result;
} }