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

Progress, but there's something wrong with nlambdas

Browse source
This commit is contained in:
Simon Brooke 2018-12-13 23:20:34 +00:00
parent 11409301da
commit cec32eff54
12 changed files with 288 additions and 204 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
lisp/defun.lisp
View file

@ -2,17 +2,18 @@
;; to defun as a list of sexprs.
(set! defun!
(nlambda
(name args body)
(cond (symbolp name)
(set! name (apply lambda (cons args body))))))
form
(cond ((symbolp (car form))
(set! (car form) (apply lambda (cdr form)))))
(t nil)))
(defun! square (x) ((* x x)))
(defun! square (x) (* x x))
(set! defsp!
(nlambda
(name args body)
(cond (symbolp name)
(set! name (nlambda args body)))))
form
(cond (symbolp (car form))
(set! (car form) (apply nlambda (cdr form))))))
(defsp! cube (x) ((* x x x)))

4
lisp/fact.lisp Normal file
View file

@ -0,0 +1,4 @@
(set! fact
(lambda (n)
(cond ((= n 1) 1)
(true (* n (fact (- n 1)))))))

3
src/init.c
View file

@ -46,7 +46,7 @@ int main( int argc, char *argv[] ) {
bool dump_at_end = false;
bool show_prompt = false;
while ( ( option = getopt( argc, argv, "pd" ) ) != -1 ) {
while ( ( option = getopt( argc, argv, "pdc" ) ) != -1 ) {
switch ( option ) {
case 'c':
print_use_colours = true;
@ -108,6 +108,7 @@ int main( int argc, char *argv[] ) {
bind_special( "cond", &lisp_cond );
bind_special( "lambda", &lisp_lambda );
bind_special( "nlambda", &lisp_nlambda );
bind_special( "progn", &lisp_progn );
bind_special( "quote", &lisp_quote );
bind_special( "set!", &lisp_set_shriek );

111
src/lispops.c
View file

@ -92,12 +92,12 @@ struct cons_pointer eval_form( struct stack_frame *parent,
inc_ref( next->arg[0] );
result = lisp_eval( next, env );
if (!exceptionp( result)) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
return result;
}
@ -111,8 +111,8 @@ struct cons_pointer eval_forms( struct stack_frame *frame,
struct cons_pointer list,
struct cons_pointer env ) {
return consp( list ) ?
make_cons( eval_form( frame, c_car( list ), env ), eval_forms( frame, c_cdr( list), env)) :
NIL;
make_cons( eval_form( frame, c_car( list ), env ),
eval_forms( frame, c_cdr( list ), env ) ) : NIL;
}
@ -231,12 +231,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
inc_ref( fn_frame->arg[0] );
struct cons_pointer fn_pointer = lisp_eval( fn_frame, env );
if (!exceptionp( result)) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( fn_frame );
}
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( fn_frame );
}
struct cons_space_object fn_cell = pointer2cell( fn_pointer );
struct cons_pointer args = c_cdr( frame->arg[0] );
@ -251,12 +251,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
struct stack_frame *next =
make_stack_frame( frame, args, env );
result = ( *fn_cell.payload.special.executable ) ( next, env );
if (!exceptionp( result)) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
}
break;
case LAMBDATV:
@ -266,12 +266,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
fputws( L"Stack frame for lambda\n", stderr );
dump_frame( stderr, next );
result = eval_lambda( fn_cell, next, env );
if (!exceptionp( result)) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
}
break;
case NLAMBDATV:
@ -279,12 +279,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
struct stack_frame *next =
make_special_frame( frame, args, env );
result = ( *fn_cell.payload.special.executable ) ( next, env );
if (!exceptionp( result)) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
}
break;
case SPECIALTV:
@ -292,12 +292,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
struct stack_frame *next =
make_special_frame( frame, args, env );
result = ( *fn_cell.payload.special.executable ) ( next, env );
if (!exceptionp( result)) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
free_stack_frame( next );
}
}
break;
default:
@ -382,12 +382,16 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
}
break;
/*
* TODO:
* the Clojure practice of having a map serve in the function place of
* an s-expression is a good one and I should adopt it; also if the
* object is a consp it could be interpretable source code but in the
* long run I don't want an interpreter, and if I can get away without
* so much the better.
*/
default:
result = frame->arg[0];
break;
}
fputws( L"Eval returning ", stderr );
@ -616,7 +620,9 @@ lisp_type( struct stack_frame *frame, struct cons_pointer env ) {
/**
* Function; evaluate the forms which are listed in my single argument
* (progn forms...)
*
* Special form; evaluate the forms which are listed in my arguments
* sequentially and return the value of the last. This function is called 'do'
* in some dialects of Lisp.
*
@ -627,14 +633,17 @@ lisp_type( struct stack_frame *frame, struct cons_pointer env ) {
*/
struct cons_pointer
lisp_progn( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer remaining = frame->arg[0];
struct cons_pointer remaining = frame->more;
struct cons_pointer result = NIL;
while ( consp( remaining ) ) {
struct cons_space_object cell = pointer2cell( remaining );
result = eval_form( frame, cell.payload.cons.car, env );
for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
result = eval_form( frame, frame->arg[i], env );
}
remaining = cell.payload.cons.cdr;
while ( consp( remaining ) ) {
result = eval_form( frame, c_car( remaining ), env );
remaining = c_cdr( remaining );
}
return result;
@ -661,12 +670,16 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer env ) {
if ( consp( clause_pointer ) ) {
struct cons_space_object cell = pointer2cell( clause_pointer );
result = eval_form( frame, c_car( clause_pointer ), env);
if ( !nilp( result ) ) {
struct cons_pointer vals = eval_forms( frame, c_cdr( clause_pointer ), env );
while (consp( vals)) {
result = c_car(vals);
vals = c_cdr(vals);
}
if ( !nilp( eval_form( frame, cell.payload.cons.car, env ) ) ) {
struct stack_frame *next = make_empty_frame( frame, env );
next->arg[0] = cell.payload.cons.cdr;
inc_ref( next->arg[0] );
result = lisp_progn( next, env );
done = true;
}
} else if ( nilp( clause_pointer ) ) {

150
src/peano.c
View file

@ -25,6 +25,36 @@
#include "real.h"
#include "stack.h"
/**
* Internal guts of add. Dark and mysterious.
*/
struct cons_pointer add_accumulate( struct cons_pointer arg,
struct stack_frame *frame,
long int *i_accumulator,
long double *d_accumulator, int *is_int ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) {
case INTEGERTV:
( *i_accumulator ) += cell.payload.integer.value;
( *d_accumulator ) += numeric_value( arg );
break;
case REALTV:
( *d_accumulator ) += cell.payload.real.value;
( *is_int ) &= false;
break;
case EXCEPTIONTV:
result = arg;
break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot multiply: not a number" ), frame );
}
return result;
}
/**
* Add an indefinite number of numbers together
* @param env the evaluation environment - ignored;
@ -36,46 +66,21 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer result = NIL;
long int i_accumulator = 0;
long double d_accumulator = 0;
bool is_int = true;
int is_int = true;
for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
struct cons_space_object current = pointer2cell( frame->arg[i] );
switch ( current.tag.value ) {
case INTEGERTV:
i_accumulator += current.payload.integer.value;
d_accumulator += numeric_value( frame->arg[i] );
break;
case REALTV:
d_accumulator += current.payload.real.value;
is_int = false;
break;
default:
lisp_throw( c_string_to_lisp_string
( "Cannot add: not a number" ), frame );
}
result =
add_accumulate( frame->arg[i], frame, &i_accumulator,
&d_accumulator, &is_int );
}
struct cons_pointer more = frame->more;
while ( consp( more ) ) {
struct cons_pointer pointer = c_car( more );
more = c_cdr( more);
struct cons_space_object current = pointer2cell( pointer );
switch ( current.tag.value ) {
case INTEGERTV:
i_accumulator += current.payload.integer.value;
d_accumulator += numeric_value( pointer );
break;
case REALTV:
d_accumulator += current.payload.real.value;
is_int = false;
break;
default:
lisp_throw( c_string_to_lisp_string
( "Cannot add: not a number" ), frame );
}
result =
add_accumulate( c_car( more ), frame, &i_accumulator,
&d_accumulator, &is_int );
more = c_cdr( more );
}
if ( is_int ) {
@ -87,6 +92,36 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) {
return result;
}
/**
* Internal guts of multiply. Dark and mysterious.
*/
struct cons_pointer multiply_accumulate( struct cons_pointer arg,
struct stack_frame *frame,
long int *i_accumulator,
long double *d_accumulator,
int *is_int ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) {
case INTEGERTV:
( *i_accumulator ) *= cell.payload.integer.value;
( *d_accumulator ) *= numeric_value( arg );
break;
case REALTV:
( *d_accumulator ) *= cell.payload.real.value;
( *is_int ) &= false;
break;
case EXCEPTIONTV:
result = arg;
break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot multiply: not a number" ), frame );
}
return result;
}
/**
* Multiply an indefinite number of numbers together
* @param env the evaluation environment - ignored;
@ -98,53 +133,32 @@ lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer result = NIL;
long int i_accumulator = 1;
long double d_accumulator = 1;
bool is_int = true;
int is_int = true;
for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
struct cons_space_object arg = pointer2cell( frame->arg[i] );
switch ( arg.tag.value ) {
case INTEGERTV:
i_accumulator *= arg.payload.integer.value;
d_accumulator *= numeric_value( frame->arg[i] );
break;
case REALTV:
d_accumulator *= arg.payload.real.value;
is_int = false;
break;
default:
lisp_throw( c_string_to_lisp_string
( "Cannot multiply: not a number" ), frame );
}
for ( int i = 0;
i < args_in_frame && !nilp( frame->arg[i] ) && !exceptionp( result );
i++ ) {
result =
multiply_accumulate( frame->arg[i], frame, &i_accumulator,
&d_accumulator, &is_int );
}
struct cons_pointer more = frame->more;
while ( consp( more ) ) {
struct cons_pointer pointer = c_car( more );
more = c_cdr( more);
struct cons_space_object current = pointer2cell( pointer );
switch ( current.tag.value ) {
case INTEGERTV:
i_accumulator *= current.payload.integer.value;
d_accumulator *= numeric_value( pointer );
break;
case REALTV:
d_accumulator *= current.payload.real.value;
is_int = false;
break;
default:
lisp_throw( c_string_to_lisp_string
( "Cannot add: not a number" ), frame );
}
while ( consp( more ) && !exceptionp( result ) ) {
result =
multiply_accumulate( c_car( more ), frame, &i_accumulator,
&d_accumulator, &is_int );
more = c_cdr( more );
}
if ( !exceptionp( result ) ) {
if ( is_int ) {
result = make_integer( i_accumulator );
} else {
result = make_real( d_accumulator );
}
}
return result;
}

15
src/print.c
View file

@ -120,6 +120,9 @@ void print( FILE * output, struct cons_pointer pointer ) {
print_use_colours ? "\x1B[31m" : "" );
print_string_contents( output, cell.payload.exception.message );
break;
case FUNCTIONTV:
fwprintf( output, L"(Function)" );
break;
case INTEGERTV:
if ( print_use_colours ) {
fputws( L"\x1B[34m", output );
@ -141,6 +144,9 @@ void print( FILE * output, struct cons_pointer pointer ) {
cell.payload.lambda.
body ) ) );
break;
case READTV:
fwprintf( output, L"(Input stream)" );
break;
case REALTV:
/* TODO: using the C heap is a bad plan because it will fragment.
* As soon as I have working vector space I'll use a special purpose
@ -171,15 +177,12 @@ void print( FILE * output, struct cons_pointer pointer ) {
fputws( L"\x1B[1;33m", output );
print_string_contents( output, pointer );
break;
case TRUETV:
fwprintf( output, L"t" );
break;
case FUNCTIONTV:
fwprintf( output, L"(Function)" );
break;
case SPECIALTV:
fwprintf( output, L"(Special form)" );
break;
case TRUETV:
fwprintf( output, L"t" );
break;
default:
fwprintf( stderr,
L"%sError: Unrecognised tag value %d (%c%c%c%c)%s\n",

130
src/read.c
View file

@ -59,47 +59,59 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
for ( c = initial;
c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) );
switch ( c ) {
case ';':
for ( c = fgetwc( input ); c != '\n'; c = fgetwc( input ) );
/* skip all characters from semi-colon to the end of the line */
break;
case EOF:
result = lisp_throw( c_string_to_lisp_string
( "End of input while reading" ), frame );
break;
case '\'':
result =
c_quote( read_continuation( frame, input, fgetwc( input ) ) );
break;
case '(':
result = read_list( frame, input, fgetwc( input ) );
break;
case '"':
result = read_string( input, fgetwc( input ) );
break;
default:
if ( c == '.' ) {
wint_t next = fgetwc( input );
if ( iswdigit( next ) ) {
ungetwc( next, input );
result = read_number( input, c );
} else if ( iswblank( next ) ) {
/* dotted pair. TODO: this isn't right, we
* really need to backtrack up a level. */
result =
read_continuation( frame, input, fgetwc( input ) );
} else {
read_symbol( input, c );
if ( feof( input ) ) {
result =
make_exception( c_string_to_lisp_string
( "End of file while reading" ), frame );
} else {
switch ( c ) {
case ';':
for ( c = fgetwc( input ); c != '\n'; c = fgetwc( input ) );
/* skip all characters from semi-colon to the end of the line */
break;
case EOF:
result = lisp_throw( c_string_to_lisp_string
( "End of input while reading" ), frame );
break;
case '\'':
result =
c_quote( read_continuation
( frame, input, fgetwc( input ) ) );
break;
case '(':
result = read_list( frame, input, fgetwc( input ) );
break;
case '"':
result = read_string( input, fgetwc( input ) );
break;
case '.':
{
wint_t next = fgetwc( input );
if ( iswdigit( next ) ) {
ungetwc( next, input );
result = read_number( input, c );
} else if ( iswblank( next ) ) {
/* dotted pair. TODO: this isn't right, we
* really need to backtrack up a level. */
result =
read_continuation( frame, input, fgetwc( input ) );
} else {
read_symbol( input, c );
}
}
} else if ( iswdigit( c ) ) {
result = read_number( input, c );
} else if ( iswprint( c ) ) {
result = read_symbol( input, c );
} else {
fwprintf( stderr,
L"Unrecognised start of input character %c\n", c );
}
break;
default:
if ( iswdigit( c ) ) {
result = read_number( input, c );
} else if ( iswprint( c ) ) {
result = read_symbol( input, c );
} else {
result =
make_exception( c_string_to_lisp_string
( "Unrecognised start of input character" ),
frame );
}
}
}
return result;
@ -114,19 +126,16 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
int places_of_decimals = 0;
bool seen_period = false;
wint_t c;
fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial );
for ( c = initial; iswdigit( c ) || c == btowc( '.' );
c = fgetwc( input ) ) {
for ( c = initial; iswdigit( c )
|| c == btowc( '.' ); c = fgetwc( input ) ) {
if ( c == btowc( '.' ) ) {
seen_period = true;
} else {
accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
fwprintf( stderr, L"Added character %c, accumulator now %ld\n", c,
accumulator );
fwprintf( stderr,
L"Added character %c, accumulator now %ld\n",
c, accumulator );
if ( seen_period ) {
places_of_decimals++;
}
@ -137,11 +146,9 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
* push back the character read which was not a digit
*/
ungetwc( c, input );
if ( seen_period ) {
long double rv = ( long double )
( accumulator / pow( 10, places_of_decimals ) );
fwprintf( stderr, L"read_numer returning %Lf\n", rv );
result = make_real( rv );
} else {
@ -155,14 +162,15 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
* Read a list from this input stream, which no longer contains the opening
* left parenthesis.
*/
struct cons_pointer read_list( struct stack_frame *frame, FILE * input,
wint_t initial ) {
struct cons_pointer read_list( struct
stack_frame
*frame, FILE * input, wint_t initial ) {
struct cons_pointer result = NIL;
if ( initial != ')' ) {
fwprintf( stderr, L"read_list starting '%C' (%d)\n", initial,
initial );
struct cons_pointer car = read_continuation( frame, input, initial );
fwprintf( stderr,
L"read_list starting '%C' (%d)\n", initial, initial );
struct cons_pointer car = read_continuation( frame, input,
initial );
result = make_cons( car, read_list( frame, input, fgetwc( input ) ) );
} else {
fwprintf( stderr, L"End of list detected\n" );
@ -181,7 +189,6 @@ struct cons_pointer read_list( struct stack_frame *frame, FILE * input,
struct cons_pointer read_string( FILE * input, wint_t initial ) {
struct cons_pointer cdr = NIL;
struct cons_pointer result;
switch ( initial ) {
case '\0':
result = make_string( initial, NIL );
@ -201,7 +208,6 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) {
struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
struct cons_pointer cdr = NIL;
struct cons_pointer result;
switch ( initial ) {
case '\0':
result = make_symbol( initial, NIL );
@ -224,7 +230,8 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
ungetwc( initial, input );
break;
default:
if ( iswprint( initial ) && !iswblank( initial ) ) {
if ( iswprint( initial )
&& !iswblank( initial ) ) {
result =
make_symbol( initial,
read_symbol( input, fgetwc( input ) ) );
@ -241,13 +248,14 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
fputws( L"Read symbol '", stderr );
print( stderr, result );
fputws( L"'\n", stderr );
return result;
}
/**
* Read the next object on this input stream and return a cons_pointer to it.
*/
struct cons_pointer read( struct stack_frame *frame, FILE * input ) {
struct cons_pointer read( struct
stack_frame
*frame, FILE * input ) {
return read_continuation( frame, input, fgetwc( input ) );
}

23
src/repl.c
View file

@ -48,7 +48,10 @@ struct cons_pointer repl_eval( struct cons_pointer input ) {
frame->arg[0] = input;
struct cons_pointer result = lisp_eval( frame, oblist );
free_stack_frame( frame );
if ( !exceptionp( result ) ) {
free_stack_frame( frame );
}
return result;
}
@ -86,12 +89,20 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
fwprintf( out_stream, L"\n:: " );
}
struct cons_pointer val = repl_eval( repl_read( input_stream ) );
struct cons_pointer input = repl_read( input_stream );
/* suppress the 'end of stream' exception */
if ( !exceptionp( val ) &&
!feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
repl_print( output_stream, val );
if ( exceptionp( input ) ) {
break;
} else {
struct cons_pointer val = repl_eval( input );
/* suppress the 'end of stream' exception */
if ( !exceptionp( val ) &&
!feof( pointer2cell( input_stream ).payload.stream.
stream ) ) {
repl_print( output_stream, val );
}
}
}
}

8
src/stack.c
View file

@ -105,7 +105,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
inc_ref( more );
}
dump_frame( stderr, result );
dump_frame( stderr, result );
return result;
}
@ -176,9 +176,9 @@ void dump_frame( FILE * output, struct stack_frame *frame ) {
print( output, frame->arg[arg] );
fputws( L"\n", output );
}
fputws( L"More: \t", output);
print( output, frame->more);
fputws( L"\n", output );
fputws( L"More: \t", output );
print( output, frame->more );
fputws( L"\n", output );
}

13
unit-tests/many-args.sh Normal file
View file

@ -0,0 +1,13 @@
#!/bin/bash
expected="120"
actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse 2> /dev/null | head -2 | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '${expected}', got '${actual}'"
exit 1
fi

4
unit-tests/progn.sh
View file

@ -1,7 +1,7 @@
#!/bin/bash
expected='5'
actual=`echo "(progn '((add 2 3)))" | target/psse 2> /dev/null | head -2 | tail -1`
actual=`echo "(progn (add 2 3))" | target/psse 2> /dev/null | head -2 | tail -1`
if [ "${expected}" = "${actual}" ]
then
@ -12,7 +12,7 @@ else
fi
expected='"foo"'
actual=`echo "(progn '((add 2.5 3) \"foo\"))" | target/psse 2> /dev/null | head -2 | tail -1`
actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2> /dev/null | head -2 | tail -1`
if [ "${expected}" = "${actual}" ]
then

16
unit-tests/varargs.sh Normal file
View file

@ -0,0 +1,16 @@
#!/bin/bash
expected='(lambda l l)(1 2 3 4 5 6 7 8 9 10)'
actual=`target/psse 2>/dev/null <<EOF
(set! list (lambda l l))
(list 1 2 3 4 5 6 7 8 9 10)
EOF`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '${expected}', got '${actual}'"
exit 1
fi