From d7886550a62868c14b33857a78ab0b2c28bcff99 Mon Sep 17 00:00:00 2001 From: simon Date: Mon, 14 Aug 2017 20:18:13 +0100 Subject: [PATCH] Standardised formatting. --- Makefile | 9 +- src/conspage.c | 210 +++++++++++++----------- src/conspage.h | 13 +- src/consspaceobject.c | 246 +++++++++++++++------------- src/consspaceobject.h | 227 ++++++++++++++++---------- src/equal.c | 72 ++++---- src/equal.h | 4 +- src/init.c | 104 +++++++----- src/integer.c | 32 ++-- src/integer.h | 4 +- src/intern.c | 88 +++++----- src/intern.h | 19 ++- src/lispops.c | 371 +++++++++++++++++++++++------------------- src/lispops.h | 54 ++++-- src/print.c | 140 ++++++++-------- src/print.h | 2 +- src/read.c | 275 +++++++++++++++---------------- src/read.h | 2 +- src/real.c | 12 +- src/real.h | 9 +- src/repl.c | 24 +-- src/repl.h | 11 +- src/stack.c | 135 ++++++++------- src/stack.h | 16 +- src/version.h | 1 - 25 files changed, 1131 insertions(+), 949 deletions(-) diff --git a/Makefile b/Makefile index 84bf081..970f2b1 100644 --- a/Makefile +++ b/Makefile @@ -8,15 +8,22 @@ DEPS := $(OBJS:.o=.d) INC_DIRS := $(shell find $(SRC_DIRS) -type d) INC_FLAGS := $(addprefix -I,$(INC_DIRS)) +INDENT_FLAGS := -kr -nut -l79 -ts2 VERSION := "0.0.0" -CPPFLAGS ?= $(INC_FLAGS) -MMD -MP +CPPFLAGS ?= $(INC_FLAGS) -MMD -MP LDFLAGS := -lm $(TARGET): $(OBJS) $(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) +format: + indent $(INDENT_FLAGS) $(SRCS) src/*.h + +test: + bash ./unit-tests.sh + .PHONY: clean clean: $(RM) $(TARGET) $(OBJS) $(DEPS) diff --git a/src/conspage.c b/src/conspage.c index 22a53e3..3e88b1e 100644 --- a/src/conspage.c +++ b/src/conspage.c @@ -19,8 +19,6 @@ #include "consspaceobject.h" #include "conspage.h" - - /** * Flag indicating whether conspage initialisation has been done. */ @@ -40,99 +38,110 @@ struct cons_pointer freelist = NIL; /** * An array of pointers to cons pages. */ -struct cons_page* conspages[NCONSPAGES]; - +struct cons_page *conspages[NCONSPAGES]; /** * Make a cons page whose serial number (i.e. index in the conspages directory) is pageno. * 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) { - conspages[initialised_cons_pages] = result; + if (result != NULL) { + conspages[initialised_cons_pages] = result; - 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) { - /* initialise cell as NIL */ - 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) { - /* initialise cell as T */ - strncpy( &cell->tag.bytes[0], TRUETAG, TAGLENGTH); - cell->count = MAXREFERENCE; - cell->payload.free.car = (struct cons_pointer){ 0, 1}; - cell->payload.free.cdr = (struct cons_pointer){ 0, 1}; - fprintf( stderr, "Allocated special cell T\n"); + 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) { + /* + * initialise cell as NIL + */ + 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) { + /* + * initialise cell as T + */ + strncpy(&cell->tag.bytes[0], TRUETAG, TAGLENGTH); + cell->count = MAXREFERENCE; + cell->payload.free.car = (struct cons_pointer) { + 0, 1}; + cell->payload.free.cdr = (struct cons_pointer) { + 0, 1}; + fprintf(stderr, "Allocated special cell T\n"); + } + } else { + /* + * otherwise, standard initialisation + */ + strncpy(&cell->tag.bytes[0], FREETAG, TAGLENGTH); + cell->payload.free.car = NIL; + cell->payload.free.cdr = freelist; + freelist.page = initialised_cons_pages; + freelist.offset = i; + } } - } else { - /* otherwise, standard initialisation */ - strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH); - cell->payload.free.car = NIL; - cell->payload.free.cdr = freelist; - freelist.page = initialised_cons_pages; - freelist.offset = i; - } + + initialised_cons_pages++; + } else { + fprintf(stderr, + "FATAL: Failed to allocate memory for cons page %d\n", + initialised_cons_pages); + exit(1); } - initialised_cons_pages ++; - } else { - fprintf( stderr, "FATAL: Failed to allocate memory for cons page %d\n", initialised_cons_pages); - exit(1); - } - } - /** * 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}); + } } - } } - /** * Frees the cell at the specified pointer. Dangerous, primitive, low * level. * * @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); - 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); - } + 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); + } } 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); + } } - /** * Allocates a cell with the specified tag. Dangerous, primitive, low * level. @@ -140,48 +149,51 @@ 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 result = freelist; +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); - } else { - struct cons_space_object* cell = &pointer2cell(result); - - if ( strncmp( &cell->tag.bytes[0], FREETAG, TAGLENGTH) == 0) { - freelist = cell->payload.free.cdr; - - 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); + if (result.page == NIL.page && result.offset == NIL.offset) { + make_cons_page(); + result = allocate_cell(tag); } else { - fprintf( stderr, "WARNING: Allocating non-free cell!"); + struct cons_space_object *cell = &pointer2cell(result); + + if (strncmp(&cell->tag.bytes[0], FREETAG, TAGLENGTH) == 0) { + freelist = cell->payload.free.cdr; + + 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); + } else { + fprintf(stderr, "WARNING: Allocating non-free cell!"); + } } - } - return result; + return result; } - /** * 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(); - conspageinitihasbeencalled = true; - } else { - fprintf( stderr, "WARNING: conspageinit() called a second or subsequent time\n"); - } + make_cons_page(); + conspageinitihasbeencalled = true; + } else { + fprintf(stderr, + "WARNING: conspageinit() called a second or subsequent time\n"); + } } diff --git a/src/conspage.h b/src/conspage.h index db7b13e..4dba5c8 100644 --- a/src/conspage.h +++ b/src/conspage.h @@ -3,7 +3,6 @@ #ifndef __conspage_h #define __conspage_h - /** * the number of cons cells on a cons page. The maximum value this can be (and consequently, * the size which, by version 1, it will default to) is the maximum value of an unsigned 32 @@ -24,10 +23,9 @@ * my current view is that that's probably unneccessary. */ struct cons_page { - struct cons_space_object cell[CONSPAGESIZE]; + struct cons_space_object cell[CONSPAGESIZE]; }; - /** * The (global) pointer to the (global) freelist. Not sure whether this ultimately * belongs in this file. @@ -37,8 +35,7 @@ extern struct cons_pointer freelist; /** * An array of pointers to cons pages. */ -extern struct cons_page* conspages[NCONSPAGES]; - +extern struct cons_page *conspages[NCONSPAGES]; /** * Frees the cell at the specified pointer. Dangerous, primitive, low @@ -48,7 +45,6 @@ extern struct cons_page* conspages[NCONSPAGES]; */ void free_cell(struct cons_pointer pointer); - /** * Allocates a cell with the specified tag. Dangerous, primitive, low * level. @@ -56,8 +52,7 @@ 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. @@ -67,6 +62,6 @@ 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 afc0002..7d0312b 100644 --- a/src/consspaceobject.c +++ b/src/consspaceobject.c @@ -11,7 +11,9 @@ #include #include #include -/* wide characters */ +/* + * wide characters + */ #include #include @@ -21,143 +23,145 @@ /** * 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; } - /** * increment the reference count of the object at this cons pointer. * * 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) { - cell->count ++; - } + if (cell->count < MAXREFERENCE) { + cell->count++; + } } - /** * Decrement the reference count of the object at this cons 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) { - cell->count --; + if (cell->count <= MAXREFERENCE) { + cell->count--; - if (cell->count == 0) { - free_cell( pointer); + if (cell->count == 0) { + free_cell(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 pointer = NIL; +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]; + struct cons_space_object *cell = + &conspages[pointer.page]->cell[pointer.offset]; - inc_ref(car); - inc_ref(cdr); - cell->payload.cons.car = car; - cell->payload.cons.cdr = cdr; + inc_ref(car); + inc_ref(cdr); + cell->payload.cons.car = car; + cell->payload.cons.cdr = cdr; - return pointer; + return pointer; } /** * 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); +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); - cell->payload.function.source = src; - cell->payload.function.executable = executable; + cell->payload.function.source = src; + cell->payload.function.executable = executable; - return pointer; + return pointer; } - + /** * Construct a string from this character (which later will be UTF) 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_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); +struct cons_pointer +make_string_like_thing(wint_t c, struct cons_pointer tail, char *tag) +{ + struct cons_pointer pointer = NIL; - 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); - } - - return pointer; + if (check_tag(tail, tag) || check_tag(tail, NILTAG)) { + pointer = allocate_cell(tag); + struct cons_space_object *cell = &pointer2cell(pointer); + + 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); + } + + return pointer; } /** @@ -166,56 +170,68 @@ struct cons_pointer make_string_like_thing( wint_t c, * 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) - (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 +make_special(struct cons_pointer src, struct cons_pointer (*executable) - cell->payload.special.source = src; - cell->payload.special.executable = executable; - - return 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; + + return pointer; } /** * Return a lisp string representation of this old skool ASCII string. */ -struct cons_pointer c_string_to_lisp_string( char* string) { - struct cons_pointer result = NIL; +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; + return result; } /** * Return a lisp symbol representation of this old skool ASCII string. */ -struct cons_pointer c_string_to_lisp_symbol( char* symbol) { - struct cons_pointer result = NIL; +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; + return result; } diff --git a/src/consspaceobject.h b/src/consspaceobject.h index b3e80cd..ccba8df 100644 --- a/src/consspaceobject.h +++ b/src/consspaceobject.h @@ -11,7 +11,9 @@ #include #include #include -/* wide characters */ +/* + * wide characters + */ #include #include @@ -201,11 +203,14 @@ * An indirect pointer to a cons cell */ struct cons_pointer { - uint32_t page; /* the index of the page on which this cell resides */ - uint32_t offset; /* the index of the cell within the page */ + uint32_t page; /* the index of the page on which this cell + * resides */ + uint32_t offset; /* the index of the cell within the page */ }; -/* number of arguments stored in a stack frame */ +/* + * number of arguments stored in a stack frame + */ #define args_in_frame 8 /** @@ -213,20 +218,21 @@ struct cons_pointer { * here to avoid circularity. TODO: refactor. */ struct stack_frame { - struct stack_frame* previous; /* the previous frame */ - struct cons_pointer arg[args_in_frame]; - /* first 8 arument bindings */ - struct cons_pointer more; /* list of any further argument - * bindings */ - struct cons_pointer function; /* the function to be called */ + struct stack_frame *previous; /* the previous frame */ + struct cons_pointer arg[args_in_frame]; + /* + * first 8 arument bindings + */ + struct cons_pointer more; /* list of any further argument bindings */ + struct cons_pointer function; /* the function to be called */ }; /** * payload of a cons cell. */ struct cons_payload { - struct cons_pointer car; - struct cons_pointer cdr; + struct cons_pointer car; + struct cons_pointer cdr; }; /** @@ -237,10 +243,11 @@ struct cons_payload { * (representing its stack frame) and a cons pointer (representing its * environment) as arguments and returns a cons pointer (representing its * result). - */ + */ struct function_payload { - struct cons_pointer source; - struct cons_pointer (*executable)(struct stack_frame*, struct cons_pointer); + struct cons_pointer source; + struct cons_pointer (*executable) (struct stack_frame *, + struct cons_pointer); }; /** @@ -248,8 +255,8 @@ struct function_payload { * but it may not be so in future. */ struct free_payload { - struct cons_pointer car; - struct cons_pointer cdr; + struct cons_pointer car; + struct cons_pointer cdr; }; /** @@ -258,7 +265,7 @@ struct free_payload { * optional bignum object. */ struct integer_payload { - long int value; + long int value; }; /** @@ -266,7 +273,7 @@ struct integer_payload { * precision, but I'm not sure of the detail. */ struct real_payload { - long double value; + long double value; }; /** @@ -280,19 +287,19 @@ struct real_payload { * * NOTE that this means that special forms do not appear on the lisp stack, * which may be confusing. TODO: think about this. - */ + */ 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 source; + struct cons_pointer (*executable) (struct cons_pointer s_expr, + struct cons_pointer env, + struct stack_frame * frame); }; /** * payload of a read or write stream cell. */ struct stream_payload { - FILE * stream; + FILE *stream; }; /** @@ -302,124 +309,164 @@ struct stream_payload { * payload of a string cell. */ struct string_payload { - wint_t character; /* the actual character stored in this cell */ - uint32_t padding; /* unused padding to word-align the cdr */ - struct cons_pointer cdr; + wint_t character; /* the actual character stored in this cell */ + uint32_t padding; /* unused padding to word-align the cdr */ + struct cons_pointer cdr; }; struct vectorp_payload { - union { - char bytes[TAGLENGTH]; /* the tag (type) of the vector-space - * object this cell points to, considered - * as bytes. NOTE that the vector space - * object should itself have the identical tag. */ - uint32_t value; /* the tag considered as a number */ - } tag; - uint64_t address; /* the address of the actual vector space - * object (TODO: will change when I actually - * implement vector space) */ + union { + char bytes[TAGLENGTH]; /* the tag (type) of the + * vector-space object this cell + * points to, considered as bytes. + * NOTE that the vector space object + * should itself have the identical + * tag. */ + uint32_t value; /* the tag considered as a number */ + } tag; + uint64_t address; /* the address of the actual vector space + * object (TODO: will change when I actually + * implement vector space) */ }; - /** * an object in cons space. */ struct cons_space_object { - union { - char bytes[TAGLENGTH]; /* the tag (type) of this cell, considered as bytes */ - uint32_t value; /* the tag considered as a number */ - } tag; - uint32_t count; /* the count of the number of references to this cell */ - struct cons_pointer access; /* cons pointer to the access control list of this cell */ - union { - /* if tag == CONSTAG */ - struct cons_payload cons; - /* if tag == FREETAG */ - struct free_payload free; - /* if tag == FUNCTIONTAG */ - struct function_payload function; - /* if tag == INTEGERTAG */ - struct integer_payload integer; - /* if tag == NILTAG; we'll treat the special cell NIL as just a cons */ - struct cons_payload nil; - /* if tag == READTAG || tag == WRITETAG */ - struct stream_payload stream; - /* if tag == REALTAG */ - struct real_payload real; - /* if tag == SPECIALTAG */ - struct special_payload special; - /* if tag == STRINGTAG || tag == SYMBOLTAG */ - struct string_payload string; - /* if tag == TRUETAG; we'll treat the special cell T as just a cons */ - struct cons_payload t; - /* if tag == VECTORPTAG */ - struct vectorp_payload vectorp; - } payload; + union { + char bytes[TAGLENGTH]; /* the tag (type) of this cell, + * considered as bytes */ + uint32_t value; /* the tag considered as a number */ + } tag; + uint32_t count; /* the count of the number of references to + * this cell */ + struct cons_pointer access; /* cons pointer to the access control list of + * this cell */ + union { + /* + * if tag == CONSTAG + */ + struct cons_payload cons; + /* + * if tag == FREETAG + */ + struct free_payload free; + /* + * if tag == FUNCTIONTAG + */ + struct function_payload function; + /* + * if tag == INTEGERTAG + */ + struct integer_payload integer; + /* + * if tag == NILTAG; we'll treat the special cell NIL as just a cons + */ + struct cons_payload nil; + /* + * if tag == READTAG || tag == WRITETAG + */ + struct stream_payload stream; + /* + * if tag == REALTAG + */ + struct real_payload real; + /* + * if tag == SPECIALTAG + */ + struct special_payload special; + /* + * if tag == STRINGTAG || tag == SYMBOLTAG + */ + struct string_payload string; + /* + * if tag == TRUETAG; we'll treat the special cell T as just a cons + */ + struct cons_payload t; + /* + * if tag == VECTORPTAG + */ + struct vectorp_payload vectorp; + } payload; }; - /** * 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 stack_frame*, struct cons_pointer)); +struct cons_pointer make_function(struct cons_pointer src, + struct cons_pointer (*executable) + + + + + + + + + (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 s_expr, - struct cons_pointer env, - struct stack_frame* frame)); +struct cons_pointer make_special(struct cons_pointer src, + struct cons_pointer (*executable) + + + + + + + + + (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 3b5cc6b..8814ea8 100644 --- a/src/equal.c +++ b/src/equal.c @@ -18,45 +18,55 @@ * 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)) { - /* 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 practice only - * the empty string will. */ - 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); + 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 + * practice only the empty string will. + */ + 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); - /* not more different than one part in a million - close enough */ - result = fabs( num_a - num_b) < (max / 1000000.0); + /* + * not more different than one part in a million - close enough + */ + result = fabs(num_a - num_b) < (max / 1000000.0); + } + /* + * there's only supposed ever to be one T and one NIL cell, so each + * should be caught by eq; equality of vector-space objects is a whole + * other ball game so we won't deal with it now (and indeedmay never). + * I'm not certain what equality means for read and write streams, so + * I'll ignore them, too, for now. + */ } - /* there's only supposed ever to be one T and one NIL cell, so each should - * be caught by eq; equality of vector-space objects is a whole other ball - * game so we won't deal with it now (and indeedmay never). I'm not certain - * what equality means for read and write streams, so I'll ignore them, too, - * for now.*/ - } - - return result; + + return result; } diff --git a/src/equal.h b/src/equal.h index 2c4a86d..796b983 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 aeb5dfd..38d03c8 100644 --- a/src/init.c +++ b/src/init.c @@ -21,75 +21,93 @@ #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) - (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)); +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)); } -int main (int argc, char *argv[]) { - /* attempt to set wide character acceptance on all streams */ +int main(int argc, char *argv[]) +{ + /* + * attempt to set wide character acceptance on all streams + */ 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; + dump_at_end = true; + break; case 'p': - show_prompt = true; - break; + show_prompt = true; + break; default: - fprintf( stderr, "Unexpected option %c\n", option); - break; - } + fprintf(stderr, "Unexpected option %c\n", option); + break; + } } if (show_prompt) { - fprintf( stdout, "Post scarcity software environment version %s\n\n", VERSION); + fprintf(stdout, + "Post scarcity software environment version %s\n\n", VERSION); } - + 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); + /* + * 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); - /* 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); + /* + * 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); - /* primitive special forms */ - bind_special( "apply", &lisp_apply); - bind_special( "eval", &lisp_eval); - bind_special( "quote", &lisp_quote); + /* + * primitive special forms + */ + bind_special("apply", &lisp_apply); + bind_special("eval", &lisp_eval); + bind_special("quote", &lisp_quote); repl(stdin, stdout, stderr, show_prompt); // print( stdout, lisp_eval( input, oblist, NULL)); - if ( dump_at_end) { + if (dump_at_end) { dump_pages(stderr); } - return(0); + return (0); } diff --git a/src/integer.c b/src/integer.c index 8f7b044..b15541a 100644 --- a/src/integer.c +++ b/src/integer.c @@ -19,28 +19,28 @@ * 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 result = NAN; - struct cons_space_object* cell = &pointer2cell(pointer); +double numeric_value(struct cons_pointer pointer) +{ + double result = NAN; + struct cons_space_object *cell = &pointer2cell(pointer); - if ( integerp( pointer)) { - result = (double) cell->payload.integer.value; - } else if ( realp( pointer)) { - result = cell->payload.real.value; - } + if (integerp(pointer)) { + result = (double) cell->payload.integer.value; + } else if (realp(pointer)) { + result = cell->payload.real.value; + } - return result; + return result; } - /** * 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); - cell->payload.integer.value = value; +struct cons_pointer make_integer(int value) +{ + struct cons_pointer result = allocate_cell(INTEGERTAG); + struct cons_space_object *cell = &pointer2cell(result); + cell->payload.integer.value = value; - return result; + return result; } - diff --git a/src/integer.h b/src/integer.h index 5d1df67..a8cb101 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(int value); #endif diff --git a/src/intern.c b/src/intern.c index 3cc9379..b71a4d1 100644 --- a/src/intern.c +++ b/src/intern.c @@ -43,21 +43,23 @@ struct cons_pointer oblist = NIL; * from the store (so that later when we want to retrieve a value, an eq test * will work); otherwise return NIL. */ -struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer store) { - struct cons_pointer result = NIL; +struct cons_pointer +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) { - struct cons_space_object entry = - pointer2cell( pointer2cell( next).payload.cons.car); + 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); - if ( equal( key, entry.payload.cons.car)) { - result = entry.payload.cons.car; + if (equal(key, entry.payload.cons.car)) { + result = entry.payload.cons.car; + } } - } - return result; + return result; } /** @@ -68,60 +70,64 @@ struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer stor * 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 result = NIL; +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) { - struct cons_space_object entry = - pointer2cell( pointer2cell( next).payload.cons.car); + 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); - if ( equal( key, entry.payload.cons.car)) { - result = entry.payload.cons.cdr; - break; + if (equal(key, entry.payload.cons.car)) { + result = entry.payload.cons.cdr; + break; + } } - } - return result; + return result; } - /** * 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) { - return make_cons( make_cons( key, value), store); +struct cons_pointer +bind(struct cons_pointer key, struct cons_pointer value, + struct cons_pointer store) +{ + return make_cons(make_cons(key, value), 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) { - oblist = bind( key, value, oblist); - return oblist; +struct cons_pointer +deep_bind(struct cons_pointer key, struct cons_pointer value) +{ + oblist = bind(key, value, oblist); + return oblist; } - /** * 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 result = environment; - struct cons_pointer canonical = internedp( key, environment); +struct cons_pointer +intern(struct cons_pointer key, struct cons_pointer environment) +{ + struct cons_pointer result = environment; + struct cons_pointer canonical = internedp(key, environment); - if ( nilp( canonical)) { - /* not currently bound */ - result = bind( key, NIL, environment); - } + if (nilp(canonical)) { + /* + * not currently bound + */ + result = bind(key, NIL, environment); + } - return result; + return result; } diff --git a/src/intern.h b/src/intern.h index 56adb33..98cc001 100644 --- a/src/intern.h +++ b/src/intern.h @@ -17,7 +17,6 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ - #ifndef __intern_h #define __intern_h @@ -28,35 +27,37 @@ 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 d85d9ac..9748797 100644 --- a/src/lispops.c +++ b/src/lispops.c @@ -37,11 +37,11 @@ /* * also to create in this section: * struct cons_pointer lisp_cond( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); + struct stack_frame* frame); * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); + struct stack_frame* frame); * struct cons_pointer lisp_mapcar( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); + struct stack_frame* frame); * * and others I haven't thought of yet. */ @@ -49,27 +49,29 @@ /** * 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 result = NIL; - - if ( consp(arg)) { - result = pointer2cell( arg).payload.cons.car; - } +struct cons_pointer c_car(struct cons_pointer arg) +{ + struct cons_pointer result = NIL; - return result; + if (consp(arg)) { + result = pointer2cell(arg).payload.cons.car; + } + + return result; } /** * 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 result = NIL; - - if ( consp(arg)) { - result = pointer2cell( arg).payload.cons.cdr; - } +struct cons_pointer c_cdr(struct cons_pointer arg) +{ + struct cons_pointer result = NIL; - return result; + if (consp(arg)) { + result = pointer2cell(arg).payload.cons.cdr; + } + + return result; } /** @@ -78,61 +80,70 @@ struct cons_pointer c_cdr( struct cons_pointer arg) { * I'm now confused about whether at this stage I actually need an apply special form, * 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) { - struct cons_pointer result = args; - - if ( consp( args)) { - lisp_eval( args, env, frame); - } +struct cons_pointer +lisp_apply(struct cons_pointer args, struct cons_pointer env, + struct stack_frame *frame) +{ + struct cons_pointer result = args; - return result; + 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) { - 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 +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); - switch ( fn_cell.tag.value) { - case SPECIALTV : - { - struct cons_space_object special = pointer2cell( fn_pointer); - result = (*special.payload.special.executable)( args, env, my_frame); + switch (fn_cell.tag.value) { + case SPECIALTV: + { + struct cons_space_object special = pointer2cell(fn_pointer); + result = + (*special.payload.special.executable) (args, env, my_frame); + } + break; + + case FUNCTIONTV: + /* + * actually, this is apply + */ + { + 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); + } + 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); + } } - break; - case FUNCTIONTV : - /* actually, this is apply */ - { - 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); - } - 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); - } - } - - return result; + return result; } /** @@ -148,40 +159,45 @@ struct cons_pointer eval_cons( struct cons_pointer s_expr, struct cons_pointer e * passes them in a stack frame as arguments to the function. * 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) { - 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_pointer +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); - switch ( cell.tag.value) { - case CONSTV : - result = eval_cons( s_expr, env, my_frame); - break; + switch (cell.tag.value) { + case CONSTV: + result = eval_cons(s_expr, env, my_frame); + break; - case SYMBOLTV : - { - 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); - } else { - result = c_assoc( canonical, env); - } + case SYMBOLTV: + { + 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); + } else { + result = c_assoc(canonical, env); + } + } + break; + /* + * the Clojure practice of having a map serve in the function place of + * an s-expression is a good one and I should adopt it; also if the + * object is a consp it could be interpretable source code but in the + * long run I don't want an interpreter, and if I can get away without + * so much the better. + */ } - break; - /* the Clojure practice of having a map serve in the function - * place of an s-expression is a good one and I should adopt it; - * also if the object is a consp it could be interpretable - * source code but in the long run I don't want an interpreter, - * and if I can get away without so much the better. */ - } - free_stack_frame( my_frame); - - return result; + free_stack_frame(my_frame); + + return result; } /** @@ -191,9 +207,11 @@ struct cons_pointer lisp_eval( struct cons_pointer s_expr, struct cons_pointer e * Returns its argument (strictly first argument - only one is expected but * 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); +struct cons_pointer +lisp_quote(struct cons_pointer args, struct cons_pointer env, + struct stack_frame *frame) +{ + return c_car(args); } /** @@ -203,22 +221,24 @@ struct cons_pointer lisp_quote( struct cons_pointer args, struct cons_pointer en * Returns a cell constructed from a and b. If a is of type string but its * cdr is nill, and b is of type string, then returns a new string cell; * otherwise returns a new cons cell. - */ -struct cons_pointer 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; + */ +struct cons_pointer +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)) { - return NIL; - } 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); - } + 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 { + result = make_cons(car, cdr); + } - return result; + return result; } /** @@ -226,70 +246,78 @@ struct cons_pointer lisp_cons(struct stack_frame* frame, struct cons_pointer env * Returns the first item (head) of a sequence. Valid for cons cells, * 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) { - struct cons_pointer result = NIL; +struct cons_pointer +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]); - 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 { - struct cons_pointer message = - c_string_to_lisp_string( "Attempt to take CAR/CDR of non sequence"); - result = lisp_throw( message, frame); - } + 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 { + struct cons_pointer message = + c_string_to_lisp_string("Attempt to take CAR/CDR of non sequence"); + result = lisp_throw(message, frame); + } - return result; + return result; } - /** * (cdr s_expr) * Returns the remainder of a sequence when the head is removed. Valid for cons cells, * 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) { - struct cons_pointer result = NIL; +struct cons_pointer +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]); - result = cell.payload.cons.car; - } 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); - } + 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 = 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); + } - return result; + return result; } /** * (assoc key store) * 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]); +struct cons_pointer +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; } /** * (eq a b) * 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; +struct cons_pointer +lisp_equal(struct stack_frame *frame, struct cons_pointer env) +{ + return equal(frame->arg[0], frame->arg[1]) ? TRUE : NIL; } /** @@ -298,14 +326,16 @@ struct cons_pointer lisp_equal( struct stack_frame* frame, struct cons_pointer e * Read one complete lisp form and return it. If read-stream is specified and * is a read stream, then read from that stream, else stdin. */ -struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer env) { - FILE* input = stdin; +struct cons_pointer +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); } /** @@ -314,27 +344,30 @@ struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer en * Print one complete lisp form and return NIL. If write-stream is specified and * is a write stream, then print to that stream, else stdout. */ -struct cons_pointer lisp_print( struct stack_frame* frame, struct cons_pointer env) { - FILE* output = stdout; +struct cons_pointer +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]); - - return NIL; + print(output, frame->arg[0]); + + return NIL; } - /** * 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"); +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"); - exit( 1); + exit(1); } - diff --git a/src/lispops.h b/src/lispops.h index 597d67f..de04134 100644 --- a/src/lispops.h +++ b/src/lispops.h @@ -19,23 +19,41 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -/* 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 env, - struct stack_frame* frame); -struct cons_pointer lisp_quote( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); +/* + * 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 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); +/* + * 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); -/* neither, at this stage, really */ -struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame); +/* + * neither, at this stage, really + */ +struct cons_pointer lisp_throw(struct cons_pointer message, + struct stack_frame *frame); diff --git a/src/print.c b/src/print.c index 78c209a..f7c3ba3 100644 --- a/src/print.c +++ b/src/print.c @@ -11,7 +11,9 @@ #include #include #include -/* wide characters */ +/* + * wide characters + */ #include #include @@ -20,88 +22,94 @@ #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); - wint_t c = cell->payload.string.character; +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); +void +print_list_contents(FILE * output, struct cons_pointer pointer, + bool initial_space) +{ + struct cons_space_object *cell = &pointer2cell(pointer); - switch ( cell->tag.value) { - case CONSTV : - if (initial_space) { - fputwc( btowc(' '), output); - } - print( output, cell->payload.cons.car); + switch (cell->tag.value) { + case CONSTV: + if (initial_space) { + fputwc(btowc(' '), output); + } + print(output, cell->payload.cons.car); - print_list_contents( output, cell->payload.cons.cdr, true); - break; - case NILTV: - break; - default: - fwprintf( output, L" . "); - print( output, pointer); - } + print_list_contents(output, cell->payload.cons.cdr, true); + break; + case NILTV: + break; + default: + 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) { - case CONSTV : - print_list( output, pointer); - break; - case INTEGERTV : - fwprintf( output, L"%ld", cell.payload.integer.value); - break; - case NILTV : - fwprintf( output, L"nil"); - break; + /* + * 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) { + case CONSTV: + print_list(output, pointer); + break; + case INTEGERTV: + fwprintf(output, L"%ld", cell.payload.integer.value); + break; + case NILTV: + fwprintf(output, L"nil"); + break; case REALTV: fwprintf(output, L"%lf", cell.payload.real.value); break; - case STRINGTV : - print_string( output, pointer); - break; - case SYMBOLTV : - print_string_contents( output, pointer); - break; - case TRUETV : - 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]); - break; - } + case STRINGTV: + print_string(output, pointer); + break; + case SYMBOLTV: + print_string_contents(output, pointer); + break; + case TRUETV: + 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]); + break; + } } diff --git a/src/print.h b/src/print.h index 4ee1e5b..6f5bf85 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 d1f7753..240816e 100644 --- a/src/read.c +++ b/src/read.c @@ -11,7 +11,9 @@ #include #include #include -/* wide characters */ +/* + * wide characters + */ #include #include @@ -21,23 +23,23 @@ #include "read.h" #include "real.h" -/* 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. */ +/* + * 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. + */ -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)); } /** @@ -45,94 +47,93 @@ 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 result = NIL; +struct cons_pointer read_continuation(FILE * input, wint_t initial) +{ + struct cons_pointer result = NIL; - wint_t c; + wint_t c; - for (c = initial; - c == '\0' || iswblank( c) || iswcntrl(c); - c = fgetwc( input)); - - switch( c) { - case '\'': - result = c_quote( read_continuation( input, fgetwc( input))); - break; - case '(' : - result = read_list(input, fgetwc( input)); - break; - case '"': - 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); - } else { - fprintf( stderr, "Unrecognised start of input character %c\n", c); + for (c = initial; + c == '\0' || iswblank(c) || iswcntrl(c); c = fgetwc(input)); + + switch (c) { + case '\'': + result = c_quote(read_continuation(input, fgetwc(input))); + break; + case '(': + result = read_list(input, fgetwc(input)); + break; + case '"': + 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); + } else { + fprintf(stderr, "Unrecognised start of input character %c\n", c); + } } - } - return result; + return result; } - /** * read a number from this input stream, given this initial character. */ -struct cons_pointer read_number( FILE* input, wint_t initial) { - int accumulator = 0; - int places_of_decimals = 0; - bool seen_period = false; - wint_t c; +struct cons_pointer read_number(FILE * input, wint_t initial) +{ + 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); - - for (c = initial; iswdigit( c) || c == btowc('.'); c = fgetwc( input)) { - if ( c == btowc('.')) { - seen_period = true; - } else { - accumulator = accumulator * 10 + ((int)c - (int)'0'); + fprintf(stderr, "read_number starting '%c' (%d)\n", initial, initial); - if ( seen_period) { - places_of_decimals ++; - } + for (c = initial; iswdigit(c) || c == btowc('.'); c = fgetwc(input)) { + if (c == btowc('.')) { + seen_period = true; + } else { + accumulator = accumulator * 10 + ((int) c - (int) '0'); + + if (seen_period) { + places_of_decimals++; + } + } } - } - /* push back the character read which was not a digit */ - ungetwc( c, input); + /* + * push back the character read which was not a digit + */ + ungetwc(c, input); - if (seen_period) { - return make_real(accumulator / pow(10, places_of_decimals)); - } - else - { - return make_integer( accumulator); - } + if (seen_period) { + return make_real(accumulator / pow(10, places_of_decimals)); + } else { + return make_integer(accumulator); + } } - /** * 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 result= NIL; +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))); - } else { - fprintf( stderr, "End of list detected\n"); - } + 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"); + } - return result; + return result; } - /** * Read a string. This means either a string delimited by double quotes * (is_quoted == true), in which case it may contain whitespace but may @@ -140,73 +141,75 @@ struct cons_pointer read_list( FILE* input, wint_t initial) { * 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 cdr = NIL; - struct cons_pointer result; +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) { - case '\0': - result = make_string( initial, NIL); - break; - case '"': - result = make_string( '\0', NIL); - break; - default: - 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 cdr = NIL; - struct cons_pointer result; - - fwprintf( stderr, L"read_symbol starting '%C' (%d)\n", - initial, initial); - - switch ( initial) { - case '\0': - result = make_symbol( initial, NIL); - break; - case '"': - /* THIS IS NOT A GOOD IDEA, but is legal */ - result = make_symbol( initial, read_symbol( input, fgetwc( input))); - break; - case ')' : - /* unquoted strings may not include right-parenthesis */ - result = make_symbol( '\0', NIL); - /* push back the character read */ - ungetwc( initial, input); - break; - default: - if ( iswblank( initial) || !iswprint( initial)) { - result = make_symbol( '\0', NIL); - /* push back the character read */ - ungetwc( initial, input); - } else { - result = make_symbol( initial, read_symbol( input, fgetwc( input))); + switch (initial) { + case '\0': + result = make_string(initial, NIL); + break; + case '"': + result = make_string('\0', NIL); + break; + default: + result = make_string(initial, read_string(input, fgetwc(input))); + break; } - break; - } - return result; + return result; } +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); + + switch (initial) { + case '\0': + result = make_symbol(initial, NIL); + break; + case '"': + /* + * THIS IS NOT A GOOD IDEA, but is legal + */ + result = make_symbol(initial, read_symbol(input, fgetwc(input))); + break; + case ')': + /* + * unquoted strings may not include right-parenthesis + */ + result = make_symbol('\0', NIL); + /* + * push back the character read + */ + ungetwc(initial, input); + break; + default: + if (iswblank(initial) || !iswprint(initial)) { + result = make_symbol('\0', NIL); + /* + * push back the character read + */ + ungetwc(initial, input); + } else { + result = make_symbol(initial, read_symbol(input, fgetwc(input))); + } + break; + } + + return result; +} /** * 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 00e74c8..123e743 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 5805248..0cd6803 100644 --- a/src/real.c +++ b/src/real.c @@ -14,11 +14,11 @@ * @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); - cell->payload.real.value = value; +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; + return result; } - diff --git a/src/real.h b/src/real.h index 261b0fa..9c0e1b9 100644 --- a/src/real.h +++ b/src/real.h @@ -4,7 +4,7 @@ * and open the template in the editor. */ -/* +/* * File: real.h * Author: simon * @@ -24,12 +24,9 @@ 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 } #endif - -#endif /* REAL_H */ - +#endif /* REAL_H */ diff --git a/src/repl.c b/src/repl.c index 8afda16..d49fad8 100644 --- a/src/repl.c +++ b/src/repl.c @@ -21,22 +21,22 @@ * @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) +{ while (!feof(in_stream)) { if (show_prompt) { - fwprintf( out_stream, L"\n:: "); + fwprintf(out_stream, L"\n:: "); } - struct cons_pointer input = read( in_stream); - fwprintf( error_stream, L"\nread {%d,%d}=> ", input.page, input.offset); + 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-> "); + 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, 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); } } - - diff --git a/src/repl.h b/src/repl.h index 7aff455..55a12d7 100644 --- a/src/repl.h +++ b/src/repl.h @@ -4,7 +4,7 @@ * and open the template in the editor. */ -/* +/* * File: repl.h * Author: simon * @@ -25,13 +25,10 @@ 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 } #endif - -#endif /* REPL_H */ - +#endif /* REPL_H */ diff --git a/src/stack.c b/src/stack.c index 8894ff3..049f892 100644 --- a/src/stack.c +++ b/src/stack.c @@ -29,82 +29,95 @@ * 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) { - /* TODO: later, pop a frame off a free-list of stack frames */ - struct stack_frame* result = malloc( sizeof( struct stack_frame)); +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)); - result->previous = previous; + result->previous = previous; - /* clearing the frame with memset would probably be slightly quicker, but - * this is clear. */ - result->more = NIL; - result->function = NIL; + /* + * clearing the frame with memset would probably be slightly quicker, but + * this is clear. + */ + result->more = NIL; + result->function = NIL; - 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 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); - - 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]); - - args = cell.payload.cons.cdr; - } else { - /* TODO: this isn't right. These args should also each be evaled. */ - result->more = args; - inc_ref( result->more); - - args = NIL; + for (int i = 0; i < args_in_frame; i++) { + result->arg[i] = NIL; } - } - return result; + int i = 0; /* still an index into args, so same name will + * do */ + + 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); + + 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]); + + args = cell.payload.cons.cdr; + } else { + /* + * TODO: this isn't right. These args should also each be evaled. + */ + result->more = args; + inc_ref(result->more); + + args = NIL; + } + } + + return result; } /** * Free this stack 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]); - } - dec_ref( frame->more); - - free( 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]); + } + dec_ref(frame->more); + + 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 result = NIL; - - 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; +struct cons_pointer fetch_arg(struct stack_frame *frame, unsigned int index) +{ + struct cons_pointer result = NIL; + + 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; + } + + result = pointer2cell(p).payload.cons.car; } - result = pointer2cell( p).payload.cons.car; - } - - return result; + return result; } diff --git a/src/stack.h b/src/stack.h index 9cb95a1..25ce84b 100644 --- a/src/stack.h +++ b/src/stack.h @@ -24,13 +24,15 @@ #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 - * TODO: refactor. */ +/* + * struct stack_frame is defined in consspaceobject.h to break circularity + * TODO: refactor. + */ #endif diff --git a/src/version.h b/src/version.h index 3603e70..445229f 100644 --- a/src/version.h +++ b/src/version.h @@ -8,5 +8,4 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ - #define VERSION "0.0.0"