Compare commits
2 commits
3659103dd7
...
222368bf64
| Author | SHA1 | Date | |
|---|---|---|---|
| 222368bf64 | |||
| 5e6363e6ae |
40 changed files with 498 additions and 285 deletions
4
Makefile
4
Makefile
|
|
@ -11,6 +11,8 @@ 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
|
||||
|
|
@ -41,7 +43,7 @@ test: $(TESTS) Makefile $(TARGET)
|
|||
|
||||
.PHONY: clean
|
||||
clean:
|
||||
$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ core
|
||||
$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core
|
||||
|
||||
repl:
|
||||
$(TARGET) -p 2> psse.log
|
||||
|
|
|
|||
|
|
@ -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: expectedto be either
|
||||
* @param op a character representing the operation: expected to 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 >= SMALL_INT_LIMIT) {
|
||||
debug_print( L"acquire_integer passing to make_integer (too large)\n", DEBUG_ALLOC );
|
||||
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 );
|
||||
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,6 +251,10 @@ 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;
|
||||
|
|
@ -264,6 +268,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
|
|||
is_first_cell = false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
debug_print( L"add_integers returning: ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
|
|
@ -407,10 +412,16 @@ 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] );
|
||||
return ( digits % 3 == 0 ) ?
|
||||
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 ) ?
|
||||
make_string( L',', make_string( character,
|
||||
tail ) ) :
|
||||
make_string( character, tail );
|
||||
|
||||
debug_print_object( r, DEBUG_IO);
|
||||
debug_println( DEBUG_IO);
|
||||
|
||||
return r;
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
|
|||
|
|
@ -45,6 +45,8 @@ 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;
|
||||
|
||||
if ( ratiop( pointer ) ) {
|
||||
struct cons_space_object cell = pointer2cell( pointer );
|
||||
struct cons_space_object dividend =
|
||||
pointer2cell( cell.payload.ratio.dividend );
|
||||
|
|
@ -54,7 +56,6 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
|
|||
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 );
|
||||
|
|
@ -63,6 +64,8 @@ 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 ) );
|
||||
|
|
@ -70,6 +73,7 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
|
|||
}
|
||||
}
|
||||
}
|
||||
// TODO: else throw exception?
|
||||
|
||||
return result;
|
||||
|
||||
|
|
@ -311,23 +315,30 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
|
|||
if ( integerp( dividend ) && integerp( divisor ) ) {
|
||||
inc_ref( dividend );
|
||||
inc_ref( divisor );
|
||||
result = allocate_cell( RATIOTV );
|
||||
struct cons_space_object *cell = &pointer2cell( result );
|
||||
struct cons_pointer unsimplified = allocate_cell( RATIOTV );
|
||||
struct cons_space_object *cell = &pointer2cell( unsimplified );
|
||||
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 ratios, else false.
|
||||
* 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.
|
||||
*/
|
||||
bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
|
||||
bool result = false;
|
||||
|
|
|
|||
39
src/debug.c
39
src/debug.c
|
|
@ -1,4 +1,4 @@
|
|||
/**
|
||||
/*
|
||||
* debug.c
|
||||
*
|
||||
* Better debug log messages.
|
||||
|
|
@ -25,13 +25,17 @@
|
|||
#include "io/print.h"
|
||||
|
||||
/**
|
||||
* the controlling flags for `debug_print`; set in `init.c`, q.v.
|
||||
* @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.
|
||||
*/
|
||||
int verbosity = 0;
|
||||
|
||||
/**
|
||||
* print this debug `message` to stderr, if `verbosity` matches `level`.
|
||||
* `verbosity is a set of flags, see debug_print.h; so you can
|
||||
* @brief 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 ) {
|
||||
|
|
@ -44,6 +48,11 @@ 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 ) {
|
||||
|
|
@ -68,8 +77,9 @@ void debug_print_128bit( __int128_t n, int level ) {
|
|||
}
|
||||
|
||||
/**
|
||||
* print a line feed to stderr, if `verbosity` matches `level`.
|
||||
* `verbosity is a set of flags, see debug_print.h; so you can
|
||||
* @brief 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 ) {
|
||||
|
|
@ -83,8 +93,10 @@ void debug_println( int level ) {
|
|||
|
||||
|
||||
/**
|
||||
* `wprintf` adapted for the debug logging system. Print to stderr only
|
||||
* `verbosity` matches `level`. All other arguments as for `wprintf`.
|
||||
* @brief `wprintf` adapted for the debug logging system.
|
||||
*
|
||||
* Print to stderr only if `verbosity` matches `level`. All other arguments
|
||||
* as for `wprintf`.
|
||||
*/
|
||||
void debug_printf( int level, wchar_t *format, ... ) {
|
||||
#ifdef DEBUG
|
||||
|
|
@ -98,8 +110,10 @@ void debug_printf( int level, wchar_t *format, ... ) {
|
|||
}
|
||||
|
||||
/**
|
||||
* 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
|
||||
* @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
|
||||
* turn debugging on for only one part of the system.
|
||||
*/
|
||||
void debug_print_object( struct cons_pointer pointer, int level ) {
|
||||
|
|
@ -114,7 +128,10 @@ void debug_print_object( struct cons_pointer pointer, int level ) {
|
|||
}
|
||||
|
||||
/**
|
||||
* Like `dump_object`, q.v., but protected by the verbosity mechanism.
|
||||
* @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.
|
||||
*/
|
||||
void debug_dump_object( struct cons_pointer pointer, int level ) {
|
||||
#ifdef DEBUG
|
||||
|
|
|
|||
55
src/debug.h
55
src/debug.h
|
|
@ -1,4 +1,4 @@
|
|||
/**
|
||||
/*
|
||||
* debug.h
|
||||
*
|
||||
* Better debug log messages.
|
||||
|
|
@ -13,14 +13,67 @@
|
|||
#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
115
src/init.c
|
|
@ -65,6 +65,25 @@ 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
|
||||
|
|
@ -73,45 +92,75 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
|
|||
* the name on the source pointer. Would make stack frames potentially
|
||||
* more readable and aid debugging generally.
|
||||
*/
|
||||
void bind_function( wchar_t *name, struct cons_pointer ( *executable )
|
||||
struct cons_pointer 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( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
|
||||
make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
|
||||
n ),
|
||||
make_cons( make_cons( init_primitive_symbol, TRUE ),
|
||||
make_cons( make_cons( init_name_symbol, n ),
|
||||
NIL ) );
|
||||
|
||||
check_exception( deep_bind( n, make_function( meta, executable ) ),
|
||||
struct cons_pointer r = 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`.
|
||||
*/
|
||||
void bind_special( wchar_t *name, struct cons_pointer ( *executable )
|
||||
struct cons_pointer 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( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
|
||||
make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
|
||||
n ),
|
||||
NIL ) );
|
||||
|
||||
struct cons_pointer meta =
|
||||
make_cons( make_cons( init_primitive_symbol, TRUE ),
|
||||
make_cons( make_cons( init_name_symbol, n), NIL ) );
|
||||
|
||||
struct cons_pointer r =
|
||||
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 ) {
|
||||
return check_exception(
|
||||
deep_bind( c_string_to_lisp_symbol( name ), value ),
|
||||
"bind_value");
|
||||
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;
|
||||
}
|
||||
|
||||
void print_banner( ) {
|
||||
|
|
@ -187,21 +236,15 @@ 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 );
|
||||
|
|
@ -211,8 +254,8 @@ int main( int argc, char *argv[] ) {
|
|||
/*
|
||||
* privileged variables (keywords)
|
||||
*/
|
||||
bind_value( L"nil", NIL );
|
||||
bind_value( L"t", TRUE );
|
||||
bind_symbol_value( privileged_symbol_nil, NIL, true);
|
||||
bind_value( L"t", TRUE, true );
|
||||
|
||||
/*
|
||||
* standard input, output, error and sink streams
|
||||
|
|
@ -233,7 +276,7 @@ int main( int argc, char *argv[] ) {
|
|||
( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"system:standard input" ) ),
|
||||
NIL ) ) );
|
||||
NIL ) ), false );
|
||||
lisp_io_out = bind_value( C_IO_OUT,
|
||||
make_write_stream( file_to_url_file( stdout ),
|
||||
make_cons( make_cons
|
||||
|
|
@ -241,26 +284,26 @@ int main( int argc, char *argv[] ) {
|
|||
( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"system:standard output]" ) ),
|
||||
NIL ) ) );
|
||||
NIL ) ), false);
|
||||
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 ) ) );
|
||||
NIL ) ), false );
|
||||
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 ) ) );
|
||||
NIL ) ), false );
|
||||
/*
|
||||
* the default prompt
|
||||
*/
|
||||
prompt_name = bind_value( L"*prompt*",
|
||||
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
|
||||
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL, false );
|
||||
/*
|
||||
* primitive function operations
|
||||
*/
|
||||
|
|
@ -327,13 +370,15 @@ 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 );
|
||||
|
|
|
|||
|
|
@ -413,12 +413,8 @@ 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;
|
||||
}
|
||||
|
||||
|
|
@ -430,7 +426,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.
|
||||
*
|
||||
* * (read-char stream)
|
||||
* * (open url)
|
||||
*
|
||||
* @param frame my stack_frame.
|
||||
* @param frame_pointer a pointer to my stack_frame.
|
||||
|
|
@ -524,6 +520,8 @@ 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.
|
||||
|
|
|
|||
|
|
@ -170,13 +170,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
|
|||
url_fputwc( L'>', output );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
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 );
|
||||
|
|
|
|||
|
|
@ -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 ) {
|
||||
if ( cell->count > 0 && cell->count != UINT32_MAX) {
|
||||
cell->count--;
|
||||
|
||||
if ( cell->count == 0 ) {
|
||||
|
|
@ -307,10 +307,6 @@ 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 {
|
||||
|
|
|
|||
|
|
@ -94,9 +94,6 @@ 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;
|
||||
}
|
||||
|
||||
|
|
@ -118,9 +115,6 @@ 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.
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@
|
|||
// #include "print.h"
|
||||
|
||||
/**
|
||||
* The global object list/or, to put it differently, the root namespace.
|
||||
* @brief 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,6 +47,12 @@
|
|||
*/
|
||||
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
|
||||
|
|
@ -163,7 +169,6 @@ struct cons_pointer hashmap_keys( struct cons_pointer mapp ) {
|
|||
!nilp( c ); c = c_cdr( c ) ) {
|
||||
result = make_cons( c_car( c_car( c ) ), result );
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -260,6 +265,8 @@ 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
|
||||
|
|
@ -294,6 +301,8 @@ 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 );
|
||||
|
|
|
|||
|
|
@ -20,6 +20,8 @@
|
|||
#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 );
|
||||
|
|
|
|||
|
|
@ -1273,8 +1273,6 @@ 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);
|
||||
}
|
||||
|
|
@ -1338,7 +1336,6 @@ 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 ) ) {
|
||||
|
|
@ -1356,7 +1353,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
|
|||
dec_ref( input );
|
||||
dec_ref( output );
|
||||
dec_ref( prompt_name );
|
||||
dec_ref( env );
|
||||
dec_ref( new_env);
|
||||
|
||||
debug_printf(DEBUG_REPL, L"Leaving inner repl\n");
|
||||
|
||||
|
|
|
|||
|
|
@ -1,79 +1,92 @@
|
|||
#!/bin/bash
|
||||
|
||||
result=0;
|
||||
|
||||
echo -n "$0: Add two small integers... "
|
||||
|
||||
expected='5'
|
||||
actual=`echo "(add 2 3)" | target/psse | tail -1`
|
||||
actual=`echo "(add 2 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0: Add float to integer... "
|
||||
|
||||
expected='5.5'
|
||||
actual=`echo "(add 2.5 3)" | target/psse | tail -1`
|
||||
actual=`echo "(add 2.5 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
exit 0
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0: Add two rationals... "
|
||||
|
||||
expected='1/4'
|
||||
actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
|
||||
actual=`echo "(+ 3/14 1/28)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
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 | tail -1`
|
||||
actual=`echo "(+ 6 1/4)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
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 | tail -1`
|
||||
actual=`echo "(+ 1/4 6)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
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 's/0*$//' |\
|
||||
head -2 |\
|
||||
tail -1`
|
||||
sed -r '/^\s*$/d' |\
|
||||
sed 's/0*$//'
|
||||
|
||||
outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
|
||||
|
||||
if [ "${outcome}" = "1" ]
|
||||
if [ "${outcome}" -eq "1" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
result=`echo "${result} + 1" | bc `
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
|
|||
|
|
@ -1,24 +1,44 @@
|
|||
#!/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 | tail -1`
|
||||
actual=`echo "(append '(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}'"
|
||||
exit 1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0: Append two strings... "
|
||||
|
||||
expected='"hellodere"'
|
||||
actual=`echo '(append "hello" "dere")' | target/psse | tail -1`
|
||||
actual=`echo '(append "hello" "dere")' | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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}
|
||||
|
|
@ -1,13 +1,29 @@
|
|||
#!/bin/bash
|
||||
|
||||
result=1
|
||||
|
||||
echo -n "$0: Apply function to one argument... "
|
||||
expected='1'
|
||||
actual=`echo "(apply 'add '(1))"| target/psse | tail -1`
|
||||
actual=`echo "(apply 'add '(1))"| target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
exit 0
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
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}
|
||||
|
|
|
|||
|
|
@ -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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1`
|
||||
|
|
@ -20,17 +20,17 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "checking no bignum was created: "
|
||||
grep -v 'BIGNUM!' psse.log > /dev/null
|
||||
echo -n "$0: checking no bignum was created: "
|
||||
grep -v 'BIGNUM!' tmp/psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -52,17 +52,17 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0 => checking a bignum was created: "
|
||||
grep 'BIGNUM!' psse.log > /dev/null
|
||||
grep 'BIGNUM!' tmp/psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -85,17 +85,17 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0 => checking a bignum was created: "
|
||||
grep 'BIGNUM!' psse.log > /dev/null
|
||||
grep 'BIGNUM!' tmp/psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -118,17 +118,17 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "checking a bignum was created: "
|
||||
grep 'BIGNUM!' psse.log > /dev/null
|
||||
echo -n "$0 => checking a bignum was created: "
|
||||
grep 'BIGNUM!' tmp/psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -150,7 +150,7 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -171,7 +171,7 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -195,17 +195,17 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0 => checking a bignum was created: "
|
||||
grep 'BIGNUM!' psse.log > /dev/null
|
||||
grep 'BIGNUM!' tmp/psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -228,17 +228,17 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0 => checking a bignum was created: "
|
||||
grep 'BIGNUM!' psse.log > /dev/null
|
||||
grep 'BIGNUM!' tmp/psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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>psse.log`
|
||||
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
|
||||
|
||||
actual=`echo $output |\
|
||||
tail -1 |\
|
||||
|
|
@ -262,17 +262,17 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0 => checking a bignum was created: "
|
||||
grep 'BIGNUM!' psse.log > /dev/null
|
||||
grep 'BIGNUM!' tmp/psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${return}
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#!/bin/bash
|
||||
|
||||
return=0
|
||||
result=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}'"
|
||||
return=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "checking no bignum was created: "
|
||||
echo -n "$0 => checking no bignum was created: "
|
||||
grep -v 'BIGNUM!' psse.log > /dev/null
|
||||
if [ $? -eq "0" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail"
|
||||
return=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
#####################################################################
|
||||
|
|
@ -51,7 +51,7 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
#####################################################################
|
||||
|
|
@ -71,7 +71,7 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
|
||||
|
|
@ -93,7 +93,7 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
#####################################################################
|
||||
|
|
@ -113,7 +113,7 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
return=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${return}
|
||||
exit ${result}
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected='(1 2 3 ("Fred") nil 77,354)'
|
||||
actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse | tail -1`
|
||||
actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -2,26 +2,30 @@
|
|||
|
||||
result=0
|
||||
|
||||
echo -n "$0: cond with one clause... "
|
||||
|
||||
expected='5'
|
||||
actual=`echo "(cond ((equal 2 2) 5))" | target/psse | tail -1`
|
||||
actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0: cond with two clauses... "
|
||||
|
||||
expected='"should"'
|
||||
actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse | tail -1`
|
||||
actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
@ -2,26 +2,28 @@
|
|||
|
||||
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 | tail -1`
|
||||
actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '$expected', got '$actual'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
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 | tail -1`
|
||||
actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '$expected', got '$actual'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
#!/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
Normal file
47
unit-tests/list-test.sh
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
#!/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}
|
||||
|
|
@ -1,28 +1,30 @@
|
|||
#!/bin/bash
|
||||
|
||||
result=1
|
||||
result=0
|
||||
|
||||
echo -n "$0: plus with fifteen arguments... "
|
||||
|
||||
expected="120"
|
||||
actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1`
|
||||
actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
# check that all the args are actually being evaluated...
|
||||
echo -n "$0: 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 | 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 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
return ${result}
|
||||
exit ${result}
|
||||
|
|
|
|||
|
|
@ -5,9 +5,9 @@ result=0
|
|||
#####################################################################
|
||||
# Create an empty map using map notation
|
||||
expected='{}'
|
||||
actual=`echo "$expected" | target/psse | tail -1`
|
||||
actual=`echo "$expected" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
echo -n "Empty map using compact map notation: "
|
||||
echo -n "$0: 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 | tail -1`
|
||||
actual=`echo "(hashmap)" | target/psse 2>/dev/null | 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 | tail -1`
|
||||
actual=`echo "{:one 1 :two 2 :three 3}" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
echo -n "Map using map notation: "
|
||||
echo -n "$0: Map using map notation... "
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
|
|
@ -51,9 +51,10 @@ 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 | tail -1`
|
||||
actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" |\
|
||||
target/psse 2>/dev/null | tail -1`
|
||||
|
||||
echo -n "Map using (hashmap): "
|
||||
echo -n "$0: Map using (hashmap) with arguments... "
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
|
|
@ -65,9 +66,9 @@ fi
|
|||
#####################################################################
|
||||
# Keyword in function position
|
||||
expected='2'
|
||||
actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse | tail -1`
|
||||
actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
echo -n "Keyword in function position: "
|
||||
echo -n "$0: Keyword in function position... "
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
|
|
@ -80,9 +81,9 @@ fi
|
|||
#####################################################################
|
||||
# Map in function position
|
||||
expected='2'
|
||||
actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse | tail -1`
|
||||
actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
echo -n "Map in function position: "
|
||||
echo -n "$0: Map in function position... "
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
|
|
|
|||
|
|
@ -2,26 +2,30 @@
|
|||
|
||||
result=0
|
||||
|
||||
echo -n "$0: multiply two integers... "
|
||||
|
||||
expected='6'
|
||||
actual=`echo "(multiply 2 3)" | target/psse | tail -1`
|
||||
actual=`echo "(multiply 2 3)" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0: multiply a real by an integer... "
|
||||
|
||||
expected='7.5'
|
||||
actual=`echo "(multiply 2.5 3)" | target/psse | tail -1`
|
||||
actual=`echo "(multiply 2.5 3)" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected=nil
|
||||
actual=`echo 'nil' | target/psse | tail -1`
|
||||
actual=`echo 'nil' | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -4,8 +4,9 @@ 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 | tail -1`
|
||||
actual=`echo "'/:users:simon:functions/assoc" | target/psse 2>&1 | tail -1`
|
||||
|
||||
echo -n "Path from root (oblist) using compact notation: "
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
|
|
@ -13,21 +14,21 @@ then
|
|||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
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 | tail -1`
|
||||
actual=`echo "'$:input-stream" | target/psse 2>/dev/null | 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=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
|
|||
|
|
@ -2,26 +2,28 @@
|
|||
|
||||
result=0
|
||||
|
||||
echo -n "$0: progn with one form... "
|
||||
expected='5'
|
||||
actual=`echo "(progn (add 2 3))" | target/psse | tail -1`
|
||||
actual=`echo "(progn (add 2 3))" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0: progn with two forms... "
|
||||
expected='"foo"'
|
||||
actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1`
|
||||
actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected='Fred'
|
||||
actual=`echo "'Fred" | target/psse | tail -1`
|
||||
actual=`echo "'Fred" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected='(123 (4 (5 nil)) Fred)'
|
||||
actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse | tail -1`
|
||||
actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected='1/4'
|
||||
actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
|
||||
actual=`echo "(+ 3/14 1/28)" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -2,30 +2,33 @@
|
|||
|
||||
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 | tail -1`
|
||||
actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
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 | tail -1`
|
||||
actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo -n "$0: reverse a symbol... "
|
||||
expected='esrever'
|
||||
actual=`echo "(reverse 'reverse)" | target/psse | tail -1`
|
||||
actual=`echo "(reverse 'reverse)" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
@ -33,8 +36,8 @@ then
|
|||
exit 0
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
echo ${result}
|
||||
exit ${result}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected="(1 2 3)"
|
||||
actual=`echo "'(1 2 3)" | target/psse | tail -1`
|
||||
actual=`echo "'(1 2 3)" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
#!/bin/bash
|
||||
|
||||
tmp=hi.$$
|
||||
tmp=tmp/hi.$$
|
||||
echo "Hello, there." > ${tmp}
|
||||
expected='"Hello, there.'
|
||||
actual=`echo "(slurp (open \"${tmp}\"))" | target/psse | tail -2 | head -1`
|
||||
actual=`echo "(slurp (open \"${tmp}\"))" | target/psse 2>&1 | tail -2 | head -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -2,28 +2,28 @@
|
|||
|
||||
result=0
|
||||
|
||||
# We should be able to cons a single character string onto the front of a string
|
||||
echo -n "$0: 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 | tail -1`
|
||||
actual=`echo '(cons "T" "est")' | target/psse 2>/dev/null | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
# But if the first argument has more than one character, we should get a dotted pair
|
||||
echo -n "$0: 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 | tail -1`
|
||||
actual=`echo '(cons "Test" "pass")' | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
result=1
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected='"Strings should be able to include spaces (and other stuff)!"'
|
||||
actual=`echo ${expected} | target/psse | tail -1`
|
||||
actual=`echo ${expected} | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -1,45 +1,54 @@
|
|||
#!/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 | tail -1`
|
||||
actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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 | tail -1`
|
||||
actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
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 | tail -1`
|
||||
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
expected=''
|
||||
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | tail -1`
|
||||
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`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
return=`echo "${return} + 1" | bc`
|
||||
fi
|
||||
|
||||
exit ${result}
|
||||
|
|
|
|||
|
|
@ -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 | tail -1`
|
||||
actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected='"λάμ(β)δα"'
|
||||
actual=`echo $expected | target/psse | tail -1`
|
||||
actual=`echo $expected | target/psse 2>&1 | tail -1`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue