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

Compare commits

base: simon:222368bf640a0b79d57322878dee42ed58b47bd6
Branches Tags
simon:master
simon:develop
simon:feature-2
simon:feature/all-integers-are-bignums
..
compare: simon:3659103dd7d6ee5e9f44c7a134fd01b825db99e0
Branches Tags
simon:develop
simon:feature-2
simon:master
simon:feature/all-integers-are-bignums

No commits in common. "222368bf640a0b79d57322878dee42ed58b47bd6" and "3659103dd7d6ee5e9f44c7a134fd01b825db99e0" have entirely different histories.
222368bf64 ... 3659103dd7

40 changed files with 284 additions and 497 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Makefile
View file

@ -11,8 +11,6 @@ TESTS := $(shell find unit-tests -name *.sh)
INC_DIRS := $(shell find $(SRC_DIRS) -type d)
INC_FLAGS := $(addprefix -I,$(INC_DIRS))
TMP_DIR ?= ./tmp
INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \
-d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \
-npsl -nsc -nsob -nss -nut -prs -l79 -ts2
@ -43,7 +41,7 @@ test: $(TESTS) Makefile $(TARGET)
.PHONY: clean
clean:
$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core
$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ core
repl:
$(TARGET) -p 2> psse.log

39
src/arith/integer.c
View file

@ -55,7 +55,7 @@ struct cons_pointer small_int_cache[SMALL_INT_LIMIT];
* Low level integer arithmetic, do not use elsewhere.
*
* @param c a pointer to a cell, assumed to be an integer cell;
* @param op a character representing the operation: expected to be either
* @param op a character representing the operation: expectedto be either
* '+' or '*'; behaviour with other values is undefined.
* @param is_first_cell true if this is the first cell in a bignum
* chain, else false.
@ -128,8 +128,8 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
struct cons_pointer result;
if ( !nilp( more) || value < 0 || value >= SMALL_INT_LIMIT) {
debug_print( L"acquire_integer passing to make_integer (outside small int range)\n", DEBUG_ALLOC );
if ( !nilp( more) || value >= SMALL_INT_LIMIT) {
debug_print( L"acquire_integer passing to make_integer (too large)\n", DEBUG_ALLOC );
result = make_integer( value, more);
} else {
if ( !small_int_cache_initialised) {
@ -239,7 +239,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
__int128_t av = cell_value( a, '+', is_first_cell );
__int128_t bv = cell_value( b, '+', is_first_cell );
__int128_t rv = (av + bv) + carry;
__int128_t rv = av + bv + carry;
debug_print( L"add_integers: av = ", DEBUG_ARITH );
debug_print_128bit( av, DEBUG_ARITH );
@ -251,22 +251,17 @@ struct cons_pointer add_integers( struct cons_pointer a,
debug_print_128bit( rv, DEBUG_ARITH );
debug_print( L"\n", DEBUG_ARITH );
if ( carry == 0 && ( rv >= 0 || rv < SMALL_INT_LIMIT)) {
result = acquire_integer( (int64_t)(rv & 0xffffffff), NIL);
break;
} else {
struct cons_pointer new = make_integer( 0, NIL );
carry = int128_to_integer( rv, cursor, new );
cursor = new;
struct cons_pointer new = make_integer( 0, NIL );
carry = int128_to_integer( rv, cursor, new );
cursor = new;
if ( nilp( result ) ) {
result = cursor;
}
a = pointer2cell( a ).payload.integer.more;
b = pointer2cell( b ).payload.integer.more;
is_first_cell = false;
if ( nilp( result ) ) {
result = cursor;
}
a = pointer2cell( a ).payload.integer.more;
b = pointer2cell( b ).payload.integer.more;
is_first_cell = false;
}
}
@ -412,16 +407,10 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
struct cons_pointer integer_to_string_add_digit( int digit, int digits,
struct cons_pointer tail ) {
wint_t character = btowc( hex_digits[digit] );
debug_printf( DEBUG_IO, L"integer_to_string_add_digit: digit is %d, digits is %d; returning: ", digit, digits);
struct cons_pointer r = ( digits % 3 == 0 ) ?
return ( digits % 3 == 0 ) ?
make_string( L',', make_string( character,
tail ) ) :
make_string( character, tail );
debug_print_object( r, DEBUG_IO);
debug_println( DEBUG_IO);
return r;
}
/**

37
src/arith/ratio.c
View file

@ -45,17 +45,16 @@ int64_t least_common_multiple( int64_t m, int64_t n ) {
struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
struct cons_pointer result = pointer;
struct cons_space_object cell = pointer2cell( pointer );
struct cons_space_object dividend =
pointer2cell( cell.payload.ratio.dividend );
struct cons_space_object divisor =
pointer2cell( cell.payload.ratio.divisor );
if ( ratiop( pointer ) ) {
struct cons_space_object cell = pointer2cell( pointer );
struct cons_space_object dividend =
pointer2cell( cell.payload.ratio.dividend );
struct cons_space_object divisor =
pointer2cell( cell.payload.ratio.divisor );
if ( divisor.payload.integer.value == 1 ) {
result = pointer2cell( pointer ).payload.ratio.dividend;
} else {
if ( divisor.payload.integer.value == 1 ) {
result = pointer2cell( pointer ).payload.ratio.dividend;
} else {
if ( ratiop( pointer ) ) {
int64_t ddrv = dividend.payload.integer.value,
drrv = divisor.payload.integer.value,
gcd = greatest_common_divisor( ddrv, drrv );
@ -64,16 +63,13 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
if ( drrv / gcd == 1 ) {
result = acquire_integer( ddrv / gcd, NIL );
} else {
debug_printf( DEBUG_ARITH,
L"simplify_ratio: %ld/%ld => %ld/%ld\n", ddrv, drrv, ddrv/gcd, drrv/gcd);
result =
make_ratio( acquire_integer( ddrv / gcd, NIL ),
acquire_integer( drrv / gcd, NIL ) );
}
}
}
}
// TODO: else throw exception?
}
return result;
@ -315,30 +311,23 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
if ( integerp( dividend ) && integerp( divisor ) ) {
inc_ref( dividend );
inc_ref( divisor );
struct cons_pointer unsimplified = allocate_cell( RATIOTV );
struct cons_space_object *cell = &pointer2cell( unsimplified );
result = allocate_cell( RATIOTV );
struct cons_space_object *cell = &pointer2cell( result );
cell->payload.ratio.dividend = dividend;
cell->payload.ratio.divisor = divisor;
result = simplify_ratio( unsimplified);
if ( !eq( result, unsimplified)) { dec_ref( unsimplified); }
} else {
result =
throw_exception( c_string_to_lisp_string
( L"Dividend and divisor of a ratio must be integers" ),
NIL );
}
// debug_print( L"make_ratio returning:\n", DEBUG_ARITH);
debug_dump_object( result, DEBUG_ARITH );
return result;
}
/**
* True if a and be are identical rationals, else false.
*
* TODO: we need ways of checking whether rationals are equal
* to floats and to integers.
* True if a and be are identical ratios, else false.
*/
bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
bool result = false;

39
src/debug.c
View file

@ -1,4 +1,4 @@
/*
/**
* debug.c
*
* Better debug log messages.
@ -25,17 +25,13 @@
#include "io/print.h"
/**
* @brief the controlling flags for `debug_print`; set in `init.c`, q.v.
*
* Interpreted as a set o binary flags. The values are controlled by macros
* with names 'DEBUG_[A_Z]*' in `debug.h`, q.v.
* the controlling flags for `debug_print`; set in `init.c`, q.v.
*/
int verbosity = 0;
/**
* @brief print this debug `message` to stderr, if `verbosity` matches `level`.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* print this debug `message` to stderr, if `verbosity` matches `level`.
* `verbosity is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*/
void debug_print( wchar_t *message, int level ) {
@ -48,11 +44,6 @@ void debug_print( wchar_t *message, int level ) {
}
/**
* @brief print a 128 bit integer value to stderr, if `verbosity` matches `level`.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*
* stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc
*/
void debug_print_128bit( __int128_t n, int level ) {
@ -77,9 +68,8 @@ void debug_print_128bit( __int128_t n, int level ) {
}
/**
* @brief print a line feed to stderr, if `verbosity` matches `level`.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* print a line feed to stderr, if `verbosity` matches `level`.
* `verbosity is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*/
void debug_println( int level ) {
@ -93,10 +83,8 @@ void debug_println( int level ) {
/**
* @brief `wprintf` adapted for the debug logging system.
*
* Print to stderr only if `verbosity` matches `level`. All other arguments
* as for `wprintf`.
* `wprintf` adapted for the debug logging system. Print to stderr only
* `verbosity` matches `level`. All other arguments as for `wprintf`.
*/
void debug_printf( int level, wchar_t *format, ... ) {
#ifdef DEBUG
@ -110,10 +98,8 @@ void debug_printf( int level, wchar_t *format, ... ) {
}
/**
* @brief print the object indicated by this `pointer` to stderr, if `verbosity`
* matches `level`.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* print the object indicated by this `pointer` to stderr, if `verbosity`
* matches `level`.`verbosity is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*/
void debug_print_object( struct cons_pointer pointer, int level ) {
@ -128,10 +114,7 @@ void debug_print_object( struct cons_pointer pointer, int level ) {
}
/**
* @brief Like `dump_object`, q.v., but protected by the verbosity mechanism.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
* Like `dump_object`, q.v., but protected by the verbosity mechanism.
*/
void debug_dump_object( struct cons_pointer pointer, int level ) {
#ifdef DEBUG

55
src/debug.h
View file

@ -1,4 +1,4 @@
/*
/**
* debug.h
*
* Better debug log messages.
@ -13,67 +13,14 @@
#ifndef __debug_print_h
#define __debug_print_h
/**
* @brief Print messages debugging memory allocation.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_ALLOC 1
/**
* @brief Print messages debugging arithmetic operations.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_ARITH 2
/**
* @brief Print messages debugging symbol binding.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_BIND 4
/**
* @brief Print messages debugging bootstrapping and teardown.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_BOOTSTRAP 8
/**
* @brief Print messages debugging evaluation.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_EVAL 16
/**
* @brief Print messages debugging input/output operations.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_IO 32
/**
* @brief Print messages debugging lambda functions (interpretation).
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_LAMBDA 64
/**
* @brief Print messages debugging the read eval print loop.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_REPL 128
/**
* @brief Print messages debugging stack operations.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_STACK 256
extern int verbosity;

115
src/init.c
View file

@ -65,25 +65,6 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
return result;
}
struct cons_pointer init_name_symbol = NIL;
struct cons_pointer init_primitive_symbol = NIL;
void maybe_bind_init_symbols() {
if ( nilp( init_name_symbol)) {
init_name_symbol = c_string_to_lisp_keyword( L"name" );
}
if ( nilp( init_primitive_symbol)) {
init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
}
if ( nilp( privileged_symbol_nil)) {
privileged_symbol_nil = c_string_to_lisp_symbol( L"nil");
}
}
void free_init_symbols() {
dec_ref( init_name_symbol);
dec_ref( init_primitive_symbol);
}
/**
* Bind this compiled `executable` function, as a Lisp function, to
@ -92,75 +73,45 @@ void free_init_symbols() {
* the name on the source pointer. Would make stack frames potentially
* more readable and aid debugging generally.
*/
struct cons_pointer bind_function( wchar_t *name, struct cons_pointer ( *executable )
void bind_function( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta =
make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( init_name_symbol, n ),
make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
n ),
NIL ) );
struct cons_pointer r = check_exception(
deep_bind( n, make_function( meta, executable ) ),
check_exception( deep_bind( n, make_function( meta, executable ) ),
"bind_function");
dec_ref( n);
return r;
}
/**
* Bind this compiled `executable` function, as a Lisp special form, to
* this `name` in the `oblist`.
*/
struct cons_pointer bind_special( wchar_t *name, struct cons_pointer ( *executable )
void bind_special( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta =
make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( init_name_symbol, n), NIL ) );
make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
n ),
NIL ) );
struct cons_pointer r =
check_exception(deep_bind( n, make_special( meta, executable ) ),
check_exception(deep_bind( n, make_special( meta, executable ) ),
"bind_special");
dec_ref( n);
return r;
}
/**
* Bind this `value` to this `symbol` in the `oblist`.
*/
struct cons_pointer
bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value, bool lock) {
struct cons_pointer r = check_exception(
deep_bind( symbol, value ),
"bind_symbol_value");
if ( lock && !exceptionp( r)){
struct cons_space_object * cell = & pointer2cell( r);
cell->count = UINT32_MAX;
}
return r;
}
/**
* Bind this `value` to this `name` in the `oblist`.
*/
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value, bool lock ) {
struct cons_pointer p = c_string_to_lisp_symbol( name );
struct cons_pointer r = bind_symbol_value( p, value, lock);
dec_ref( p);
return r;
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) {
return check_exception(
deep_bind( c_string_to_lisp_symbol( name ), value ),
"bind_value");
}
void print_banner( ) {
@ -236,15 +187,21 @@ int main( int argc, char *argv[] ) {
}
}
initialise_cons_pages();
maybe_bind_init_symbols();
if ( show_prompt ) {
print_banner( );
}
initialise_cons_pages( );
// TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly.
// What actually goes wrong is:
// 1. the hashmap is created;
// 2. everything bound in init seems to get initialised properly;
// 3. the REPL starts up;
// 4. Anything typed into the REPL (except ctrl-D) results in immediate segfault.
// 5. If ctrl-D is the first thing typed into the REPL, shutdown proceeds normally.
// Hypothesis: binding stuff into a hashmap oblist either isn't happening or
// is wrking ok, but retrieving from a hashmap oblist is failing.
debug_print( L"About to initialise oblist\n", DEBUG_BOOTSTRAP );
oblist = make_hashmap( 32, NIL, TRUE );
@ -254,8 +211,8 @@ int main( int argc, char *argv[] ) {
/*
* privileged variables (keywords)
*/
bind_symbol_value( privileged_symbol_nil, NIL, true);
bind_value( L"t", TRUE, true );
bind_value( L"nil", NIL );
bind_value( L"t", TRUE );
/*
* standard input, output, error and sink streams
@ -276,7 +233,7 @@ int main( int argc, char *argv[] ) {
( L"url" ),
c_string_to_lisp_string
( L"system:standard input" ) ),
NIL ) ), false );
NIL ) ) );
lisp_io_out = bind_value( C_IO_OUT,
make_write_stream( file_to_url_file( stdout ),
make_cons( make_cons
@ -284,26 +241,26 @@ int main( int argc, char *argv[] ) {
( L"url" ),
c_string_to_lisp_string
( L"system:standard output]" ) ),
NIL ) ), false);
NIL ) ) );
bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ),
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard log" ) ),
NIL ) ), false );
NIL ) ) );
bind_value( L"*sink*", make_write_stream( sink,
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard sink" ) ),
NIL ) ), false );
NIL ) ) );
/*
* the default prompt
*/
prompt_name = bind_value( L"*prompt*",
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL, false );
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
/*
* primitive function operations
*/
@ -370,15 +327,13 @@ int main( int argc, char *argv[] ) {
repl( show_prompt );
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
dec_ref( oblist );
debug_dump_object( oblist, DEBUG_BOOTSTRAP );
if ( dump_at_end ) {
dump_pages( file_to_url_file( stdout ) );
}
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
dec_ref( oblist );
free_init_symbols();
summarise_allocation( );
curl_global_cleanup( );
return ( 0 );

8
src/io/io.c
View file

@ -413,8 +413,12 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
struct cons_pointer stream_name =
inputp ? lisp_io_in : lisp_io_out;
inc_ref( stream_name );
result = c_assoc( stream_name, env );
dec_ref( stream_name );
return result;
}
@ -426,7 +430,7 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
* to append, or error if the URL is faulty or indicates an unavailable
* resource.
*
* * (open url)
* * (read-char stream)
*
* @param frame my stack_frame.
* @param frame_pointer a pointer to my stack_frame.
@ -520,8 +524,6 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
* Function: return a string representing all characters from the stream
* indicated by arg 0; further arguments are ignored.
*
* TODO: it should be possible to optionally pass a string URL to this function,
*
* * (slurp stream)
*
* @param frame my stack_frame.

10
src/io/print.c
View file

@ -170,9 +170,13 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
url_fputwc( L'>', output );
break;
case INTEGERTV:
struct cons_pointer s = integer_to_string( pointer, 10 );
print_string_contents( output, s );
dec_ref( s );
if ( nilp( cell.payload.integer.more)) {
url_fwprintf( output, L"%ld", cell.payload.integer.value);
} else {
struct cons_pointer s = integer_to_string( pointer, 10 );
print_string_contents( output, s );
dec_ref( s );
}
break;
case KEYTV:
url_fputws( L":", output );

6
src/memory/consspaceobject.c
View file

@ -80,7 +80,7 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
struct cons_pointer dec_ref( struct cons_pointer pointer ) {
struct cons_space_object *cell = &pointer2cell( pointer );
if ( cell->count > 0 && cell->count != UINT32_MAX) {
if ( cell->count > 0 ) {
cell->count--;
if ( cell->count == 0 ) {
@ -307,6 +307,10 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
cell->payload.string.character = c;
cell->payload.string.cdr = tail;
/* \todo There's a problem here. Sometimes the offsets on
* strings are quite massively off. Fix is probably
* cell->payload.string.cdr = tail */
//cell->payload.string.cdr.offset = tail.offset;
cell->payload.string.hash = calculate_hash( c, tail );
} else {

6
src/memory/hashmap.c
View file

@ -94,6 +94,9 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
}
}
// TODO: I am not sure this is right! We do not inc_ref a string when
// we make it.
inc_ref(result);
return result;
}
@ -115,6 +118,9 @@ struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
struct cons_pointer result = hashmap_put( mapp, key, val );
struct cons_space_object *cell = &pointer2cell( result);
// if (cell->count <= 1) {
// inc_ref( result); // TODO: I DO NOT BELIEVE this is the right place!
// }
return result;
// TODO: else clone and return clone.

13
src/ops/intern.c
View file

@ -36,7 +36,7 @@
// #include "print.h"
/**
* @brief The global object list/or, to put it differently, the root namespace.
* The global object list/or, to put it differently, the root namespace.
* What is added to this during system setup is 'global', that is,
* visible to all sessions/threads. What is added during a session/thread is local to
* that session/thread (because shallow binding). There must be some way for a user to
@ -47,12 +47,6 @@
*/
struct cons_pointer oblist = NIL;
/**
* @brief the symbol `NIL`, which is special!
*
*/
struct cons_pointer privileged_symbol_nil = NIL;
/**
* Return a hash value for the structure indicated by `ptr` such that if
* `x`,`y` are two separate structures whose print representation is the same
@ -169,6 +163,7 @@ struct cons_pointer hashmap_keys( struct cons_pointer mapp ) {
!nilp( c ); c = c_cdr( c ) ) {
result = make_cons( c_car( c_car( c ) ), result );
}
}
}
@ -265,8 +260,6 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
return result;
}
// (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
/**
* Implementation of interned? in C. The final implementation if interned? will
* deal with stores which can be association lists or hashtables or hybrids of
@ -301,8 +294,6 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
// }
if (!nilp( c_assoc( key, store))) {
result = key;
} else if ( equal( key, privileged_symbol_nil)) {
result = privileged_symbol_nil;
}
} else {
debug_print( L"`", DEBUG_BIND );

2
src/ops/intern.h
View file

@ -20,8 +20,6 @@
#ifndef __intern_h
#define __intern_h
extern struct cons_pointer privileged_symbol_nil;
extern struct cons_pointer oblist;
uint32_t get_hash( struct cons_pointer ptr );

5
src/ops/lispops.c
View file

@ -1273,6 +1273,8 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
struct cons_pointer old_oblist = oblist;
struct cons_pointer new_env = env;
inc_ref( env );
if (truep(frame->arg[0])) {
new_env = set( prompt_name, frame->arg[0], new_env);
}
@ -1336,6 +1338,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer,
new_env );
inc_ref( expr );
if ( exceptionp( expr )
&& url_feof( pointer2cell( input ).payload.stream.stream ) ) {
@ -1353,7 +1356,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
dec_ref( input );
dec_ref( output );
dec_ref( prompt_name );
dec_ref( new_env);
dec_ref( env );
debug_printf(DEBUG_REPL, L"Leaving inner repl\n");

45
unit-tests/add.sh
View file

@ -1,92 +1,79 @@
#!/bin/bash
result=0;
echo -n "$0: Add two small integers... "
expected='5'
actual=`echo "(add 2 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
actual=`echo "(add 2 3)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
exit 1
fi
echo -n "$0: Add float to integer... "
expected='5.5'
actual=`echo "(add 2.5 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
actual=`echo "(add 2.5 3)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
exit 1
fi
echo -n "$0: Add two rationals... "
expected='1/4'
actual=`echo "(+ 3/14 1/28)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
exit 1
fi
echo -n "$0: Add an integer to a rational... "
# (+ integer ratio) should be ratio
expected='25/4'
actual=`echo "(+ 6 1/4)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
actual=`echo "(+ 6 1/4)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
exit 1
fi
echo -n "$0: Add a rational to an integer... "
# (+ ratio integer) should be ratio
expected='25/4'
actual=`echo "(+ 1/4 6)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
actual=`echo "(+ 1/4 6)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
exit 1
fi
echo -n "$0: Add a real to a rational... "
# (+ real ratio) should be real
# for this test, trailing zeros can be ignored
expected='6.25'
actual=`echo "(+ 6.000000001 1/4)" |\
target/psse 2> /dev/null |\
sed -r '/^\s*$/d' |\
sed 's/0*$//'
sed 's/0*$//' |\
head -2 |\
tail -1`
outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
if [ "${outcome}" -eq "1" ]
if [ "${outcome}" = "1" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc `
exit 1
fi
exit ${result}

28
unit-tests/append.sh
View file

@ -1,44 +1,24 @@
#!/bin/bash
return=0;
echo -n "$0: Append two lists... "
expected='(a b c d e f)'
actual=`echo "(append '(a b c) '(d e f))" | target/psse 2>/dev/null | tail -1`
actual=`echo "(append '(a b c) '(d e f))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
exit 1
fi
echo -n "$0: Append two strings... "
expected='"hellodere"'
actual=`echo '(append "hello" "dere")' | target/psse 2>/dev/null | tail -1`
actual=`echo '(append "hello" "dere")' | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
exit 1
fi
echo -n "$0: Append keyword to string should error... "
expected='Exception:'
actual=`echo '(append "hello" :dere)' | target/psse 2>/dev/null | sed -r '/^\s*$/d' | awk '{print $1}'`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
fi
exit ${return}

22
unit-tests/apply.sh
View file

@ -1,29 +1,13 @@
#!/bin/bash
result=1
echo -n "$0: Apply function to one argument... "
expected='1'
actual=`echo "(apply 'add '(1))"| target/psse 2>/dev/null | tail -1`
actual=`echo "(apply 'add '(1))"| target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
exit 1
fi
echo -n "$0: Apply function to multiple arguments... "
expected='3'
actual=`echo "(apply 'add '(1 2))"| target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
fi
exit ${result}

68
unit-tests/bignum-add.sh
View file

@ -9,7 +9,7 @@ a=1152921504606846975
b=1
c=`echo "$a + $b" | bc`
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1`
@ -20,17 +20,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
echo -n "$0: checking no bignum was created: "
grep -v 'BIGNUM!' tmp/psse.log > /dev/null
echo -n "checking no bignum was created: "
grep -v 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
return=`echo "${return} + 1" | bc`
return=1
fi
#####################################################################
@ -40,7 +40,7 @@ a='1152921504606846976'
b=1
c=`echo "$a + $b" | bc`
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -52,17 +52,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' tmp/psse.log > /dev/null
grep 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
return=`echo "${return} + 1" | bc`
return=1
fi
@ -73,7 +73,7 @@ a='1152921504606846977'
b=1
c=`echo "$a + $b" | bc`
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -85,17 +85,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' tmp/psse.log > /dev/null
grep 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
return=`echo "${return} + 1" | bc`
return=1
fi
#####################################################################
@ -106,7 +106,7 @@ a=1
b=1152921504606846977
c=`echo "$a + $b" | bc`
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -118,17 +118,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' tmp/psse.log > /dev/null
echo -n "checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
return=`echo "${return} + 1" | bc`
return=1
fi
@ -139,7 +139,7 @@ a=1152921504606846977
c=`echo "$a + $a" | bc`
echo -n "$0 => adding $a to $a: "
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -150,7 +150,7 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
#####################################################################
@ -160,7 +160,7 @@ a=1152921504606846977
c=`echo "$a * 5" | bc`
echo -n "$0 => adding $a, $a $a, $a, $a: "
expected='t'
output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -171,7 +171,7 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
@ -183,7 +183,7 @@ a=10000000000000000000
b=10000000000000000000
c=`echo "$a + $b" | bc`
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -195,17 +195,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' tmp/psse.log > /dev/null
grep 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
return=`echo "${return} + 1" | bc`
return=1
fi
@ -216,7 +216,7 @@ a=1
b=1329227995784915872903807060280344576
c=`echo "$a + $b" | bc`
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -228,17 +228,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' tmp/psse.log > /dev/null
grep 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
return=`echo "${return} + 1" | bc`
return=1
fi
@ -250,7 +250,7 @@ a=1
b=3064991081731777716716694054300618367237478244367204352
c=`echo "$a + $b" | bc`
expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
actual=`echo $output |\
tail -1 |\
@ -262,17 +262,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
return=1
fi
echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' tmp/psse.log > /dev/null
grep 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
return=`echo "${return} + 1" | bc`
return=1
fi
exit ${return}

18
unit-tests/bignum-subtract.sh
View file

@ -1,6 +1,6 @@
#!/bin/bash
result=0
return=0
#####################################################################
# subtract a smallnum from a smallnum to produce a smallnum
@ -20,17 +20,17 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
return=1
fi
echo -n "$0 => checking no bignum was created: "
echo -n "checking no bignum was created: "
grep -v 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
result=`echo "${result} + 1" | bc`
return=1
fi
#####################################################################
@ -51,7 +51,7 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
return=1
fi
#####################################################################
@ -71,7 +71,7 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
return=1
fi
@ -93,7 +93,7 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
return=1
fi
#####################################################################
@ -113,7 +113,7 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
return=1
fi
exit ${result}
exit ${return}

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

@ -1,7 +1,7 @@
#!/bin/bash
expected='(1 2 3 ("Fred") nil 77,354)'
actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse 2>/dev/null | tail -1`
actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

12
unit-tests/cond.sh
View file

@ -2,30 +2,26 @@
result=0
echo -n "$0: cond with one clause... "
expected='5'
actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2>/dev/null | tail -1`
actual=`echo "(cond ((equal 2 2) 5))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: cond with two clauses... "
expected='"should"'
actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2>/dev/null | tail -1`
actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}

10
unit-tests/let.sh
View file

@ -2,28 +2,26 @@
result=0
echo -n "$0: let with two bindings, one form in body..."
expected='11'
actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: let with two bindings, two forms in body..."
expected='1'
actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}

42
unit-tests/list-test,sh Normal file
View file

@ -0,0 +1,42 @@
#!/bin/bash
result=0
expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=1
fi
expected="(0 1 2 3 4)"
actual=`echo "(list 0 1 2 3 4)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=1
fi
expected="(0 1 2 3 4 5 6 7)"
actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '$expected', got '$actual'"
result=1
fi
exit ${result}

47
unit-tests/list-test.sh
View file

@ -1,47 +0,0 @@
#!/bin/bash
result=0
echo -n "$0: flat list with 16 elements... "
expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" |\
target/psse 2>/dev/null |\
tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=`echo "${result} + 1" | bc`
fi
echo -n "$0: flat list with 5 elements... "
expected="(0 1 2 3 4)"
actual=`echo "(list 0 1 2 3 4)" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=`echo "${result} + 1" | bc`
fi
echo -n "$0: flat list with 8 elements... "
expected="(0 1 2 3 4 5 6 7)"
actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '$expected', got '$actual'"
result=`echo "${result} + 1" | bc`
fi
exit ${result}

16
unit-tests/many-args.sh
View file

@ -1,30 +1,28 @@
#!/bin/bash
result=0
echo -n "$0: plus with fifteen arguments... "
result=1
expected="120"
actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse 2>/dev/null | tail -1`
actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: check that all the args are actually being evaluated... "
# check that all the args are actually being evaluated...
expected="120"
actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse 2>/dev/null | tail -1`
actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}
return ${result}

23
unit-tests/map.sh
View file

@ -5,9 +5,9 @@ result=0
#####################################################################
# Create an empty map using map notation
expected='{}'
actual=`echo "$expected" | target/psse 2>/dev/null | tail -1`
actual=`echo "$expected" | target/psse | tail -1`
echo -n "$0: Empty map using compact map notation... "
echo -n "Empty map using compact map notation: "
if [ "${expected}" = "${actual}" ]
then
echo "OK"
@ -19,7 +19,7 @@ fi
#####################################################################
# Create an empty map using make-map
expected='{}'
actual=`echo "(hashmap)" | target/psse 2>/dev/null | tail -1`
actual=`echo "(hashmap)" | target/psse | tail -1`
echo -n "Empty map using (make-map): "
if [ "${expected}" = "${actual}" ]
@ -35,9 +35,9 @@ fi
# significant at this stage, but in the long term should be sorted
# alphanumerically
expected='{:one 1, :two 2, :three 3}'
actual=`echo "{:one 1 :two 2 :three 3}" | target/psse 2>/dev/null | tail -1`
actual=`echo "{:one 1 :two 2 :three 3}" | target/psse | tail -1`
echo -n "$0: Map using map notation... "
echo -n "Map using map notation: "
if [ "${expected}" = "${actual}" ]
then
echo "OK"
@ -51,10 +51,9 @@ fi
# significant at this stage, but in the long term should be sorted
# alphanumerically
expected='{:one 1, :two 2, :three 3}'
actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" |\
target/psse 2>/dev/null | tail -1`
actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" | target/psse | tail -1`
echo -n "$0: Map using (hashmap) with arguments... "
echo -n "Map using (hashmap): "
if [ "${expected}" = "${actual}" ]
then
echo "OK"
@ -66,9 +65,9 @@ fi
#####################################################################
# Keyword in function position
expected='2'
actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse 2>/dev/null | tail -1`
actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse | tail -1`
echo -n "$0: Keyword in function position... "
echo -n "Keyword in function position: "
if [ "${expected}" = "${actual}" ]
then
echo "OK"
@ -81,9 +80,9 @@ fi
#####################################################################
# Map in function position
expected='2'
actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse 2>/dev/null | tail -1`
actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse | tail -1`
echo -n "$0: Map in function position... "
echo -n "Map in function position: "
if [ "${expected}" = "${actual}" ]
then
echo "OK"

12
unit-tests/multiply.sh
View file

@ -2,30 +2,26 @@
result=0
echo -n "$0: multiply two integers... "
expected='6'
actual=`echo "(multiply 2 3)" | target/psse 2>/dev/null | tail -1`
actual=`echo "(multiply 2 3)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: multiply a real by an integer... "
expected='7.5'
actual=`echo "(multiply 2.5 3)" | target/psse 2>/dev/null | tail -1`
actual=`echo "(multiply 2.5 3)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}

2
unit-tests/nil.sh
View file

@ -1,7 +1,7 @@
#!/bin/bash
expected=nil
actual=`echo 'nil' | target/psse 2>/dev/null | tail -1`
actual=`echo 'nil' | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

11
unit-tests/path-notation.sh
View file

@ -4,9 +4,8 @@ result=0
#####################################################################
# Create a path from root using compact path notation
echo -n "$0: Create a path from root using compact path notation... "
expected='(-> oblist :users :simon :functions (quote assoc))'
actual=`echo "'/:users:simon:functions/assoc" | target/psse 2>&1 | tail -1`
actual=`echo "'/:users:simon:functions/assoc" | target/psse | tail -1`
echo -n "Path from root (oblist) using compact notation: "
if [ "${expected}" = "${actual}" ]
@ -14,21 +13,21 @@ then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
#####################################################################
# Create a path from the current session using compact path notation
echo -n "$0: Create a path from the current session using compact path notation... "
expected='(-> session :input-stream)'
actual=`echo "'$:input-stream" | target/psse 2>/dev/null | tail -1`
actual=`echo "'$:input-stream" | target/psse | tail -1`
echo -n "Path from current session using compact notation: "
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}

10
unit-tests/progn.sh
View file

@ -2,28 +2,26 @@
result=0
echo -n "$0: progn with one form... "
expected='5'
actual=`echo "(progn (add 2 3))" | target/psse 2>/dev/null | tail -1`
actual=`echo "(progn (add 2 3))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: progn with two forms... "
expected='"foo"'
actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2>/dev/null | tail -1`
actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}

2
unit-tests/quote.sh
View file

@ -1,7 +1,7 @@
#!/bin/bash
expected='Fred'
actual=`echo "'Fred" | target/psse 2>&1 | tail -1`
actual=`echo "'Fred" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

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

@ -1,7 +1,7 @@
#!/bin/bash
expected='(123 (4 (5 nil)) Fred)'
actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2>&1 | tail -1`
actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

2
unit-tests/ratio-addition.sh
View file

@ -1,7 +1,7 @@
#!/bin/bash
expected='1/4'
actual=`echo "(+ 3/14 1/28)" | target/psse 2>&1 | tail -1`
actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

17
unit-tests/reverse.sh
View file

@ -2,33 +2,30 @@
result=0
echo -n "$0: reverse a string... "
expected='"god yzal eht revo depmuj xof nworb kciuq ehT"'
actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse 2>&1 | tail -1`
actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: reverse a list... "
expected='(1,024 512 256 128 64 32 16 8 4 2)'
actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse 2>&1 | tail -1`
actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: reverse a symbol... "
expected='esrever'
actual=`echo "(reverse 'reverse)" | target/psse 2>&1 | tail -1`
actual=`echo "(reverse 'reverse)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
@ -36,8 +33,8 @@ then
exit 0
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}
echo ${result}

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>&1 | tail -1`
actual=`echo "'(1 2 3)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

4
unit-tests/slurp.sh
View file

@ -1,9 +1,9 @@
#!/bin/bash
tmp=tmp/hi.$$
tmp=hi.$$
echo "Hello, there." > ${tmp}
expected='"Hello, there.'
actual=`echo "(slurp (open \"${tmp}\"))" | target/psse 2>&1 | tail -2 | head -1`
actual=`echo "(slurp (open \"${tmp}\"))" | target/psse | tail -2 | head -1`
if [ "${expected}" = "${actual}" ]
then

12
unit-tests/string-cons.sh
View file

@ -2,28 +2,28 @@
result=0
echo -n "$0: We should be able to cons a single character string onto the front of a string... "
# We should be able to cons a single character string onto the front of a string
expected='"Test"'
actual=`echo '(cons "T" "est")' | target/psse 2>/dev/null | tail -1`
actual=`echo '(cons "T" "est")' | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
echo -n "$0: But if the first argument has more than one character, we should get a dotted pair... "
# But if the first argument has more than one character, we should get a dotted pair
expected='("Test" . "pass")'
actual=`echo '(cons "Test" "pass")' | target/psse 2>&1 | tail -1`
actual=`echo '(cons "Test" "pass")' | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
result=`echo "${result} + 1" | bc`
result=1
fi
exit ${result}

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>&1 | tail -1`
actual=`echo ${expected} | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

27
unit-tests/try.sh
View file

@ -1,54 +1,45 @@
#!/bin/bash
result=0
echo -n "$0: if the body of a try errors, the last form in the catch block is returned... "
expected=':foo'
actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse 2>&1 | tail -1`
actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
exit 1
fi
echo -n "$0: if the body of a try errors, the last form in the catch block is evaluated... "
expected='4'
actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse 2>&1 | tail -1`
actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
exit 1
fi
echo -n "$0: body and catch block can optionally be marked with keywords... "
expected='8'
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse 2>&1 | tail -1`
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
exit 1
fi
echo -n "$0: the exception is bound to the symbol \`*exception*\` in the catch environment... "
expected='Exception: "Cannot divide: not a number"'
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse 2>&1 | grep Exception`
expected=''
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
exit 1
fi
exit ${result}

2
unit-tests/varargs.sh
View file

@ -1,7 +1,7 @@
#!/bin/bash
expected='(1 2 3 4 5 6 7 8 9 10)'
actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" | target/psse 2>&1 | tail -1`
actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" |target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then

2
unit-tests/wide-character.sh
View file

@ -1,7 +1,7 @@
#!/bin/bash
expected='"λάμ(β)δα"'
actual=`echo $expected | target/psse 2>&1 | tail -1`
actual=`echo $expected | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then