andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Add equal2?. 

* src/lib.c (equal2_p): New function.
* module/mes/base.mes (equal2?): Remove.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-05 20:01:04 +02:00
parent 6a9621ebf3
commit 0a4030838c
2 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
module/mes/base.mes
View File

@ -91,17 +91,6 @@
(define (and=> value procedure) (and value (procedure value)))
(define eqv? eq?)
(define (equal2? a b)
(if (and (null? a) (null? b)) #t
(if (and (pair? a) (pair? b))
(and (equal2? (car a) (car b))
(equal2? (cdr a) (cdr b)))
(if (and (string? a) (string? b))
(eq? (string->symbol a) (string->symbol b))
(if (and (vector? a) (vector? b))
(equal2? (vector->list a) (vector->list b))
(eq? a b))))))
(define (equal? . x)
(if (or (null? x) (null? (cdr x))) #t
(if (null? (cddr x)) (equal2? (car x) (cadr x))

30
src/lib.c
View File

@ -268,3 +268,33 @@ memq (SCM x, SCM a)
return a != cell_nil ? a : cell_f;
}
SCM
equal2_p (SCM a, SCM b)
{
if (a == cell_nil && b == cell_nil)
return cell_t;
if (TYPE (a) == TPAIR && TYPE (b) == TPAIR)
return equal2_p (CAR (a), CAR (b)) == cell_t
&& equal2_p (CDR (a), CDR (b)) == cell_t
? cell_t : cell_f;
if (TYPE (a) == TSTRING && TYPE (b) == TSTRING)
return equal2_p (STRING (a), STRING (b));
if (TYPE (a) == TVECTOR && TYPE (b) == TVECTOR)
{
if (LENGTH (a) != LENGTH (b))
return cell_f;
for (int i=0; i < LENGTH (a); i++)
{
SCM ai = VECTOR (a) + i;
SCM bi = VECTOR (b) + i;
if (TYPE (ai) == TREF)
ai = REF (ai);
if (TYPE (bi) == TREF)
bi = REF (bi);
if (equal2_p (ai, bi) == cell_f)
return cell_f;
}
return cell_t;
}
return eq_p (a, b);
}