conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

rewrite boolean=? in c

This commit is contained in:
Yuichi Nishiwaki 2014-07-22 09:13:42 +09:00
parent b1ae2c24e5
commit 0d59eee27b
2 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
piclib/prelude.scm
View File

@ -589,14 +589,6 @@
s s
(fold f (f (car xs) s) (cdr xs)))) (fold f (f (car xs) s) (cdr xs))))
;;; 6.3 Booleans
(define (boolean=? . objs)
(or (every (lambda (x) (eq? x #t)) objs)
(every (lambda (x) (eq? x #f)) objs)))
(export boolean=?)
;;; 6.4 Pairs and lists ;;; 6.4 Pairs and lists
(define (member obj list . opts) (define (member obj list . opts)

20
src/bool.c
View File

@ -169,6 +169,25 @@ pic_bool_boolean_p(pic_state *pic)
return (pic_true_p(v) || pic_false_p(v)) ? pic_true_value() : pic_false_value(); return (pic_true_p(v) || pic_false_p(v)) ? pic_true_value() : pic_false_value();
} }
static pic_value
pic_bool_boolean_eq_p(pic_state *pic)
{
size_t argc, i;
pic_value *argv;
pic_get_args(pic, "*", &argc, &argv);
for (i = 0; i < argc; ++i) {
if (! (pic_true_p(argv[i]) || pic_false_p(argv[i]))) {
return pic_false_value();
}
if (! pic_eq_p(argv[i], argv[0])) {
return pic_false_value();
}
}
return pic_true_value();
}
void void
pic_init_bool(pic_state *pic) pic_init_bool(pic_state *pic)
{ {
@ -178,4 +197,5 @@ pic_init_bool(pic_state *pic)
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);
pic_defun(pic, "boolean=?", pic_bool_boolean_eq_p);
} }