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

Some improvement, but two unit tests fail.

Browse source
This commit is contained in:
simon 2017-08-14 17:57:23 +01:00
parent 48d4de668e
commit 31176e1f39
21 changed files with 288 additions and 85 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -4,3 +4,5 @@
*.o
target/
nbproject/

3
Makefile
View file

@ -12,9 +12,10 @@ INC_FLAGS := $(addprefix -I,$(INC_DIRS))
VERSION := "0.0.0"
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:

27
src/consspaceobject.c
View file

@ -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",
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);
}

1
src/consspaceobject.h
View file

@ -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

43
src/init.c
View file

@ -9,15 +9,17 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <stdbool.h>
#include <stdio.h>
#include <unistd.h>
#include <wchar.h>
#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,7 +35,34 @@ 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);
/* 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;
}
}
if (show_prompt) {
fprintf( stdout, "Post scarcity software environment version %s\n\n", VERSION);
}
initialise_cons_pages();
/* privileged variables (keywords) */
@ -55,14 +84,12 @@ int main (int argc, char *argv[]) {
bind_special( "eval", &lisp_eval);
bind_special( "quote", &lisp_quote);
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);
repl(stdin, stdout, stderr, show_prompt);
// print( stdout, lisp_eval( input, oblist, NULL));
if ( dump_at_end) {
dump_pages(stderr);
}
return(0);
}

24
src/print.c
View file

@ -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) {
@ -81,10 +81,13 @@ void print( FILE* output, struct cons_pointer pointer) {
print_list( output, pointer);
break;
case INTEGERTV :
fprintf( output, "%ld", cell.payload.integer.value);
fwprintf( output, L"%ld", cell.payload.integer.value);
break;
case NILTV :
fprintf( output, "nil");
fwprintf( output, L"nil");
break;
case REALTV:
fwprintf(output, L"%lf", cell.payload.real.value);
break;
case STRINGTV :
print_string( output, pointer);
@ -93,11 +96,12 @@ void print( FILE* output, struct cons_pointer pointer) {
print_string_contents( output, pointer);
break;
case TRUETV :
fprintf( output, "t");
fwprintf( output, L"t");
break;
default :
fprintf( stderr, "Error: Unrecognised tag value %d (%c%c%c%c)\n",
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;
}
}

12
src/read.c
View file

@ -8,6 +8,7 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <math.h>
#include <stdbool.h>
#include <stdio.h>
/* 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);
if (seen_period) {
return make_real(accumulator / pow(10, places_of_decimals));
}
else
{
return make_integer( accumulator);
}
}

24
src/real.c Normal file
View file

@ -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;
}

35
src/real.h Normal file
View file

@ -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 */

42
src/repl.c Normal file
View file

@ -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 <stdbool.h>
#include <stdio.h>
#include <wchar.h>
#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);
}
}

37
src/repl.h Normal file
View file

@ -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 */

2
unit-tests/complex-list.sh
View file

@ -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

19
unit-tests/empty-list.sh.bash Normal file
View file

@ -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

2
unit-tests/empty-string.sh
View file

@ -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

2
unit-tests/fred.sh
View file

@ -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

2
unit-tests/integer.sh
View file

@ -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

2
unit-tests/nil.sh
View file

@ -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

2
unit-tests/quote.sh
View file

@ -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

2
unit-tests/quoted-list.sh
View file

@ -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

2
unit-tests/simple-list.sh
View file

@ -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

2
unit-tests/string-with-spaces.sh
View file

@ -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