Compare commits
No commits in common. "af21e506efbf22884d5eb30fb1cbb504afe43a51" and "3665326c55b30dc485365926db0f6beff24aaa90" have entirely different histories.
af21e506ef
...
3665326c55
5 changed files with 40 additions and 65 deletions
|
|
@ -150,7 +150,7 @@ struct cons_pointer c_car( struct cons_pointer arg ) {
|
|||
|
||||
/**
|
||||
* Implementation of cdr in C. If arg is not a sequence, or the current user is
|
||||
* not authorised to read it, does not error but returns nil.
|
||||
* not authorised to read it,does not error but returns nil.
|
||||
*/
|
||||
struct cons_pointer c_cdr( struct cons_pointer arg ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
|
|
|||
|
|
@ -9,7 +9,6 @@
|
|||
|
||||
#include <math.h>
|
||||
#include <stdbool.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "arith/integer.h"
|
||||
#include "arith/peano.h"
|
||||
|
|
@ -364,38 +363,22 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
|
|||
/* TODO: it is not OK to do this on the stack since list-like
|
||||
* structures can be of indefinite extent. It *must* be done by
|
||||
* iteration (and even that is problematic) */
|
||||
if (cell_a->payload.string.hash == cell_b->payload.string.hash) {
|
||||
wchar_t a_buff[ STRING_SHIPYARD_SIZE], b_buff[ STRING_SHIPYARD_SIZE];
|
||||
uint32_t tag = cell_a->tag.value;
|
||||
int i = 0;
|
||||
|
||||
memset(a_buff,0,sizeof(a_buff));
|
||||
memset(b_buff,0,sizeof(b_buff));
|
||||
|
||||
for (; (i < (STRING_SHIPYARD_SIZE - 1)) && !nilp( a) && !nilp( b); i++) {
|
||||
a_buff[i] = cell_a->payload.string.character;
|
||||
a = c_cdr(a);
|
||||
cell_a = &pointer2cell( a );
|
||||
|
||||
b_buff[i] = cell_b->payload.string.character;
|
||||
b = c_cdr( b);
|
||||
cell_b = &pointer2cell( b);
|
||||
}
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_print( L"Comparing '", DEBUG_ARITH);
|
||||
debug_print( a_buff, DEBUG_ARITH);
|
||||
debug_print_object( a, DEBUG_ARITH);
|
||||
debug_print( L"' to '", DEBUG_ARITH);
|
||||
debug_print( b_buff, DEBUG_ARITH);
|
||||
debug_print( L"'\n", DEBUG_ARITH);
|
||||
debug_print_object( b, DEBUG_ARITH);
|
||||
#endif
|
||||
|
||||
/* OK, now we have wchar string buffers loaded from the objects. We
|
||||
* may not have exhausted either string, so the buffers being equal
|
||||
* isn't sufficient. So we recurse at least once. */
|
||||
|
||||
result = (wcsncmp( a_buff, b_buff, i) == 0) && equal( c_cdr(a), c_cdr(b));
|
||||
}
|
||||
result =
|
||||
cell_a->payload.string.hash == cell_b->payload.string.hash
|
||||
&& cell_a->payload.string.character ==
|
||||
cell_b->payload.string.character
|
||||
&&
|
||||
( equal
|
||||
( cell_a->payload.string.cdr,
|
||||
cell_b->payload.string.cdr )
|
||||
|| ( end_of_string( cell_a->payload.string.cdr )
|
||||
&& end_of_string( cell_b->payload.string.cdr ) ) );
|
||||
break;
|
||||
case VECTORPOINTTV:
|
||||
if ( cell_b->tag.value == VECTORPOINTTV) {
|
||||
|
|
|
|||
|
|
@ -15,12 +15,6 @@
|
|||
#ifndef __equal_h
|
||||
#define __equal_h
|
||||
|
||||
/**
|
||||
* size of buffer for assembling strings. Likely to be useful to
|
||||
* read, too.
|
||||
*/
|
||||
#define STRING_SHIPYARD_SIZE 1024
|
||||
|
||||
/**
|
||||
* Shallow, and thus cheap, equality: true if these two objects are
|
||||
* the same object, else false.
|
||||
|
|
|
|||
|
|
@ -1639,6 +1639,7 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
|
|||
|
||||
bindings =
|
||||
make_cons( make_cons( symbol, val ), bindings );
|
||||
|
||||
} else {
|
||||
result =
|
||||
throw_exception( c_string_to_lisp_string
|
||||
|
|
@ -1648,8 +1649,6 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
|
|||
}
|
||||
}
|
||||
|
||||
debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND);
|
||||
|
||||
/* i.e., no exception yet */
|
||||
for ( int form = 1; !exceptionp( result ) && form < frame->args; form++ ) {
|
||||
result =
|
||||
|
|
@ -1657,11 +1656,10 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
|
|||
bindings );
|
||||
}
|
||||
|
||||
/* release the local bindings as they go out of scope! **BUT**
|
||||
* bindings were consed onto the front of env, so caution... */
|
||||
// for (struct cons_pointer cursor = bindings; !eq( cursor, env); cursor = c_cdr(cursor)) {
|
||||
// dec_ref( cursor);
|
||||
// }
|
||||
// release the local bindings as they go out of scope!
|
||||
for (struct cons_pointer cursor = bindings; !eq( cursor, env); cursor = c_cdr(cursor)) {
|
||||
dec_ref( cursor);
|
||||
}
|
||||
|
||||
return result;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,28 +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 2>/dev/null | tail -1`
|
||||
# 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`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '$expected', got '$actual'"
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
# if [ "${expected}" = "${actual}" ]
|
||||
# then
|
||||
# echo "OK"
|
||||
# else
|
||||
# echo "Fail: expected '$expected', got '$actual'"
|
||||
# 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 2>/dev/null | tail -1`
|
||||
# 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`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '$expected', got '$actual'"
|
||||
result=`echo "${result} + 1" | bc`
|
||||
fi
|
||||
# if [ "${expected}" = "${actual}" ]
|
||||
# then
|
||||
# echo "OK"
|
||||
# else
|
||||
# echo "Fail: expected '$expected', got '$actual'"
|
||||
# result=`echo "${result} + 1" | bc`
|
||||
# fi
|
||||
|
||||
exit ${result}
|
||||
Loading…
Add table
Add a link
Reference in a new issue