From 784fdce49a63700266b8a09e3b4c72403e77efb7 Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 12 Sep 2017 19:53:59 +0100 Subject: [PATCH 1/2] Ignore backup files. --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index ecd8e8f..056d7cb 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,7 @@ target/ nbproject/ + +*.c~ + +*.h~ From 36d8431a91987664ca69a33ce3b18e4cd9789218 Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 12 Sep 2017 22:14:11 +0100 Subject: [PATCH 2/2] 11 out of 12 unit tests passing, progress! I don't understand why it works, but it works. --- .gitignore | 4 +- Makefile | 6 +- README.md | 2 +- src/conspage.c | 113 +++++++++++------------ src/conspage.h | 8 +- src/consspaceobject.c | 157 +++++++++++++++----------------- src/consspaceobject.h | 48 +++++----- src/equal.c | 40 ++++----- src/equal.h | 4 +- src/init.c | 78 ++++++++-------- src/integer.c | 21 ++--- src/integer.h | 4 +- src/intern.c | 46 +++++----- src/intern.h | 21 ++--- src/lispops.c | 204 +++++++++++++++++++++--------------------- src/lispops.h | 52 +++++------ src/print.c | 81 ++++++++--------- src/print.h | 2 +- src/read.c | 139 ++++++++++++++-------------- src/read.h | 2 +- src/real.c | 7 +- src/real.h | 2 +- src/repl.c | 27 +++--- src/repl.h | 4 +- src/stack.c | 45 +++++----- src/stack.h | 10 +-- 26 files changed, 547 insertions(+), 580 deletions(-) diff --git a/.gitignore b/.gitignore index 056d7cb..8ddda0d 100644 --- a/.gitignore +++ b/.gitignore @@ -7,6 +7,4 @@ target/ nbproject/ -*.c~ - -*.h~ +*~ diff --git a/Makefile b/Makefile index 970f2b1..7916239 100644 --- a/Makefile +++ b/Makefile @@ -8,14 +8,14 @@ DEPS := $(OBJS:.o=.d) INC_DIRS := $(shell find $(SRC_DIRS) -type d) INC_FLAGS := $(addprefix -I,$(INC_DIRS)) -INDENT_FLAGS := -kr -nut -l79 -ts2 +INDENT_FLAGS := -kr -br -brf -brs -ce -cdw -npsl -nut -prs -l79 -ts2 VERSION := "0.0.0" -CPPFLAGS ?= $(INC_FLAGS) -MMD -MP +CPPFLAGS ?= $(INC_FLAGS) -MMD -MP -g LDFLAGS := -lm -$(TARGET): $(OBJS) +$(TARGET): $(OBJS) Makefile $(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) format: diff --git a/README.md b/README.md index b1356e6..caa6375 100644 --- a/README.md +++ b/README.md @@ -20,5 +20,5 @@ Although I describe it as a 'Lisp environment', for reasons explained in Post Sc Copyright © 2017 [Simon Brooke](mailto:simon@journeyman.cc) -Distributed under the terms of the +Distributed under the terms of the [GNU General Public License v2](http://www.gnu.org/licenses/gpl-2.0.html) diff --git a/src/conspage.c b/src/conspage.c index 3e88b1e..3413091 100644 --- a/src/conspage.c +++ b/src/conspage.c @@ -45,43 +45,42 @@ struct cons_page *conspages[NCONSPAGES]; * Initialise all cells and prepend each to the freelist; if pageno is zero, do not prepend * cells 0 and 1 to the freelist but initialise them as NIL and T respectively. */ -void make_cons_page() -{ - struct cons_page *result = malloc(sizeof(struct cons_page)); +void make_cons_page( ) { + struct cons_page *result = malloc( sizeof( struct cons_page ) ); - if (result != NULL) { + if ( result != NULL ) { conspages[initialised_cons_pages] = result; - for (int i = 0; i < CONSPAGESIZE; i++) { + for ( int i = 0; i < CONSPAGESIZE; i++ ) { struct cons_space_object *cell = &conspages[initialised_cons_pages]->cell[i]; - if (initialised_cons_pages == 0 && i < 2) { - if (i == 0) { + if ( initialised_cons_pages == 0 && i < 2 ) { + if ( i == 0 ) { /* * initialise cell as NIL */ - strncpy(&cell->tag.bytes[0], NILTAG, TAGLENGTH); + strncpy( &cell->tag.bytes[0], NILTAG, TAGLENGTH ); cell->count = MAXREFERENCE; cell->payload.free.car = NIL; cell->payload.free.cdr = NIL; - fprintf(stderr, "Allocated special cell NIL\n"); - } else if (i == 1) { + fprintf( stderr, "Allocated special cell NIL\n" ); + } else if ( i == 1 ) { /* * initialise cell as T */ - strncpy(&cell->tag.bytes[0], TRUETAG, TAGLENGTH); + strncpy( &cell->tag.bytes[0], TRUETAG, TAGLENGTH ); cell->count = MAXREFERENCE; - cell->payload.free.car = (struct cons_pointer) { + cell->payload.free.car = ( struct cons_pointer ) { 0, 1}; - cell->payload.free.cdr = (struct cons_pointer) { + cell->payload.free.cdr = ( struct cons_pointer ) { 0, 1}; - fprintf(stderr, "Allocated special cell T\n"); + fprintf( stderr, "Allocated special cell T\n" ); } } else { /* * otherwise, standard initialisation */ - strncpy(&cell->tag.bytes[0], FREETAG, TAGLENGTH); + strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH ); cell->payload.free.car = NIL; cell->payload.free.cdr = freelist; freelist.page = initialised_cons_pages; @@ -91,10 +90,10 @@ void make_cons_page() initialised_cons_pages++; } else { - fprintf(stderr, - "FATAL: Failed to allocate memory for cons page %d\n", - initialised_cons_pages); - exit(1); + fprintf( stderr, + "FATAL: Failed to allocate memory for cons page %d\n", + initialised_cons_pages ); + exit( 1 ); } } @@ -102,14 +101,13 @@ void make_cons_page() /** * dump the allocated pages to this output stream. */ -void dump_pages(FILE * output) -{ - for (int i = 0; i < initialised_cons_pages; i++) { - fprintf(output, "\nDUMPING PAGE %d\n", i); +void dump_pages( FILE * output ) { + for ( int i = 0; i < initialised_cons_pages; i++ ) { + fprintf( output, "\nDUMPING PAGE %d\n", i ); - for (int j = 0; j < CONSPAGESIZE; j++) { - dump_object(output, (struct cons_pointer) { - i, j}); + for ( int j = 0; j < CONSPAGESIZE; j++ ) { + dump_object( output, ( struct cons_pointer ) { + i, j} ); } } } @@ -120,25 +118,24 @@ void dump_pages(FILE * output) * * @pointer the cell to free */ -void free_cell(struct cons_pointer pointer) -{ - struct cons_space_object *cell = &pointer2cell(pointer); +void free_cell( struct cons_pointer pointer ) { + struct cons_space_object *cell = &pointer2cell( pointer ); - if (!check_tag(pointer, FREETAG)) { - if (cell->count == 0) { - strncpy(&cell->tag.bytes[0], FREETAG, 4); + if ( !check_tag( pointer, FREETAG ) ) { + if ( cell->count == 0 ) { + strncpy( &cell->tag.bytes[0], FREETAG, 4 ); cell->payload.free.car = NIL; cell->payload.free.cdr = freelist; freelist = pointer; } else { - fprintf(stderr, - "Attempt to free cell with %d dangling references at page %d, offset %d\n", - cell->count, pointer.page, pointer.offset); + fprintf( stderr, + "Attempt to free cell with %d dangling references at page %d, offset %d\n", + cell->count, pointer.page, pointer.offset ); } } else { - fprintf(stderr, - "Attempt to free cell which is already FREE at page %d, offset %d\n", - pointer.page, pointer.offset); + fprintf( stderr, + "Attempt to free cell which is already FREE at page %d, offset %d\n", + pointer.page, pointer.offset ); } } @@ -149,31 +146,30 @@ void free_cell(struct cons_pointer pointer) * @param tag the tag of the cell to allocate - must be a valid cons space tag. * @return the cons pointer which refers to the cell allocated. */ -struct cons_pointer allocate_cell(char *tag) -{ +struct cons_pointer allocate_cell( char *tag ) { struct cons_pointer result = freelist; - if (result.page == NIL.page && result.offset == NIL.offset) { - make_cons_page(); - result = allocate_cell(tag); + if ( result.page == NIL.page && result.offset == NIL.offset ) { + make_cons_page( ); + result = allocate_cell( tag ); } else { - struct cons_space_object *cell = &pointer2cell(result); + struct cons_space_object *cell = &pointer2cell( result ); - if (strncmp(&cell->tag.bytes[0], FREETAG, TAGLENGTH) == 0) { + if ( strncmp( &cell->tag.bytes[0], FREETAG, TAGLENGTH ) == 0 ) { freelist = cell->payload.free.cdr; - strncpy(&cell->tag.bytes[0], tag, 4); + strncpy( &cell->tag.bytes[0], tag, 4 ); cell->count = 0; cell->payload.cons.car = NIL; cell->payload.cons.cdr = NIL; - fprintf(stderr, - "Allocated cell of type '%s' at %d, %d \n", tag, - result.page, result.offset); - dump_object(stderr, result); + fprintf( stderr, + "Allocated cell of type '%s' at %d, %d \n", tag, + result.page, result.offset ); + dump_object( stderr, result ); } else { - fprintf(stderr, "WARNING: Allocating non-free cell!"); + fprintf( stderr, "WARNING: Allocating non-free cell!" ); } } @@ -183,17 +179,16 @@ struct cons_pointer allocate_cell(char *tag) /** * initialise the cons page system; to be called exactly once during startup. */ -void initialise_cons_pages() -{ - if (conspageinitihasbeencalled == false) { - for (int i = 0; i < NCONSPAGES; i++) { - conspages[i] = (struct cons_page *) NULL; +void initialise_cons_pages( ) { + if ( conspageinitihasbeencalled == false ) { + for ( int i = 0; i < NCONSPAGES; i++ ) { + conspages[i] = ( struct cons_page * ) NULL; } - make_cons_page(); + make_cons_page( ); conspageinitihasbeencalled = true; } else { - fprintf(stderr, - "WARNING: conspageinit() called a second or subsequent time\n"); + fprintf( stderr, + "WARNING: conspageinit() called a second or subsequent time\n" ); } } diff --git a/src/conspage.h b/src/conspage.h index 4dba5c8..0dfff8f 100644 --- a/src/conspage.h +++ b/src/conspage.h @@ -43,7 +43,7 @@ extern struct cons_page *conspages[NCONSPAGES]; * * @pointer the cell to free */ -void free_cell(struct cons_pointer pointer); +void free_cell( struct cons_pointer pointer ); /** * Allocates a cell with the specified tag. Dangerous, primitive, low @@ -52,16 +52,16 @@ void free_cell(struct cons_pointer pointer); * @param tag the tag of the cell to allocate - must be a valid cons space tag. * @return the cons pointer which refers to the cell allocated. */ -struct cons_pointer allocate_cell(char *tag); +struct cons_pointer allocate_cell( char *tag ); /** * initialise the cons page system; to be called exactly once during startup. */ -void initialise_cons_pages(); +void initialise_cons_pages( ); /** * dump the allocated pages to this output stream. */ -void dump_pages(FILE * output); +void dump_pages( FILE * output ); #endif diff --git a/src/consspaceobject.c b/src/consspaceobject.c index 7d0312b..a75dbd2 100644 --- a/src/consspaceobject.c +++ b/src/consspaceobject.c @@ -23,10 +23,9 @@ /** * Check that the tag on the cell at this pointer is this tag */ -int check_tag(struct cons_pointer pointer, char *tag) -{ - struct cons_space_object cell = pointer2cell(pointer); - return strncmp(&cell.tag.bytes[0], tag, TAGLENGTH) == 0; +int check_tag( struct cons_pointer pointer, char *tag ) { + struct cons_space_object cell = pointer2cell( pointer ); + return strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; } /** @@ -35,11 +34,10 @@ int check_tag(struct cons_pointer pointer, char *tag) * You can't roll over the reference count. Once it hits the maximum * value you cannot increment further. */ -void inc_ref(struct cons_pointer pointer) -{ - struct cons_space_object *cell = &pointer2cell(pointer); +void inc_ref( struct cons_pointer pointer ) { + struct cons_space_object *cell = &pointer2cell( pointer ); - if (cell->count < MAXREFERENCE) { + if ( cell->count < MAXREFERENCE ) { cell->count++; } } @@ -50,15 +48,14 @@ void inc_ref(struct cons_pointer pointer) * If a count has reached MAXREFERENCE it cannot be decremented. * If a count is decremented to zero the cell should be freed. */ -void dec_ref(struct cons_pointer pointer) -{ - struct cons_space_object *cell = &pointer2cell(pointer); +void dec_ref( struct cons_pointer pointer ) { + struct cons_space_object *cell = &pointer2cell( pointer ); - if (cell->count <= MAXREFERENCE) { + if ( cell->count <= MAXREFERENCE ) { cell->count--; - if (cell->count == 0) { - free_cell(pointer); + if ( cell->count == 0 ) { + free_cell( pointer ); } } } @@ -66,54 +63,55 @@ void dec_ref(struct cons_pointer pointer) /** * dump the object at this cons_pointer to this output stream. */ -void dump_object(FILE * output, struct cons_pointer pointer) -{ - struct cons_space_object cell = pointer2cell(pointer); - fwprintf(output, - L"\tDumping %c%c%c%c (%d) at page %d, offset %d count %u\n", - cell.tag.bytes[0], - cell.tag.bytes[1], - cell.tag.bytes[2], - cell.tag.bytes[3], - cell.tag.value, pointer.page, pointer.offset, cell.count); +void dump_object( FILE * output, struct cons_pointer pointer ) { + struct cons_space_object cell = pointer2cell( pointer ); + fwprintf( output, + L"\tDumping %c%c%c%c (%d) at page %d, offset %d count %u\n", + cell.tag.bytes[0], + cell.tag.bytes[1], + cell.tag.bytes[2], + cell.tag.bytes[3], + cell.tag.value, pointer.page, pointer.offset, cell.count ); - if (check_tag(pointer, CONSTAG)) { - fwprintf(output, - L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d\n", - cell.payload.cons.car.page, - cell.payload.cons.car.offset, - cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset); - } else if (check_tag(pointer, INTEGERTAG)) { - fwprintf(output, - L"\t\tInteger cell: value %ld\n", cell.payload.integer.value); - } else if (check_tag(pointer, FREETAG)) { - fwprintf(output, L"\t\tFree cell: next at page %d offset %d\n", - cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset); - } else if (check_tag(pointer, REALTAG)) { - fwprintf(output, L"\t\tReal cell: value %Lf\n", - cell.payload.real.value); - } else if (check_tag(pointer, STRINGTAG)) { - fwprintf(output, - L"String cell: character '%1c' (%1d) next at page %2d offset %3d\n", - cell.payload.string.character, - cell.payload.string.cdr.page, cell.payload.string.cdr.offset); + if ( check_tag( pointer, CONSTAG ) ) { + fwprintf( output, + L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d\n", + cell.payload.cons.car.page, + cell.payload.cons.car.offset, + cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); + } else if ( check_tag( pointer, INTEGERTAG ) ) { + fwprintf( output, + L"\t\tInteger cell: value %ld\n", + cell.payload.integer.value ); + } else if ( check_tag( pointer, FREETAG ) ) { + fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", + cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); + } else if ( check_tag( pointer, REALTAG ) ) { + fwprintf( output, L"\t\tReal cell: value %Lf\n", + cell.payload.real.value ); + } else if ( check_tag( pointer, STRINGTAG ) ) { + fwprintf( output, + L"String cell: character '%1c' (%1d) next at page %2d offset %3d\n", + cell.payload.string.character, + cell.payload.string.cdr.page, + cell.payload.string.cdr.offset ); } } /** * Construct a cons cell from this pair of pointers. */ -struct cons_pointer make_cons(struct cons_pointer car, struct cons_pointer cdr) -{ +struct cons_pointer make_cons( struct cons_pointer car, + struct cons_pointer cdr ) { struct cons_pointer pointer = NIL; - pointer = allocate_cell(CONSTAG); + pointer = allocate_cell( CONSTAG ); struct cons_space_object *cell = &conspages[pointer.page]->cell[pointer.offset]; - inc_ref(car); - inc_ref(cdr); + inc_ref( car ); + inc_ref( cdr ); cell->payload.cons.car = car; cell->payload.cons.cdr = cdr; @@ -124,11 +122,10 @@ struct cons_pointer make_cons(struct cons_pointer car, struct cons_pointer cdr) * Construct a cell which points to an executable Lisp special form. */ struct cons_pointer -make_function(struct cons_pointer src, struct cons_pointer (*executable) - (struct stack_frame *, struct cons_pointer)) -{ - struct cons_pointer pointer = allocate_cell(FUNCTIONTAG); - struct cons_space_object *cell = &pointer2cell(pointer); +make_function( struct cons_pointer src, struct cons_pointer ( *executable ) + ( struct stack_frame *, struct cons_pointer ) ) { + struct cons_pointer pointer = allocate_cell( FUNCTIONTAG ); + struct cons_space_object *cell = &pointer2cell( pointer ); cell->payload.function.source = src; cell->payload.function.executable = executable; @@ -143,22 +140,21 @@ make_function(struct cons_pointer src, struct cons_pointer (*executable) * pointer to next is NIL. */ struct cons_pointer -make_string_like_thing(wint_t c, struct cons_pointer tail, char *tag) -{ +make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) { struct cons_pointer pointer = NIL; - if (check_tag(tail, tag) || check_tag(tail, NILTAG)) { - pointer = allocate_cell(tag); - struct cons_space_object *cell = &pointer2cell(pointer); + if ( check_tag( tail, tag ) || check_tag( tail, NILTAG ) ) { + pointer = allocate_cell( tag ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref(tail); + inc_ref( tail ); cell->payload.string.character = c; cell->payload.string.cdr.page = tail.page; cell->payload.string.cdr.offset = tail.offset; } else { - fwprintf(stderr, - L"Warning: only NIL and %s can be appended to %s\n", - tag, tag); + fwprintf( stderr, + L"Warning: only NIL and %s can be appended to %s\n", + tag, tag ); } return pointer; @@ -170,24 +166,22 @@ make_string_like_thing(wint_t c, struct cons_pointer tail, char *tag) * has one character and a pointer to the next; in the last cell the * pointer to next is NIL. */ -struct cons_pointer make_string(wint_t c, struct cons_pointer tail) -{ - return make_string_like_thing(c, tail, STRINGTAG); +struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) { + return make_string_like_thing( c, tail, STRINGTAG ); } /** * Construct a symbol from this character and this tail. */ -struct cons_pointer make_symbol(wint_t c, struct cons_pointer tail) -{ - return make_string_like_thing(c, tail, SYMBOLTAG); +struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) { + return make_string_like_thing( c, tail, SYMBOLTAG ); } /** * Construct a cell which points to an executable Lisp special form. */ struct cons_pointer -make_special(struct cons_pointer src, struct cons_pointer (*executable) +make_special( struct cons_pointer src, struct cons_pointer ( *executable ) @@ -196,11 +190,10 @@ make_special(struct cons_pointer src, struct cons_pointer (*executable) - (struct cons_pointer s_expr, - struct cons_pointer env, struct stack_frame * frame)) -{ - struct cons_pointer pointer = allocate_cell(SPECIALTAG); - struct cons_space_object *cell = &pointer2cell(pointer); + ( struct cons_pointer s_expr, + struct cons_pointer env, struct stack_frame * frame ) ) { + struct cons_pointer pointer = allocate_cell( SPECIALTAG ); + struct cons_space_object *cell = &pointer2cell( pointer ); cell->payload.special.source = src; cell->payload.special.executable = executable; @@ -211,12 +204,11 @@ make_special(struct cons_pointer src, struct cons_pointer (*executable) /** * Return a lisp string representation of this old skool ASCII string. */ -struct cons_pointer c_string_to_lisp_string(char *string) -{ +struct cons_pointer c_string_to_lisp_string( char *string ) { struct cons_pointer result = NIL; - for (int i = strlen(string); i > 0; i--) { - result = make_string((wint_t) string[i - 1], result); + for ( int i = strlen( string ); i > 0; i-- ) { + result = make_string( ( wint_t ) string[i - 1], result ); } return result; @@ -225,12 +217,11 @@ struct cons_pointer c_string_to_lisp_string(char *string) /** * Return a lisp symbol representation of this old skool ASCII string. */ -struct cons_pointer c_string_to_lisp_symbol(char *symbol) -{ +struct cons_pointer c_string_to_lisp_symbol( char *symbol ) { struct cons_pointer result = NIL; - for (int i = strlen(symbol); i > 0; i--) { - result = make_symbol((wint_t) symbol[i - 1], result); + for ( int i = strlen( symbol ); i > 0; i-- ) { + result = make_symbol( ( wint_t ) symbol[i - 1], result ); } return result; diff --git a/src/consspaceobject.h b/src/consspaceobject.h index ccba8df..3b8c9fa 100644 --- a/src/consspaceobject.h +++ b/src/consspaceobject.h @@ -246,8 +246,8 @@ struct cons_payload { */ struct function_payload { struct cons_pointer source; - struct cons_pointer (*executable) (struct stack_frame *, - struct cons_pointer); + struct cons_pointer ( *executable ) ( struct stack_frame *, + struct cons_pointer ); }; /** @@ -290,9 +290,9 @@ struct real_payload { */ struct special_payload { struct cons_pointer source; - struct cons_pointer (*executable) (struct cons_pointer s_expr, - struct cons_pointer env, - struct stack_frame * frame); + struct cons_pointer ( *executable ) ( struct cons_pointer s_expr, + struct cons_pointer env, + struct stack_frame * frame ); }; /** @@ -393,31 +393,31 @@ struct cons_space_object { /** * Check that the tag on the cell at this pointer is this tag */ -int check_tag(struct cons_pointer pointer, char *tag); +int check_tag( struct cons_pointer pointer, char *tag ); /** * increment the reference count of the object at this cons pointer */ -void inc_ref(struct cons_pointer pointer); +void inc_ref( struct cons_pointer pointer ); /** * decrement the reference count of the object at this cons pointer */ -void dec_ref(struct cons_pointer pointer); +void dec_ref( struct cons_pointer pointer ); /** * dump the object at this cons_pointer to this output stream. */ -void dump_object(FILE * output, struct cons_pointer pointer); +void dump_object( FILE * output, struct cons_pointer pointer ); -struct cons_pointer make_cons(struct cons_pointer car, - struct cons_pointer cdr); +struct cons_pointer make_cons( struct cons_pointer car, + struct cons_pointer cdr ); /** * Construct a cell which points to an executable Lisp special form. */ -struct cons_pointer make_function(struct cons_pointer src, - struct cons_pointer (*executable) +struct cons_pointer make_function( struct cons_pointer src, + struct cons_pointer ( *executable ) @@ -426,14 +426,14 @@ struct cons_pointer make_function(struct cons_pointer src, - (struct stack_frame *, - struct cons_pointer)); + ( struct stack_frame *, + struct cons_pointer ) ); /** * Construct a cell which points to an executable Lisp special form. */ -struct cons_pointer make_special(struct cons_pointer src, - struct cons_pointer (*executable) +struct cons_pointer make_special( struct cons_pointer src, + struct cons_pointer ( *executable ) @@ -442,31 +442,31 @@ struct cons_pointer make_special(struct cons_pointer src, - (struct cons_pointer s_expr, - struct cons_pointer env, - struct stack_frame * frame)); + ( struct cons_pointer s_expr, + struct cons_pointer env, + struct stack_frame * frame ) ); /** * Construct a string from this character and this tail. A string is * implemented as a flat list of cells each of which has one character and a * pointer to the next; in the last cell the pointer to next is NIL. */ -struct cons_pointer make_string(wint_t c, struct cons_pointer tail); +struct cons_pointer make_string( wint_t c, struct cons_pointer tail ); /** * Construct a symbol from this character and this tail. A symbol is identical * to a string except for having a different tag. */ -struct cons_pointer make_symbol(wint_t c, struct cons_pointer tail); +struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ); /** * Return a lisp string representation of this old skool ASCII string. */ -struct cons_pointer c_string_to_lisp_string(char *string); +struct cons_pointer c_string_to_lisp_string( char *string ); /** * Return a lisp symbol representation of this old skool ASCII string. */ -struct cons_pointer c_string_to_lisp_symbol(char *symbol); +struct cons_pointer c_string_to_lisp_symbol( char *symbol ); #endif diff --git a/src/equal.c b/src/equal.c index 8814ea8..2a20d5e 100644 --- a/src/equal.c +++ b/src/equal.c @@ -18,27 +18,26 @@ * Shallow, and thus cheap, equality: true if these two objects are * the same object, else false. */ -bool eq(struct cons_pointer a, struct cons_pointer b) -{ - return ((a.page == b.page) && (a.offset == b.offset)); +bool eq( struct cons_pointer a, struct cons_pointer b ) { + return ( ( a.page == b.page ) && ( a.offset == b.offset ) ); } /** * Deep, and thus expensive, equality: true if these two objects have * identical structure, else false. */ -bool equal(struct cons_pointer a, struct cons_pointer b) -{ - bool result = eq(a, b); +bool equal( struct cons_pointer a, struct cons_pointer b ) { + bool result = eq( a, b ); - if (!result) { - struct cons_space_object *cell_a = &pointer2cell(a); - struct cons_space_object *cell_b = &pointer2cell(b); + if ( !result ) { + struct cons_space_object *cell_a = &pointer2cell( a ); + struct cons_space_object *cell_b = &pointer2cell( b ); - if (consp(a) && consp(b)) { - result = equal(cell_a->payload.cons.car, cell_b->payload.cons.car) - && equal(cell_a->payload.cons.cdr, cell_b->payload.cons.cdr); - } else if (stringp(a) && stringp(b)) { + if ( consp( a ) && consp( b ) ) { + result = + equal( cell_a->payload.cons.car, cell_b->payload.cons.car ) + && equal( cell_a->payload.cons.cdr, cell_b->payload.cons.cdr ); + } else if ( stringp( a ) && stringp( b ) ) { /* * slightly complex because a string may or may not have a '\0' * cell at the end, but I'll ignore that for now. I think in @@ -47,17 +46,18 @@ bool equal(struct cons_pointer a, struct cons_pointer b) result = cell_a->payload.string.character == cell_b->payload.string.character - && equal(cell_a->payload.string.cdr, - cell_b->payload.string.cdr); - } else if (numberp(a) && numberp(b)) { - double num_a = numeric_value(a); - double num_b = numeric_value(b); - double max = fabs(num_a) > fabs(num_b) ? fabs(num_a) : fabs(num_b); + && equal( cell_a->payload.string.cdr, + cell_b->payload.string.cdr ); + } else if ( numberp( a ) && numberp( b ) ) { + double num_a = numeric_value( a ); + double num_b = numeric_value( b ); + double max = + fabs( num_a ) > fabs( num_b ) ? fabs( num_a ) : fabs( num_b ); /* * not more different than one part in a million - close enough */ - result = fabs(num_a - num_b) < (max / 1000000.0); + result = fabs( num_a - num_b ) < ( max / 1000000.0 ); } /* * there's only supposed ever to be one T and one NIL cell, so each diff --git a/src/equal.h b/src/equal.h index 796b983..1f27104 100644 --- a/src/equal.h +++ b/src/equal.h @@ -19,12 +19,12 @@ * Shallow, and thus cheap, equality: true if these two objects are * the same object, else false. */ -bool eq(struct cons_pointer a, struct cons_pointer b); +bool eq( struct cons_pointer a, struct cons_pointer b ); /** * Deep, and thus expensive, equality: true if these two objects have * identical structure, else false. */ -bool equal(struct cons_pointer a, struct cons_pointer b); +bool equal( struct cons_pointer a, struct cons_pointer b ); #endif diff --git a/src/init.c b/src/init.c index 38d03c8..3681e25 100644 --- a/src/init.c +++ b/src/init.c @@ -21,14 +21,13 @@ #include "lispops.h" #include "repl.h" -void bind_function(char *name, struct cons_pointer (*executable) - (struct stack_frame *, struct cons_pointer)) -{ - deep_bind(intern(c_string_to_lisp_symbol(name), oblist), - make_function(NIL, executable)); +void bind_function( char *name, struct cons_pointer ( *executable ) + ( struct stack_frame *, struct cons_pointer ) ) { + deep_bind( intern( c_string_to_lisp_symbol( name ), oblist ), + make_function( NIL, executable ) ); } -void bind_special(char *name, struct cons_pointer (*executable) +void bind_special( char *name, struct cons_pointer ( *executable ) @@ -37,27 +36,25 @@ void bind_special(char *name, struct cons_pointer (*executable) - (struct cons_pointer s_expr, struct cons_pointer env, - struct stack_frame * frame)) -{ - deep_bind(intern(c_string_to_lisp_symbol(name), oblist), - make_special(NIL, executable)); + ( struct cons_pointer s_expr, struct cons_pointer env, + struct stack_frame * frame ) ) { + deep_bind( intern( c_string_to_lisp_symbol( name ), oblist ), + make_special( NIL, executable ) ); } -int main(int argc, char *argv[]) -{ +int main( int argc, char *argv[] ) { /* * attempt to set wide character acceptance on all streams */ - fwide(stdin, 1); - fwide(stdout, 1); - fwide(stderr, 1); + fwide( stdin, 1 ); + fwide( stdout, 1 ); + fwide( stderr, 1 ); int option; bool dump_at_end = false; bool show_prompt = false; - while ((option = getopt(argc, argv, "pd")) != -1) { - switch (option) { + while ( ( option = getopt( argc, argv, "pd" ) ) != -1 ) { + switch ( option ) { case 'd': dump_at_end = true; break; @@ -65,49 +62,50 @@ int main(int argc, char *argv[]) show_prompt = true; break; default: - fprintf(stderr, "Unexpected option %c\n", option); + fprintf( stderr, "Unexpected option %c\n", option ); break; } } - if (show_prompt) { - fprintf(stdout, - "Post scarcity software environment version %s\n\n", VERSION); + if ( show_prompt ) { + fprintf( stdout, + "Post scarcity software environment version %s\n\n", + VERSION ); } - initialise_cons_pages(); + initialise_cons_pages( ); /* * privileged variables (keywords) */ - deep_bind(intern(c_string_to_lisp_string("nil"), oblist), NIL); - deep_bind(intern(c_string_to_lisp_string("t"), oblist), TRUE); + deep_bind( intern( c_string_to_lisp_string( "nil" ), oblist ), NIL ); + deep_bind( intern( c_string_to_lisp_string( "t" ), oblist ), TRUE ); /* * primitive function operations */ - bind_function("assoc", &lisp_assoc); - bind_function("car", &lisp_car); - bind_function("cdr", &lisp_cdr); - bind_function("cons", &lisp_cons); - bind_function("eq", &lisp_eq); - bind_function("equal", &lisp_equal); - bind_function("read", &lisp_read); - bind_function("print", &lisp_print); + bind_function( "assoc", &lisp_assoc ); + bind_function( "car", &lisp_car ); + bind_function( "cdr", &lisp_cdr ); + bind_function( "cons", &lisp_cons ); + bind_function( "eq", &lisp_eq ); + bind_function( "equal", &lisp_equal ); + bind_function( "read", &lisp_read ); + bind_function( "print", &lisp_print ); /* * primitive special forms */ - bind_special("apply", &lisp_apply); - bind_special("eval", &lisp_eval); - bind_special("quote", &lisp_quote); + bind_special( "apply", &lisp_apply ); + bind_special( "eval", &lisp_eval ); + bind_special( "quote", &lisp_quote ); - repl(stdin, stdout, stderr, show_prompt); + repl( stdin, stdout, stderr, show_prompt ); // print( stdout, lisp_eval( input, oblist, NULL)); - if (dump_at_end) { - dump_pages(stderr); + if ( dump_at_end ) { + dump_pages( stderr ); } - return (0); + return ( 0 ); } diff --git a/src/integer.c b/src/integer.c index b15541a..ad128ee 100644 --- a/src/integer.c +++ b/src/integer.c @@ -9,6 +9,7 @@ #define _GNU_SOURCE #include +#include #include "conspage.h" #include "consspaceobject.h" @@ -19,14 +20,13 @@ * as a cons-space object. Cell may in principle be any kind of number, * but only integers and reals are so far implemented. */ -double numeric_value(struct cons_pointer pointer) -{ +double numeric_value( struct cons_pointer pointer ) { double result = NAN; - struct cons_space_object *cell = &pointer2cell(pointer); + struct cons_space_object *cell = &pointer2cell( pointer ); - if (integerp(pointer)) { - result = (double) cell->payload.integer.value; - } else if (realp(pointer)) { + if ( integerp( pointer ) ) { + result = cell->payload.integer.value * 1.0; + } else if ( realp( pointer ) ) { result = cell->payload.real.value; } @@ -36,11 +36,12 @@ double numeric_value(struct cons_pointer pointer) /** * Allocate an integer cell representing this value and return a cons pointer to it. */ -struct cons_pointer make_integer(int value) -{ - struct cons_pointer result = allocate_cell(INTEGERTAG); - struct cons_space_object *cell = &pointer2cell(result); +struct cons_pointer make_integer( long int value ) { + struct cons_pointer result = allocate_cell( INTEGERTAG ); + struct cons_space_object *cell = &pointer2cell( result ); cell->payload.integer.value = value; + dump_object( stderr, result); + return result; } diff --git a/src/integer.h b/src/integer.h index a8cb101..e3e8c3b 100644 --- a/src/integer.h +++ b/src/integer.h @@ -11,11 +11,11 @@ #ifndef __integer_h #define __integer_h -double numeric_value(struct cons_pointer pointer); +double numeric_value( struct cons_pointer pointer ); /** * Allocate an integer cell representing this value and return a cons pointer to it. */ -struct cons_pointer make_integer(int value); +struct cons_pointer make_integer( long int value ); #endif diff --git a/src/intern.c b/src/intern.c index b71a4d1..31b7e2e 100644 --- a/src/intern.c +++ b/src/intern.c @@ -44,17 +44,16 @@ struct cons_pointer oblist = NIL; * will work); otherwise return NIL. */ struct cons_pointer -internedp(struct cons_pointer key, struct cons_pointer store) -{ +internedp( struct cons_pointer key, struct cons_pointer store ) { struct cons_pointer result = NIL; - for (struct cons_pointer next = store; - nilp(result) && consp(next); - next = pointer2cell(next).payload.cons.cdr) { + for ( struct cons_pointer next = store; + nilp( result ) && consp( next ); + next = pointer2cell( next ).payload.cons.cdr ) { struct cons_space_object entry = - pointer2cell(pointer2cell(next).payload.cons.car); + pointer2cell( pointer2cell( next ).payload.cons.car ); - if (equal(key, entry.payload.cons.car)) { + if ( equal( key, entry.payload.cons.car ) ) { result = entry.payload.cons.car; } } @@ -70,16 +69,16 @@ internedp(struct cons_pointer key, struct cons_pointer store) * If this key is lexically identical to a key in this store, return the value * of that key from the store; otherwise return NIL. */ -struct cons_pointer c_assoc(struct cons_pointer key, struct cons_pointer store) -{ +struct cons_pointer c_assoc( struct cons_pointer key, + struct cons_pointer store ) { struct cons_pointer result = NIL; - for (struct cons_pointer next = store; - consp(next); next = pointer2cell(next).payload.cons.cdr) { + for ( struct cons_pointer next = store; + consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { struct cons_space_object entry = - pointer2cell(pointer2cell(next).payload.cons.car); + pointer2cell( pointer2cell( next ).payload.cons.car ); - if (equal(key, entry.payload.cons.car)) { + if ( equal( key, entry.payload.cons.car ) ) { result = entry.payload.cons.cdr; break; } @@ -93,10 +92,9 @@ struct cons_pointer c_assoc(struct cons_pointer key, struct cons_pointer store) * with this key/value pair added to the front. */ struct cons_pointer -bind(struct cons_pointer key, struct cons_pointer value, - struct cons_pointer store) -{ - return make_cons(make_cons(key, value), store); +bind( struct cons_pointer key, struct cons_pointer value, + struct cons_pointer store ) { + return make_cons( make_cons( key, value ), store ); } /** @@ -105,9 +103,8 @@ bind(struct cons_pointer key, struct cons_pointer value, * there it may not be especially useful). */ struct cons_pointer -deep_bind(struct cons_pointer key, struct cons_pointer value) -{ - oblist = bind(key, value, oblist); +deep_bind( struct cons_pointer key, struct cons_pointer value ) { + oblist = bind( key, value, oblist ); return oblist; } @@ -117,16 +114,15 @@ deep_bind(struct cons_pointer key, struct cons_pointer value) * with the value NIL. */ struct cons_pointer -intern(struct cons_pointer key, struct cons_pointer environment) -{ +intern( struct cons_pointer key, struct cons_pointer environment ) { struct cons_pointer result = environment; - struct cons_pointer canonical = internedp(key, environment); + struct cons_pointer canonical = internedp( key, environment ); - if (nilp(canonical)) { + if ( nilp( canonical ) ) { /* * not currently bound */ - result = bind(key, NIL, environment); + result = bind( key, NIL, environment ); } return result; diff --git a/src/intern.h b/src/intern.h index 98cc001..e940daa 100644 --- a/src/intern.h +++ b/src/intern.h @@ -27,37 +27,38 @@ extern struct cons_pointer oblist; * implementation a store is just an assoc list, but in future it might be a * namespace, a regularity or a homogeneity. */ -struct cons_pointer c_assoc(struct cons_pointer key, - struct cons_pointer store); +struct cons_pointer c_assoc( struct cons_pointer key, + struct cons_pointer store ); /** * Return true if this key is present as a key in this enviroment, defaulting to * the oblist if no environment is passed. */ -struct cons_pointer internedp(struct cons_pointer key, - struct cons_pointer environment); +struct cons_pointer internedp( struct cons_pointer key, + struct cons_pointer environment ); /** * Return a new key/value store containing all the key/value pairs in this store * with this key/value pair added to the front. */ -struct cons_pointer bind(struct cons_pointer key, - struct cons_pointer value, struct cons_pointer store); +struct cons_pointer bind( struct cons_pointer key, + struct cons_pointer value, + struct cons_pointer store ); /** * Binds this key to this value in the global oblist, but doesn't affect the * current environment. May not be useful except in bootstrapping (and even * there it may not be especially useful). */ -struct cons_pointer deep_bind(struct cons_pointer key, - struct cons_pointer value); +struct cons_pointer deep_bind( struct cons_pointer key, + struct cons_pointer value ); /** * Ensure that a canonical copy of this key is bound in this environment, and * return that canonical copy. If there is currently no such binding, create one * with the value NIL. */ -struct cons_pointer intern(struct cons_pointer key, - struct cons_pointer environment); +struct cons_pointer intern( struct cons_pointer key, + struct cons_pointer environment ); #endif diff --git a/src/lispops.c b/src/lispops.c index 9748797..85ec7eb 100644 --- a/src/lispops.c +++ b/src/lispops.c @@ -49,12 +49,11 @@ /** * Implementation of car in C. If arg is not a cons, does not error but returns nil. */ -struct cons_pointer c_car(struct cons_pointer arg) -{ +struct cons_pointer c_car( struct cons_pointer arg ) { struct cons_pointer result = NIL; - if (consp(arg)) { - result = pointer2cell(arg).payload.cons.car; + if ( consp( arg ) ) { + result = pointer2cell( arg ).payload.cons.car; } return result; @@ -63,12 +62,11 @@ struct cons_pointer c_car(struct cons_pointer arg) /** * Implementation of cdr in C. If arg is not a cons, does not error but returns nil. */ -struct cons_pointer c_cdr(struct cons_pointer arg) -{ +struct cons_pointer c_cdr( struct cons_pointer arg ) { struct cons_pointer result = NIL; - if (consp(arg)) { - result = pointer2cell(arg).payload.cons.cdr; + if ( consp( arg ) ) { + result = pointer2cell( arg ).payload.cons.cdr; } return result; @@ -81,33 +79,33 @@ struct cons_pointer c_cdr(struct cons_pointer arg) * and if so how it differs from eval. */ struct cons_pointer -lisp_apply(struct cons_pointer args, struct cons_pointer env, - struct stack_frame *frame) -{ +lisp_apply( struct cons_pointer args, struct cons_pointer env, + struct stack_frame *frame ) { struct cons_pointer result = args; - if (consp(args)) { - lisp_eval(args, env, frame); + if ( consp( args ) ) { + lisp_eval( args, env, frame ); } return result; } struct cons_pointer -eval_cons(struct cons_pointer s_expr, struct cons_pointer env, - struct stack_frame *my_frame) -{ +eval_cons( struct cons_pointer s_expr, struct cons_pointer env, + struct stack_frame *my_frame ) { struct cons_pointer result = NIL; - struct cons_pointer fn_pointer = lisp_eval(c_car(s_expr), env, my_frame); - struct cons_space_object fn_cell = pointer2cell(fn_pointer); - struct cons_pointer args = c_cdr(s_expr); + struct cons_pointer fn_pointer = + lisp_eval( c_car( s_expr ), env, my_frame ); + struct cons_space_object fn_cell = pointer2cell( fn_pointer ); + struct cons_pointer args = c_cdr( s_expr ); - switch (fn_cell.tag.value) { + switch ( fn_cell.tag.value ) { case SPECIALTV: { - struct cons_space_object special = pointer2cell(fn_pointer); + struct cons_space_object special = pointer2cell( fn_pointer ); result = - (*special.payload.special.executable) (args, env, my_frame); + ( *special.payload.special.executable ) ( args, env, + my_frame ); } break; @@ -116,30 +114,31 @@ eval_cons(struct cons_pointer s_expr, struct cons_pointer env, * actually, this is apply */ { - struct cons_space_object function = pointer2cell(fn_pointer); - struct stack_frame *frame = make_stack_frame(my_frame, args, env); + struct cons_space_object function = pointer2cell( fn_pointer ); + struct stack_frame *frame = + make_stack_frame( my_frame, args, env ); /* * the trick: pass the remaining arguments and environment to the * executable code which is the payload of the function object. */ - result = (*function.payload.function.executable) (frame, env); - free_stack_frame(frame); + result = ( *function.payload.function.executable ) ( frame, env ); + free_stack_frame( frame ); } break; default: { - char *buffer = malloc(1024); - memset(buffer, '\0', 1024); - sprintf(buffer, - "Unexpected cell with tag %d (%c%c%c%c) in function position", - 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, my_frame); + char *buffer = malloc( 1024 ); + memset( buffer, '\0', 1024 ); + sprintf( buffer, + "Unexpected cell with tag %d (%c%c%c%c) in function position", + 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, my_frame ); } } @@ -160,29 +159,32 @@ eval_cons(struct cons_pointer s_expr, struct cons_pointer env, * If a special form, passes the cdr of s_expr to the special form as argument. */ struct cons_pointer -lisp_eval(struct cons_pointer s_expr, struct cons_pointer env, - struct stack_frame *previous) -{ +lisp_eval( struct cons_pointer s_expr, struct cons_pointer env, + struct stack_frame *previous ) { struct cons_pointer result = s_expr; - struct cons_space_object cell = pointer2cell(s_expr); - struct stack_frame *my_frame = - make_stack_frame(previous, make_cons(s_expr, NIL), env); + struct cons_space_object cell = pointer2cell( s_expr ); - switch (cell.tag.value) { + fprintf( stderr, "In eval; about to make stack frame" ); + + struct stack_frame *frame = make_stack_frame( previous, s_expr, env ); + + fprintf( stderr, "In eval; stack frame made" ); + + switch ( cell.tag.value ) { case CONSTV: - result = eval_cons(s_expr, env, my_frame); + result = eval_cons( s_expr, env, frame ); break; case SYMBOLTV: { - struct cons_pointer canonical = internedp(s_expr, env); - if (nilp(canonical)) { + struct cons_pointer canonical = internedp( s_expr, env ); + if ( nilp( canonical ) ) { struct cons_pointer message = c_string_to_lisp_string - ("Attempt to take value of unbound symbol."); - result = lisp_throw(message, my_frame); + ( "Attempt to take value of unbound symbol." ); + result = lisp_throw( message, frame ); } else { - result = c_assoc(canonical, env); + result = c_assoc( canonical, env ); } } break; @@ -195,7 +197,7 @@ lisp_eval(struct cons_pointer s_expr, struct cons_pointer env, */ } - free_stack_frame(my_frame); + free_stack_frame( frame ); return result; } @@ -208,10 +210,9 @@ lisp_eval(struct cons_pointer s_expr, struct cons_pointer env, * this isn't at this stage checked) unevaluated. */ struct cons_pointer -lisp_quote(struct cons_pointer args, struct cons_pointer env, - struct stack_frame *frame) -{ - return c_car(args); +lisp_quote( struct cons_pointer args, struct cons_pointer env, + struct stack_frame *frame ) { + return c_car( args ); } /** @@ -223,19 +224,19 @@ lisp_quote(struct cons_pointer args, struct cons_pointer env, * otherwise returns a new cons cell. */ struct cons_pointer -lisp_cons(struct stack_frame *frame, struct cons_pointer env) -{ +lisp_cons( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer car = frame->arg[0]; struct cons_pointer cdr = frame->arg[1]; struct cons_pointer result; - if (nilp(car) && nilp(cdr)) { + if ( nilp( car ) && nilp( cdr ) ) { return NIL; - } else if (stringp(car) && stringp(cdr) && - nilp(pointer2cell(car).payload.string.cdr)) { - result = make_string(pointer2cell(car).payload.string.character, cdr); + } else if ( stringp( car ) && stringp( cdr ) && + nilp( pointer2cell( car ).payload.string.cdr ) ) { + result = + make_string( pointer2cell( car ).payload.string.character, cdr ); } else { - result = make_cons(car, cdr); + result = make_cons( car, cdr ); } return result; @@ -247,20 +248,20 @@ lisp_cons(struct stack_frame *frame, struct cons_pointer env) * strings, and TODO read streams and other things which can be considered as sequences. */ struct cons_pointer -lisp_car(struct stack_frame *frame, struct cons_pointer env) -{ +lisp_car( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer result = NIL; - if (consp(frame->arg[0])) { - struct cons_space_object cell = pointer2cell(frame->arg[0]); + if ( consp( frame->arg[0] ) ) { + struct cons_space_object cell = pointer2cell( frame->arg[0] ); result = cell.payload.cons.car; - } else if (stringp(frame->arg[0])) { - struct cons_space_object cell = pointer2cell(frame->arg[0]); - result = make_string(cell.payload.string.character, NIL); + } else if ( stringp( frame->arg[0] ) ) { + struct cons_space_object cell = pointer2cell( frame->arg[0] ); + result = make_string( cell.payload.string.character, NIL ); } else { struct cons_pointer message = - c_string_to_lisp_string("Attempt to take CAR/CDR of non sequence"); - result = lisp_throw(message, frame); + c_string_to_lisp_string + ( "Attempt to take CAR/CDR of non sequence" ); + result = lisp_throw( message, frame ); } return result; @@ -272,20 +273,20 @@ lisp_car(struct stack_frame *frame, struct cons_pointer env) * strings, and TODO read streams and other things which can be considered as sequences. */ struct cons_pointer -lisp_cdr(struct stack_frame *frame, struct cons_pointer env) -{ +lisp_cdr( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer result = NIL; - if (consp(frame->arg[0])) { - struct cons_space_object cell = pointer2cell(frame->arg[0]); + if ( consp( frame->arg[0] ) ) { + struct cons_space_object cell = pointer2cell( frame->arg[0] ); result = cell.payload.cons.car; - } else if (stringp(frame->arg[0])) { - struct cons_space_object cell = pointer2cell(frame->arg[0]); + } else if ( stringp( frame->arg[0] ) ) { + struct cons_space_object cell = pointer2cell( frame->arg[0] ); result = cell.payload.string.cdr; } else { struct cons_pointer message = - c_string_to_lisp_string("Attempt to take CAR/CDR of non sequence"); - result = lisp_throw(message, frame); + c_string_to_lisp_string + ( "Attempt to take CAR/CDR of non sequence" ); + result = lisp_throw( message, frame ); } return result; @@ -296,18 +297,17 @@ lisp_cdr(struct stack_frame *frame, struct cons_pointer env) * Returns the value associated with key in store, or NIL if not found. */ struct cons_pointer -lisp_assoc(struct stack_frame *frame, struct cons_pointer env) -{ - return c_assoc(frame->arg[0], frame->arg[1]); +lisp_assoc( struct stack_frame *frame, struct cons_pointer env ) { + return c_assoc( frame->arg[0], frame->arg[1] ); } /** * (eq a b) * Returns T if a and b are pointers to the same object, else NIL */ -struct cons_pointer lisp_eq(struct stack_frame *frame, struct cons_pointer env) -{ - return eq(frame->arg[0], frame->arg[1]) ? TRUE : NIL; +struct cons_pointer lisp_eq( struct stack_frame *frame, + struct cons_pointer env ) { + return eq( frame->arg[0], frame->arg[1] ) ? TRUE : NIL; } /** @@ -315,9 +315,8 @@ struct cons_pointer lisp_eq(struct stack_frame *frame, struct cons_pointer env) * Returns T if a and b are pointers to structurally identical objects, else NIL */ struct cons_pointer -lisp_equal(struct stack_frame *frame, struct cons_pointer env) -{ - return equal(frame->arg[0], frame->arg[1]) ? TRUE : NIL; +lisp_equal( struct stack_frame *frame, struct cons_pointer env ) { + return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL; } /** @@ -327,15 +326,14 @@ lisp_equal(struct stack_frame *frame, struct cons_pointer env) * is a read stream, then read from that stream, else stdin. */ struct cons_pointer -lisp_read(struct stack_frame *frame, struct cons_pointer env) -{ +lisp_read( struct stack_frame *frame, struct cons_pointer env ) { FILE *input = stdin; - if (readp(frame->arg[0])) { - input = pointer2cell(frame->arg[0]).payload.stream.stream; + if ( readp( frame->arg[0] ) ) { + input = pointer2cell( frame->arg[0] ).payload.stream.stream; } - return read(input); + return read( input ); } /** @@ -345,15 +343,14 @@ lisp_read(struct stack_frame *frame, struct cons_pointer env) * is a write stream, then print to that stream, else stdout. */ struct cons_pointer -lisp_print(struct stack_frame *frame, struct cons_pointer env) -{ +lisp_print( struct stack_frame *frame, struct cons_pointer env ) { FILE *output = stdout; - if (writep(frame->arg[1])) { - output = pointer2cell(frame->arg[1]).payload.stream.stream; + if ( writep( frame->arg[1] ) ) { + output = pointer2cell( frame->arg[1] ).payload.stream.stream; } - print(output, frame->arg[0]); + print( output, frame->arg[0] ); return NIL; } @@ -362,12 +359,11 @@ lisp_print(struct stack_frame *frame, struct cons_pointer env) * TODO: make this do something sensible somehow. */ struct cons_pointer -lisp_throw(struct cons_pointer message, struct stack_frame *frame) -{ - fprintf(stderr, "\nERROR: "); - print(stderr, message); - fprintf(stderr, - "\n\nAn exception was thrown and I've no idea what to do now\n"); +lisp_throw( struct cons_pointer message, struct stack_frame *frame ) { + fprintf( stderr, "\nERROR: " ); + print( stderr, message ); + fprintf( stderr, + "\n\nAn exception was thrown and I've no idea what to do now\n" ); - exit(1); + exit( 1 ); } diff --git a/src/lispops.h b/src/lispops.h index de04134..f3e5200 100644 --- a/src/lispops.h +++ b/src/lispops.h @@ -22,38 +22,38 @@ /* * special forms */ -struct cons_pointer lisp_eval(struct cons_pointer args, - struct cons_pointer env, - struct stack_frame *frame); -struct cons_pointer lisp_apply(struct cons_pointer args, +struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env, - struct stack_frame *frame); -struct cons_pointer lisp_quote(struct cons_pointer args, - struct cons_pointer env, - struct stack_frame *frame); + struct stack_frame *frame ); +struct cons_pointer lisp_apply( struct cons_pointer args, + struct cons_pointer env, + struct stack_frame *frame ); +struct cons_pointer lisp_quote( struct cons_pointer args, + struct cons_pointer env, + struct stack_frame *frame ); /* * functions */ -struct cons_pointer lisp_cons(struct stack_frame *frame, - struct cons_pointer env); -struct cons_pointer lisp_car(struct stack_frame *frame, - struct cons_pointer env); -struct cons_pointer lisp_cdr(struct stack_frame *frame, - struct cons_pointer env); -struct cons_pointer lisp_assoc(struct stack_frame *frame, - struct cons_pointer env); -struct cons_pointer lisp_eq(struct stack_frame *frame, - struct cons_pointer env); -struct cons_pointer lisp_equal(struct stack_frame *frame, - struct cons_pointer env); -struct cons_pointer lisp_read(struct stack_frame *frame, - struct cons_pointer env); -struct cons_pointer lisp_print(struct stack_frame *frame, - struct cons_pointer env); +struct cons_pointer lisp_cons( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_car( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_cdr( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_assoc( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_eq( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_equal( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_read( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_print( struct stack_frame *frame, + struct cons_pointer env ); /* * neither, at this stage, really */ -struct cons_pointer lisp_throw(struct cons_pointer message, - struct stack_frame *frame); +struct cons_pointer lisp_throw( struct cons_pointer message, + struct stack_frame *frame ); diff --git a/src/print.c b/src/print.c index f7c3ba3..abe7dda 100644 --- a/src/print.c +++ b/src/print.c @@ -22,94 +22,89 @@ #include "integer.h" #include "print.h" -void print_string_contents(FILE * output, struct cons_pointer pointer) -{ - if (stringp(pointer) || symbolp(pointer)) { - struct cons_space_object *cell = &pointer2cell(pointer); +void print_string_contents( FILE * output, struct cons_pointer pointer ) { + if ( stringp( pointer ) || symbolp( pointer ) ) { + struct cons_space_object *cell = &pointer2cell( pointer ); wint_t c = cell->payload.string.character; - if (c != '\0') { - fputwc(c, output); + if ( c != '\0' ) { + fputwc( c, output ); } - print_string_contents(output, cell->payload.string.cdr); + print_string_contents( output, cell->payload.string.cdr ); } } -void print_string(FILE * output, struct cons_pointer pointer) -{ - fputwc(btowc('"'), output); - print_string_contents(output, pointer); - fputwc(btowc('"'), output); +void print_string( FILE * output, struct cons_pointer pointer ) { + fputwc( btowc( '"' ), output ); + print_string_contents( output, pointer ); + fputwc( btowc( '"' ), output ); } /** * Print a single list cell (cons cell). TODO: does not handle dotted pairs. */ void -print_list_contents(FILE * output, struct cons_pointer pointer, - bool initial_space) -{ - struct cons_space_object *cell = &pointer2cell(pointer); +print_list_contents( FILE * output, struct cons_pointer pointer, + bool initial_space ) { + struct cons_space_object *cell = &pointer2cell( pointer ); - switch (cell->tag.value) { + switch ( cell->tag.value ) { case CONSTV: - if (initial_space) { - fputwc(btowc(' '), output); + if ( initial_space ) { + fputwc( btowc( ' ' ), output ); } - print(output, cell->payload.cons.car); + print( output, cell->payload.cons.car ); - print_list_contents(output, cell->payload.cons.cdr, true); + print_list_contents( output, cell->payload.cons.cdr, true ); break; case NILTV: break; default: - fwprintf(output, L" . "); - print(output, pointer); + fwprintf( output, L" . " ); + print( output, pointer ); } } -void print_list(FILE * output, struct cons_pointer pointer) -{ - fputwc(btowc('('), output); - print_list_contents(output, pointer, false); - fputwc(btowc(')'), output); +void print_list( FILE * output, struct cons_pointer pointer ) { + fputwc( btowc( '(' ), output ); + print_list_contents( output, pointer, false ); + fputwc( btowc( ')' ), output ); } -void print(FILE * output, struct cons_pointer pointer) -{ - struct cons_space_object cell = pointer2cell(pointer); +void print( FILE * output, struct cons_pointer pointer ) { + struct cons_space_object cell = pointer2cell( pointer ); /* * Because tags have values as well as bytes, this if ... else if * statement can ultimately be replaced by a switch, which will be neater. */ - switch (cell.tag.value) { + switch ( cell.tag.value ) { case CONSTV: - print_list(output, pointer); + print_list( output, pointer ); break; case INTEGERTV: - fwprintf(output, L"%ld", cell.payload.integer.value); + fwprintf( output, L"%ld", cell.payload.integer.value ); break; case NILTV: - fwprintf(output, L"nil"); + fwprintf( output, L"nil" ); break; case REALTV: - fwprintf(output, L"%lf", cell.payload.real.value); + fwprintf( output, L"%lf", cell.payload.real.value ); break; case STRINGTV: - print_string(output, pointer); + print_string( output, pointer ); break; case SYMBOLTV: - print_string_contents(output, pointer); + print_string_contents( output, pointer ); break; case TRUETV: - fwprintf(output, L"t"); + fwprintf( output, L"t" ); break; default: - fwprintf(stderr, - L"Error: Unrecognised tag value %d (%c%c%c%c)\n", - cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1], - cell.tag.bytes[2], cell.tag.bytes[3]); + fwprintf( stderr, + L"Error: Unrecognised tag value %d (%c%c%c%c)\n", + cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1], + cell.tag.bytes[2], cell.tag.bytes[3] ); break; } } diff --git a/src/print.h b/src/print.h index 6f5bf85..a3fb4ab 100644 --- a/src/print.h +++ b/src/print.h @@ -14,6 +14,6 @@ #ifndef __print_h #define __print_h -void print(FILE * output, struct cons_pointer pointer); +void print( FILE * output, struct cons_pointer pointer ); #endif diff --git a/src/read.c b/src/read.c index 240816e..26e0b9d 100644 --- a/src/read.c +++ b/src/read.c @@ -12,7 +12,7 @@ #include #include /* - * wide characters + * wide characters */ #include #include @@ -26,20 +26,20 @@ /* * for the time being things which may be read are: strings numbers - either * integer or real, but not yet including ratios or bignums lists Can't read - * atoms because I don't yet know what an atom is or how it's stored. + * atoms because I don't yet know what an atom is or how it's stored. */ -struct cons_pointer read_number(FILE * input, wint_t initial); -struct cons_pointer read_list(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_number( FILE * input, wint_t initial ); +struct cons_pointer read_list( 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 ); /** * quote reader macro in C (!) */ -struct cons_pointer c_quote(struct cons_pointer arg) -{ - return make_cons(c_string_to_lisp_symbol("quote"), make_cons(arg, NIL)); +struct cons_pointer c_quote( struct cons_pointer arg ) { + return make_cons( c_string_to_lisp_symbol( "quote" ), + make_cons( arg, NIL ) ); } /** @@ -47,32 +47,31 @@ struct cons_pointer c_quote(struct cons_pointer arg) * treating this initial character as the first character of the object * representation. */ -struct cons_pointer read_continuation(FILE * input, wint_t initial) -{ +struct cons_pointer read_continuation( FILE * input, wint_t initial ) { struct cons_pointer result = NIL; wint_t c; - for (c = initial; - c == '\0' || iswblank(c) || iswcntrl(c); c = fgetwc(input)); + for ( c = initial; + c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) ); - switch (c) { + switch ( c ) { case '\'': - result = c_quote(read_continuation(input, fgetwc(input))); + result = c_quote( read_continuation( input, fgetwc( input ) ) ); break; case '(': - result = read_list(input, fgetwc(input)); + result = read_list( input, fgetwc( input ) ); break; case '"': - result = read_string(input, fgetwc(input)); + result = read_string( input, fgetwc( input ) ); break; default: - if (iswdigit(c)) { - result = read_number(input, c); - } else if (iswprint(c)) { - result = read_symbol(input, c); + if ( iswdigit( c ) ) { + result = read_number( input, c ); + } else if ( iswprint( c ) ) { + result = read_symbol( input, c ); } else { - fprintf(stderr, "Unrecognised start of input character %c\n", c); + fprintf( stderr, "Unrecognised start of input character %c\n", c ); } } @@ -82,36 +81,38 @@ struct cons_pointer read_continuation(FILE * input, wint_t initial) /** * read a number from this input stream, given this initial character. */ -struct cons_pointer read_number(FILE * input, wint_t initial) -{ - int accumulator = 0; +struct cons_pointer read_number( FILE * input, wint_t initial ) { + long int accumulator = 0; int places_of_decimals = 0; bool seen_period = false; wint_t c; - fprintf(stderr, "read_number starting '%c' (%d)\n", initial, initial); + fprintf( stderr, "read_number starting '%c' (%d)\n", initial, initial ); - for (c = initial; iswdigit(c) || c == btowc('.'); c = fgetwc(input)) { - if (c == btowc('.')) { + for ( c = initial; iswdigit( c ) || c == btowc( '.' ); + c = fgetwc( input ) ) { + if ( c == btowc( '.' ) ) { seen_period = true; } else { - accumulator = accumulator * 10 + ((int) c - (int) '0'); + accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' ); - if (seen_period) { + fprintf( stderr, "Added character %c, accumulator now %ld\n", c, accumulator); + + if ( seen_period ) { places_of_decimals++; } } } /* - * push back the character read which was not a digit + * push back the character read which was not a digit */ - ungetwc(c, input); + ungetwc( c, input ); - if (seen_period) { - return make_real(accumulator / pow(10, places_of_decimals)); + if ( seen_period ) { + return make_real( accumulator / pow( 10, places_of_decimals ) ); } else { - return make_integer(accumulator); + return make_integer( accumulator ); } } @@ -119,86 +120,85 @@ struct cons_pointer read_number(FILE * input, wint_t initial) * Read a list from this input stream, which no longer contains the opening * left parenthesis. */ -struct cons_pointer read_list(FILE * input, wint_t initial) -{ +struct cons_pointer read_list( FILE * input, wint_t initial ) { struct cons_pointer result = NIL; - if (initial != ')') { - fwprintf(stderr, L"read_list starting '%C' (%d)\n", initial, initial); - struct cons_pointer car = read_continuation(input, initial); - result = make_cons(car, read_list(input, fgetwc(input))); + if ( initial != ')' ) { + fwprintf( stderr, L"read_list starting '%C' (%d)\n", initial, + initial ); + struct cons_pointer car = read_continuation( input, initial ); + result = make_cons( car, read_list( input, fgetwc( input ) ) ); } else { - fprintf(stderr, "End of list detected\n"); + fprintf( stderr, "End of list detected\n" ); } return result; } -/** - * Read a string. This means either a string delimited by double quotes +/** + * Read a string. This means either a string delimited by double quotes * (is_quoted == true), in which case it may contain whitespace but may * not contain a double quote character (unless escaped), or one not * so delimited in which case it may not contain whitespace (unless escaped) * but may contain a double quote character (probably not a good idea!) */ -struct cons_pointer read_string(FILE * input, wint_t initial) -{ +struct cons_pointer read_string( FILE * input, wint_t initial ) { struct cons_pointer cdr = NIL; struct cons_pointer result; - fwprintf(stderr, L"read_string starting '%C' (%d)\n", initial, initial); + fwprintf( stderr, L"read_string starting '%C' (%d)\n", initial, initial ); - switch (initial) { + switch ( initial ) { case '\0': - result = make_string(initial, NIL); + result = make_string( initial, NIL ); break; case '"': - result = make_string('\0', NIL); + 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; } return result; } -struct cons_pointer read_symbol(FILE * input, wint_t initial) -{ +struct cons_pointer read_symbol( FILE * input, wint_t initial ) { struct cons_pointer cdr = NIL; struct cons_pointer result; - fwprintf(stderr, L"read_symbol starting '%C' (%d)\n", initial, initial); + fwprintf( stderr, L"read_symbol starting '%C' (%d)\n", initial, initial ); - switch (initial) { + switch ( initial ) { case '\0': - result = make_symbol(initial, NIL); + result = make_symbol( initial, NIL ); break; case '"': /* - * 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; case ')': /* - * unquoted strings may not include right-parenthesis + * unquoted strings may not include right-parenthesis */ - result = make_symbol('\0', NIL); + result = make_symbol( '\0', NIL ); /* - * push back the character read + * push back the character read */ - ungetwc(initial, input); + ungetwc( initial, input ); break; default: - if (iswblank(initial) || !iswprint(initial)) { - result = make_symbol('\0', NIL); + if ( iswblank( initial ) || !iswprint( initial ) ) { + result = make_symbol( '\0', NIL ); /* - * push back the character read + * push back the character read */ - ungetwc(initial, input); + ungetwc( initial, input ); } else { - result = make_symbol(initial, read_symbol(input, fgetwc(input))); + result = + make_symbol( initial, read_symbol( input, fgetwc( input ) ) ); } break; } @@ -209,7 +209,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. */ -struct cons_pointer read(FILE * input) -{ - return read_continuation(input, fgetwc(input)); +struct cons_pointer read( FILE * input ) { + return read_continuation( input, fgetwc( input ) ); } diff --git a/src/read.h b/src/read.h index 123e743..5ed365a 100644 --- a/src/read.h +++ b/src/read.h @@ -14,6 +14,6 @@ /** * read the next object on this input stream and return a cons_pointer to it. */ -struct cons_pointer read(FILE * input); +struct cons_pointer read( FILE * input ); #endif diff --git a/src/real.c b/src/real.c index 0cd6803..5608b86 100644 --- a/src/real.c +++ b/src/real.c @@ -14,10 +14,9 @@ * @param value the value to wrap; * @return a real number cell wrapping this value. */ -struct cons_pointer make_real(long double value) -{ - struct cons_pointer result = allocate_cell(REALTAG); - struct cons_space_object *cell = &pointer2cell(result); +struct cons_pointer make_real( long double value ) { + struct cons_pointer result = allocate_cell( REALTAG ); + struct cons_space_object *cell = &pointer2cell( result ); cell->payload.real.value = value; return result; diff --git a/src/real.h b/src/real.h index 9c0e1b9..7e3601f 100644 --- a/src/real.h +++ b/src/real.h @@ -24,7 +24,7 @@ extern "C" { * @param value the value to wrap; * @return a real number cell wrapping this value. */ - struct cons_pointer make_real(double value); + struct cons_pointer make_real( double value ); #ifdef __cplusplus } diff --git a/src/repl.c b/src/repl.c index d49fad8..959104b 100644 --- a/src/repl.c +++ b/src/repl.c @@ -22,21 +22,22 @@ * @param show_prompt true if prompts should be shown. */ void -repl(FILE * in_stream, FILE * out_stream, FILE * error_stream, - bool show_prompt) -{ - while (!feof(in_stream)) { - if (show_prompt) { - fwprintf(out_stream, L"\n:: "); +repl( FILE * in_stream, FILE * out_stream, FILE * error_stream, + bool show_prompt ) { + while ( !feof( in_stream ) ) { + if ( show_prompt ) { + fwprintf( out_stream, L"\n:: " ); } - struct cons_pointer input = read(in_stream); - fwprintf(error_stream, L"\nread {%d,%d}=> ", input.page, input.offset); - if (show_prompt) { - fwprintf(out_stream, L"\n-> "); + struct cons_pointer input = read( in_stream ); + fwprintf( error_stream, L"\nread {%d,%d}=> ", input.page, + input.offset ); + if ( show_prompt ) { + fwprintf( out_stream, L"\n-> " ); } // print( out_stream, lisp_eval(input, oblist, NULL)); - print(out_stream, input); - fwprintf(out_stream, L"\n"); - fwprintf(error_stream, L"\neval {%d,%d}=> ", input.page, input.offset); + print( out_stream, input ); + fwprintf( out_stream, L"\n" ); + fwprintf( error_stream, L"\neval {%d,%d}=> ", input.page, + input.offset ); } } diff --git a/src/repl.h b/src/repl.h index 55a12d7..1a7b0e9 100644 --- a/src/repl.h +++ b/src/repl.h @@ -25,8 +25,8 @@ extern "C" { * @param err_stream the stream to send errors to; * @param show_prompt true if prompts should be shown. */ - void repl(FILE * in_stream, FILE * out_stream, - FILE * error_stream, bool show_prompt); + void repl( FILE * in_stream, FILE * out_stream, + FILE * error_stream, bool show_prompt ); #ifdef __cplusplus } diff --git a/src/stack.c b/src/stack.c index 049f892..6581b02 100644 --- a/src/stack.c +++ b/src/stack.c @@ -29,14 +29,13 @@ * Allocate a new stack frame with its previous pointer set to this value, * its arguments set up from these args, evaluated in this env. */ -struct stack_frame *make_stack_frame(struct stack_frame *previous, - struct cons_pointer args, - struct cons_pointer env) -{ +struct stack_frame *make_stack_frame( struct stack_frame *previous, + struct cons_pointer args, + struct cons_pointer env ) { /* * TODO: later, pop a frame off a free-list of stack frames */ - struct stack_frame *result = malloc(sizeof(struct stack_frame)); + struct stack_frame *result = malloc( sizeof( struct stack_frame ) ); result->previous = previous; @@ -47,27 +46,27 @@ struct stack_frame *make_stack_frame(struct stack_frame *previous, result->more = NIL; result->function = NIL; - for (int i = 0; i < args_in_frame; i++) { + for ( int i = 0; i < args_in_frame; i++ ) { result->arg[i] = NIL; } int i = 0; /* still an index into args, so same name will * do */ - while (!nilp(args)) { /* iterate down the arg list filling in the + while ( !nilp( args ) ) { /* iterate down the arg list filling in the * arg slots in the frame. When there are no * more slots, if there are still args, stash * them on more */ - struct cons_space_object cell = pointer2cell(args); + struct cons_space_object cell = pointer2cell( args ); - if (i < args_in_frame) { + if ( i < args_in_frame ) { /* * TODO: if we were running on real massively parallel hardware, * each arg except the first should be handed off to another * processor to be evaled in parallel */ - result->arg[i] = lisp_eval(cell.payload.cons.car, env, result); - inc_ref(result->arg[i]); + result->arg[i] = lisp_eval( cell.payload.cons.car, env, result ); + inc_ref( result->arg[i] ); args = cell.payload.cons.cdr; } else { @@ -75,7 +74,7 @@ struct stack_frame *make_stack_frame(struct stack_frame *previous, * TODO: this isn't right. These args should also each be evaled. */ result->more = args; - inc_ref(result->more); + inc_ref( result->more ); args = NIL; } @@ -87,36 +86,34 @@ struct stack_frame *make_stack_frame(struct stack_frame *previous, /** * Free this stack frame. */ -void free_stack_frame(struct stack_frame *frame) -{ +void free_stack_frame( struct stack_frame *frame ) { /* * TODO: later, push it back on the stack-frame freelist */ - for (int i = 0; i < args_in_frame; i++) { - dec_ref(frame->arg[i]); + for ( int i = 0; i < args_in_frame; i++ ) { + dec_ref( frame->arg[i] ); } - dec_ref(frame->more); + dec_ref( frame->more ); - free(frame); + free( frame ); } /** * Fetch a pointer to the value of the local variable at this index. */ -struct cons_pointer fetch_arg(struct stack_frame *frame, unsigned int index) -{ +struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int index ) { struct cons_pointer result = NIL; - if (index < args_in_frame) { + if ( index < args_in_frame ) { result = frame->arg[index]; } else { struct cons_pointer p = frame->more; - for (int i = args_in_frame; i < index; i++) { - p = pointer2cell(p).payload.cons.cdr; + for ( int i = args_in_frame; i < index; i++ ) { + p = pointer2cell( p ).payload.cons.cdr; } - result = pointer2cell(p).payload.cons.car; + result = pointer2cell( p ).payload.cons.car; } return result; diff --git a/src/stack.h b/src/stack.h index 25ce84b..47d97e9 100644 --- a/src/stack.h +++ b/src/stack.h @@ -24,11 +24,11 @@ #ifndef __stack_h #define __stack_h -struct stack_frame *make_stack_frame(struct stack_frame *previous, - struct cons_pointer args, - struct cons_pointer env); -void free_stack_frame(struct stack_frame *frame); -struct cons_pointer fetch_arg(struct stack_frame *frame, unsigned int n); +struct stack_frame *make_stack_frame( struct stack_frame *previous, + struct cons_pointer args, + struct cons_pointer env ); +void free_stack_frame( struct stack_frame *frame ); +struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n ); /* * struct stack_frame is defined in consspaceobject.h to break circularity