From fc42c713040444a573b39203c40c2ff1a7b5106c Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 6 Nov 2013 16:12:31 +0900 Subject: [PATCH] add eqv? and equal? --- piclib/built-in.scm | 13 +++++++++++++ src/bool.c | 11 +++++++++++ src/value.c | 6 ++++++ 3 files changed, 30 insertions(+) diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 78633727..e4c000c4 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -113,6 +113,8 @@ (if-false (cons 'cond (cdr clauses)))) (list 'if test if-true if-false))))) +(define else #t) + (define-macro (and . exprs) (if (null? exprs) #t @@ -141,3 +143,14 @@ (list 'quasiquote (car x)) (list 'quasiquote (cdr x)))))) (#t x))) + +(define (equal? x y) + (cond + ((eqv? x y) + #t) + ((and (pair? x) (pair? y)) + (and (equal? (car x) (car y)) + (equal? (cdr x) (cdr y)))) + (else + #f))) + diff --git a/src/bool.c b/src/bool.c index a5aaf294..faacf3a8 100644 --- a/src/bool.c +++ b/src/bool.c @@ -12,6 +12,16 @@ pic_bool_eq_p(pic_state *pic) return pic_bool_value(pic_eq_p(x, y)); } +static pic_value +pic_bool_eqv_p(pic_state *pic) +{ + pic_value x, y; + + pic_get_args(pic, "oo", &x, &y); + + return pic_bool_value(pic_eqv_p(x, y)); +} + /* TODO: replace it with native opcode */ static pic_value pic_bool_not(pic_state *pic) @@ -37,6 +47,7 @@ void pic_init_bool(pic_state *pic) { pic_defun(pic, "eq?", pic_bool_eq_p); + pic_defun(pic, "eqv?", pic_bool_eqv_p); pic_defun(pic, "not", pic_bool_not); pic_defun(pic, "boolean?", pic_bool_boolean_p); diff --git a/src/value.c b/src/value.c index 3b76bf67..3e979b66 100644 --- a/src/value.c +++ b/src/value.c @@ -225,6 +225,12 @@ pic_eq_p(pic_value x, pic_value y) return x.u.data == y.u.data; } +bool +pic_eqv_p(pic_value x, pic_value y) +{ + return x.u.data == y.u.data; +} + #else bool