diff --git a/.gitignore b/.gitignore index f26dde3..ecd8e8f 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,5 @@ *.o target/ + +nbproject/ diff --git a/Makefile b/Makefile index 144dbf5..84bf081 100644 --- a/Makefile +++ b/Makefile @@ -11,10 +11,11 @@ INC_FLAGS := $(addprefix -I,$(INC_DIRS)) VERSION := "0.0.0" -CPPFLAGS ?= $(INC_FLAGS) -MMD -MP +CPPFLAGS ?= $(INC_FLAGS) -MMD -MP +LDFLAGS := -lm $(TARGET): $(OBJS) - $(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LOADLIBES) $(LDLIBS) + $(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) .PHONY: clean clean: diff --git a/src/consspaceobject.c b/src/consspaceobject.c index f9420d6..afc0002 100644 --- a/src/consspaceobject.c +++ b/src/consspaceobject.c @@ -66,34 +66,37 @@ void dec_ref( struct cons_pointer pointer) { */ void dump_object( FILE* output, struct cons_pointer pointer) { struct cons_space_object cell = pointer2cell(pointer); - fprintf( output, - "\tDumping object at page %d, offset %d with tag %c%c%c%c (%d), count %u\n", - pointer.page, - pointer.offset, + 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)) { - fprintf( output, - "\tCons cell: car at page %d offset %d, cdr at page %d offset %d\n", + 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)) { - fprintf( output, "\t\tInteger cell: value %ld\n", cell.payload.integer.value); + fwprintf( output, + L"\t\tInteger cell: value %ld\n", + cell.payload.integer.value); } else if ( check_tag( pointer, FREETAG)) { - fprintf( output, "\t\tFree cell: next at page %d offset %d\n", + fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset); } else if ( check_tag(pointer, REALTAG)) { - fprintf( output, "\t\tReal cell: value %Lf\n", cell.payload.real.value); + fwprintf( output, L"\t\tReal cell: value %Lf\n", cell.payload.real.value); } else if ( check_tag( pointer, STRINGTAG)) { - fwprintf( output, L"\t\tString cell: character '%C' next at page %d offset %d\n", - cell.payload.string.character, cell.payload.string.cdr.page, - cell.payload.string.cdr.offset); - }; + 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); + } } @@ -150,7 +153,7 @@ struct cons_pointer make_string_like_thing( wint_t c, cell->payload.string.cdr.page = tail.page; cell->payload.string.cdr.offset = tail.offset; } else { - fprintf( stderr, "Warning: only NIL and %s can be appended to %s\n", + fwprintf( stderr, L"Warning: only NIL and %s can be appended to %s\n", tag, tag); } diff --git a/src/consspaceobject.h b/src/consspaceobject.h index 4729061..b3e80cd 100644 --- a/src/consspaceobject.h +++ b/src/consspaceobject.h @@ -67,6 +67,7 @@ * A real number. */ #define REALTAG "REAL" +#define REALTV 1279346002 /** * A special form - one whose arguments are not pre-evaluated but passed as a diff --git a/src/init.c b/src/init.c index 1cee833..aeb5dfd 100644 --- a/src/init.c +++ b/src/init.c @@ -9,15 +9,17 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include +#include +#include #include "version.h" #include "conspage.h" #include "consspaceobject.h" #include "intern.h" #include "lispops.h" -#include "print.h" -#include "read.h" +#include "repl.h" void bind_function( char* name, struct cons_pointer (*executable) (struct stack_frame*, struct cons_pointer)) { @@ -33,36 +35,61 @@ void bind_special( char* name, struct cons_pointer (*executable) } int main (int argc, char *argv[]) { - fprintf( stderr, "Post scarcity software environment version %s\n", VERSION); - initialise_cons_pages(); + /* 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) + { + case 'd': + dump_at_end = true; + break; + case 'p': + show_prompt = true; + break; + default: + fprintf( stderr, "Unexpected option %c\n", option); + break; + } + } - /* 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); + if (show_prompt) { + fprintf( stdout, "Post scarcity software environment version %s\n\n", VERSION); + } + + initialise_cons_pages(); - /* 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); + /* 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 special forms */ - bind_special( "apply", &lisp_apply); - bind_special( "eval", &lisp_eval); - bind_special( "quote", &lisp_quote); + /* 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); - fprintf( stderr, "\n:: "); - struct cons_pointer input = read( stdin); - fprintf( stderr, "\nread {%d,%d}=> ", input.page, input.offset); - print( stdout, input); - fprintf( stderr, "\neval {%d,%d}=> ", input.page, input.offset); - // print( stdout, lisp_eval( input, oblist, NULL)); + /* primitive special forms */ + bind_special( "apply", &lisp_apply); + bind_special( "eval", &lisp_eval); + bind_special( "quote", &lisp_quote); - dump_pages(stderr); - - return(0); + repl(stdin, stdout, stderr, show_prompt); + // print( stdout, lisp_eval( input, oblist, NULL)); + + if ( dump_at_end) { + dump_pages(stderr); + } + + return(0); } diff --git a/src/print.c b/src/print.c index 36e0fa9..78c209a 100644 --- a/src/print.c +++ b/src/print.c @@ -34,9 +34,9 @@ void print_string_contents( FILE* output, struct cons_pointer pointer) { void print_string( FILE* output, struct cons_pointer pointer) { - fputc( '"', output); + fputwc( btowc('"'), output); print_string_contents( output, pointer); - fputc( '"', output); + fputwc( btowc('"'), output); } /** @@ -49,7 +49,7 @@ void print_list_contents( FILE* output, struct cons_pointer pointer, switch ( cell->tag.value) { case CONSTV : if (initial_space) { - fputc( ' ', output); + fputwc( btowc(' '), output); } print( output, cell->payload.cons.car); @@ -58,16 +58,16 @@ void print_list_contents( FILE* output, struct cons_pointer pointer, case NILTV: break; default: - fprintf( output, " . "); + fwprintf( output, L" . "); print( output, pointer); } } void print_list( FILE* output, struct cons_pointer pointer) { - fputc( '(', output); + fputwc( btowc('('), output); print_list_contents( output, pointer, false); - fputc( ')', output); + fputwc( btowc(')'), output); } void print( FILE* output, struct cons_pointer pointer) { @@ -77,27 +77,31 @@ void print( FILE* output, struct cons_pointer pointer) { * 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 : - fprintf( output, "%ld", cell.payload.integer.value); - break; - case NILTV : - fprintf( output, "nil"); - break; - case STRINGTV : - print_string( output, pointer); - break; - case SYMBOLTV : - print_string_contents( output, pointer); - break; - case TRUETV : - fprintf( output, "t"); - break; - default : - fprintf( stderr, "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]); + 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; } } diff --git a/src/read.c b/src/read.c index d45b628..d1f7753 100644 --- a/src/read.c +++ b/src/read.c @@ -8,6 +8,7 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include #include /* wide characters */ @@ -18,6 +19,7 @@ #include "integer.h" #include "intern.h" #include "read.h" +#include "real.h" /* for the time being things which may be read are: strings @@ -87,8 +89,8 @@ struct cons_pointer read_number( FILE* input, wint_t initial) { fprintf( stderr, "read_number starting '%c' (%d)\n", initial, initial); - for (c = initial; iswdigit( c); c = fgetwc( input)) { - if ( c == '.') { + for (c = initial; iswdigit( c) || c == btowc('.'); c = fgetwc( input)) { + if ( c == btowc('.')) { seen_period = true; } else { accumulator = accumulator * 10 + ((int)c - (int)'0'); @@ -102,7 +104,13 @@ struct cons_pointer read_number( FILE* input, wint_t initial) { /* push back the character read which was not a digit */ ungetwc( c, input); - return make_integer( accumulator); + if (seen_period) { + return make_real(accumulator / pow(10, places_of_decimals)); + } + else + { + return make_integer( accumulator); + } } diff --git a/src/real.c b/src/real.c new file mode 100644 index 0000000..5805248 --- /dev/null +++ b/src/real.c @@ -0,0 +1,24 @@ +/* + * To change this license header, choose License Headers in Project Properties. + * To change this template file, choose Tools | Templates + * and open the template in the editor. + */ + +#include "conspage.h" +#include "consspaceobject.h" +#include "read.h" + +/** + * Allocate a real number cell representing this value and return a cons + * pointer to it. + * @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; + + return result; +} + diff --git a/src/real.h b/src/real.h new file mode 100644 index 0000000..261b0fa --- /dev/null +++ b/src/real.h @@ -0,0 +1,35 @@ +/* + * To change this license header, choose License Headers in Project Properties. + * To change this template file, choose Tools | Templates + * and open the template in the editor. + */ + +/* + * File: real.h + * Author: simon + * + * Created on 14 August 2017, 17:25 + */ + +#ifndef REAL_H +#define REAL_H + +#ifdef __cplusplus +extern "C" { +#endif + +/** + * Allocate a real number cell representing this value and return a cons + * pointer to it. + * @param value the value to wrap; + * @return a real number cell wrapping this value. + */ +struct cons_pointer make_real( double value); + + +#ifdef __cplusplus +} +#endif + +#endif /* REAL_H */ + diff --git a/src/repl.c b/src/repl.c new file mode 100644 index 0000000..8afda16 --- /dev/null +++ b/src/repl.c @@ -0,0 +1,42 @@ +/* + * To change this license header, choose License Headers in Project Properties. + * To change this template file, choose Tools | Templates + * and open the template in the editor. + */ +#include +#include +#include + +#include "conspage.h" +#include "consspaceobject.h" +#include "intern.h" +#include "lispops.h" +#include "read.h" +#include "print.h" + +/** + * The read/eval/print loop + * @param in_stream the stream to read from; + * @param out_stream the stream to write to; + * @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) { + 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-> "); + } +// 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 new file mode 100644 index 0000000..7aff455 --- /dev/null +++ b/src/repl.h @@ -0,0 +1,37 @@ +/* + * To change this license header, choose License Headers in Project Properties. + * To change this template file, choose Tools | Templates + * and open the template in the editor. + */ + +/* + * File: repl.h + * Author: simon + * + * Created on 14 August 2017, 14:40 + */ + +#ifndef REPL_H +#define REPL_H + +#ifdef __cplusplus +extern "C" { +#endif + +/** + * The read/eval/print loop + * @param in_stream the stream to read from; + * @param out_stream the stream to write to; + * @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); + + +#ifdef __cplusplus +} +#endif + +#endif /* REPL_H */ + diff --git a/unit-tests/complex-list.sh b/unit-tests/complex-list.sh index 6376fd6..c4c8e94 100644 --- a/unit-tests/complex-list.sh +++ b/unit-tests/complex-list.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='(1 2 3 ("Fred") nil 77354)' -actual=`echo '(1 2 3 ("Fred") () 77354)' | target/psse 2> /dev/null` +actual=`echo '(1 2 3 ("Fred") () 77354)' | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/empty-list.sh.bash b/unit-tests/empty-list.sh.bash new file mode 100644 index 0000000..8e5d0b0 --- /dev/null +++ b/unit-tests/empty-list.sh.bash @@ -0,0 +1,19 @@ +#!/bin/bash +# +# File: empty-list.sh.bash +# Author: simon +# +# Created on 14-Aug-2017, 15:06:40 +# + +expected=nil +actual=`echo '()' | target/psse 2> /dev/null | head -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" + exit 0 +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi diff --git a/unit-tests/empty-string.sh b/unit-tests/empty-string.sh index 2eccbe3..24bcd7a 100644 --- a/unit-tests/empty-string.sh +++ b/unit-tests/empty-string.sh @@ -1,7 +1,7 @@ #!/bin/bash expected="\"\"" -actual=`echo '""' | target/psse 2> /dev/null` +actual=`echo '""' | target/psse 2> /dev/null | head -1` if [ "$expected" = "$actual" ] then diff --git a/unit-tests/fred.sh b/unit-tests/fred.sh index ebb03ac..62af33f 100644 --- a/unit-tests/fred.sh +++ b/unit-tests/fred.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='"Fred"' -actual=`echo ${expected} | target/psse 2> /dev/null` +actual=`echo ${expected} | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/integer.sh b/unit-tests/integer.sh index e2d41f1..828eace 100644 --- a/unit-tests/integer.sh +++ b/unit-tests/integer.sh @@ -1,7 +1,7 @@ #!/bin/bash expected="354" -actual=`echo ${expected} | target/psse 2> /dev/null` +actual=`echo ${expected} | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/nil.sh b/unit-tests/nil.sh index 5449330..8e9aea6 100644 --- a/unit-tests/nil.sh +++ b/unit-tests/nil.sh @@ -1,7 +1,7 @@ #!/bin/bash expected=nil -actual=`echo '()' | target/psse 2> /dev/null` +actual=`echo 'nil' | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/quote.sh b/unit-tests/quote.sh index 624bdfb..f7bf353 100644 --- a/unit-tests/quote.sh +++ b/unit-tests/quote.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='(quote Fred)' -actual=`echo "'Fred" | target/psse 2> /dev/null` +actual=`echo "'Fred" | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/quoted-list.sh b/unit-tests/quoted-list.sh index eb4e7f3..1d18369 100644 --- a/unit-tests/quoted-list.sh +++ b/unit-tests/quoted-list.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='(quote (123 (4 (5 nil)) Fred))' -actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2> /dev/null` +actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/simple-list.sh b/unit-tests/simple-list.sh index 9ee9719..8d0c758 100644 --- a/unit-tests/simple-list.sh +++ b/unit-tests/simple-list.sh @@ -1,7 +1,7 @@ #!/bin/bash expected="(1 2 3)" -actual=`echo '(1 2 3)' | target/psse 2> /dev/null` +actual=`echo '(1 2 3)' | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/string-with-spaces.sh b/unit-tests/string-with-spaces.sh index fb78b81..53e00c0 100644 --- a/unit-tests/string-with-spaces.sh +++ b/unit-tests/string-with-spaces.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='"Strings should be able to include spaces (and other stuff)!"' -actual=`echo ${expected} | target/psse 2> /dev/null` +actual=`echo ${expected} | target/psse 2> /dev/null | head -1` if [ "${expected}" = "${actual}" ] then