add pic_equal_p
This commit is contained in:
parent
381ed58bff
commit
dcb5b448cd
|
@ -102,6 +102,8 @@ int pic_get_args(pic_state *, const char *, ...);
|
||||||
void pic_defun(pic_state *, const char *, pic_func_t);
|
void pic_defun(pic_state *, const char *, pic_func_t);
|
||||||
void pic_defmacro(pic_state *, const char *, struct pic_proc *);
|
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 *);
|
pic_sym pic_intern_cstr(pic_state *, const char *);
|
||||||
const char *pic_symbol_name(pic_state *, pic_sym);
|
const char *pic_symbol_name(pic_state *, pic_sym);
|
||||||
|
|
||||||
|
|
|
@ -260,16 +260,6 @@
|
||||||
(define-macro (unless test . exprs)
|
(define-macro (unless test . exprs)
|
||||||
(list 'if test #f (cons 'begin 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)
|
(define (member obj list . opts)
|
||||||
(let ((compare (if (null? opts) equal? (car opts))))
|
(let ((compare (if (null? opts) equal? (car opts))))
|
||||||
(if (null? list)
|
(if (null? list)
|
||||||
|
|
32
src/bool.c
32
src/bool.c
|
@ -1,6 +1,27 @@
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
#include "picrin.h"
|
#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
|
static pic_value
|
||||||
pic_bool_eq_p(pic_state *pic)
|
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));
|
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 */
|
/* TODO: replace it with native opcode */
|
||||||
static pic_value
|
static pic_value
|
||||||
pic_bool_not(pic_state *pic)
|
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, "eq?", pic_bool_eq_p);
|
||||||
pic_defun(pic, "eqv?", pic_bool_eqv_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, "not", pic_bool_not);
|
||||||
pic_defun(pic, "boolean?", pic_bool_boolean_p);
|
pic_defun(pic, "boolean?", pic_bool_boolean_p);
|
||||||
|
|
Loading…
Reference in New Issue