diff --git a/include/picrin.h b/include/picrin.h index ff241611..afce63bf 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -100,6 +100,8 @@ int pic_get_args(pic_state *, const char *, ...); void pic_defun(pic_state *, const char *, pic_func_t); void pic_defmacro(pic_state *, const char *, struct pic_proc *); +bool pic_equal_p(pic_state *, pic_value, pic_value); + pic_sym pic_intern_cstr(pic_state *, const char *); const char *pic_symbol_name(pic_state *, pic_sym); diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 89d65e84..27351492 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -260,16 +260,6 @@ (define-macro (unless test . exprs) (list 'if test #f (cons 'begin exprs))) -(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))) - (define (member obj list . opts) (let ((compare (if (null? opts) equal? (car opts)))) (if (null? list) diff --git a/src/bool.c b/src/bool.c index faacf3a8..3051a1b4 100644 --- a/src/bool.c +++ b/src/bool.c @@ -1,6 +1,27 @@ #include #include "picrin.h" +#include "picrin/pair.h" + +bool +pic_equal_p(pic_state *pic, pic_value x, pic_value y) +{ + enum pic_tt type; + + if (pic_eqv_p(x, y)) + return true; + + type = pic_type(x); + if (type != pic_type(y)) + return false; + switch (type) { + case PIC_TT_PAIR: + return pic_equal_p(pic, pic_car(pic, x), pic_car(pic, y)) + && pic_equal_p(pic, pic_cdr(pic, x), pic_cdr(pic, y)); + default: + return false; + } +} static pic_value pic_bool_eq_p(pic_state *pic) @@ -22,6 +43,16 @@ pic_bool_eqv_p(pic_state *pic) return pic_bool_value(pic_eqv_p(x, y)); } +static pic_value +pic_bool_equal_p(pic_state *pic) +{ + pic_value x, y; + + pic_get_args(pic, "oo", &x, &y); + + return pic_bool_value(pic_equal_p(pic, x, y)); +} + /* TODO: replace it with native opcode */ static pic_value pic_bool_not(pic_state *pic) @@ -48,6 +79,7 @@ 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, "equal?", pic_bool_equal_p); pic_defun(pic, "not", pic_bool_not); pic_defun(pic, "boolean?", pic_bool_boolean_p);