commit 2e9710546f1320ff63abf641f4b321f5ebc5a5c9
parent 674f30ad4cd197f01689b48f9046dfb2956eb6f9
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 24 Mar 2011 20:56:07 -0300
equal? now takes an arbitrary list of arguments. BUG: there seems to be a problem with marks in equal?... It show when comparing pairs with shared struct (copied with copy-es).
Diffstat:
4 files changed, 29 insertions(+), 6 deletions(-)
diff --git a/src/kgeqp.c b/src/kgeqp.c
@@ -21,6 +21,7 @@
/* 4.2.1 eq? */
/* 6.5.1 eq? */
+/* NOTE: this does 2 passes but could do it in one */
void eqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) denv;
diff --git a/src/kgequalp.c b/src/kgequalp.c
@@ -23,6 +23,7 @@
#include "kgequalp.h"
/* 4.3.1 equal? */
+/* 6.6.1 equal? */
/*
** equal? is O(n) where n is the number of pairs.
@@ -33,12 +34,32 @@
** Idea to look up these papers from srfi 85:
** "Recursive Equivalence Predicates" by William D. Clinger
*/
-void equalp(klisp_State *K, TValue *xparas, TValue ptree, TValue denv)
+void equalp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) denv;
- bind_2p(K, "equal?", ptree, obj1, obj2);
- bool res = equal2p(K, obj1, obj2);
- kapply_cc(K, b2tv(res));
+ (void) xparams;
+
+ int32_t cpairs;
+ int32_t pairs = check_list(K, "equal?", true, ptree, &cpairs);
+
+ /* In this case we can get away without comparing the
+ first and last element on a cycle because equal? is
+ symetric, (cf: ftyped_bpred) */
+ int32_t comps = pairs - 1;
+ TValue tail = ptree;
+ TValue res = KTRUE;
+ while(comps-- > 0) { /* comps could be -1 if ptree is nil */
+ TValue first = kcar(tail);
+ tail = kcdr(tail); /* tail only advances one place per iteration */
+ TValue second = kcar(tail);
+
+ if (!equal2p(K, first, second)) {
+ res = KFALSE;
+ break;
+ }
+ }
+
+ kapply_cc(K, res);
}
diff --git a/src/kgequalp.h b/src/kgequalp.h
@@ -19,7 +19,7 @@
#include "kghelpers.h"
/* 4.3.1 equal? */
-/* TEMP: for now it takes only two argument */
+/* 6.6.1 equal? */
void equalp(klisp_State *K, TValue *xparas, TValue ptree, TValue denv);
/* Helper (may be used in assoc and member) */
diff --git a/src/kground.c b/src/kground.c
@@ -95,6 +95,7 @@ void kinit_ground_env(klisp_State *K)
*/
/* 4.3.1 equal? */
+ /* 6.6.1 equal? */
add_applicative(K, ground_env, "equal?", equalp, 0);
/*
@@ -434,7 +435,7 @@ void kinit_ground_env(klisp_State *K)
*/
/* 6.6.1 equal? */
- /* TODO */
+ /* DONE: above, together with 4.3.1 */
/*
** 6.7 Environments
