mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-15 16:57:35 +02:00
eqv? behavior per R7RS
This commit is contained in:
parent
6d0b082f37
commit
3dc451d016
4 changed files with 21 additions and 2 deletions
|
@ -443,6 +443,7 @@ double MRG32k3a (double seed);
|
||||||
*/
|
*/
|
||||||
/**@{*/
|
/**@{*/
|
||||||
//object Cyc_eq(object x, object y);
|
//object Cyc_eq(object x, object y);
|
||||||
|
object Cyc_eqv(object x, object y);
|
||||||
#define Cyc_eq(x, y) (make_boolean(x == y))
|
#define Cyc_eq(x, y) (make_boolean(x == y))
|
||||||
int equal(object, object);
|
int equal(object, object);
|
||||||
object equalp(object, object);
|
object equalp(object, object);
|
||||||
|
|
14
runtime.c
14
runtime.c
|
@ -2041,6 +2041,18 @@ object Cyc_is_procedure(void *data, object o)
|
||||||
// return boolean_f;
|
// return boolean_f;
|
||||||
//}
|
//}
|
||||||
|
|
||||||
|
object Cyc_eqv(object x, object y)
|
||||||
|
{
|
||||||
|
if (Cyc_eq(x, y) == boolean_t) {
|
||||||
|
return boolean_t;
|
||||||
|
} else if (Cyc_is_number(x) == boolean_t &&
|
||||||
|
equalp(x, y) == boolean_t) {
|
||||||
|
return boolean_t;
|
||||||
|
} else {
|
||||||
|
return boolean_f;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
object Cyc_is_immutable(object obj)
|
object Cyc_is_immutable(object obj)
|
||||||
{
|
{
|
||||||
if (is_object_type(obj) &&
|
if (is_object_type(obj) &&
|
||||||
|
@ -4838,7 +4850,7 @@ void _eq_127(void *data, object cont, object args)
|
||||||
void _eqv_127(void *data, object cont, object args)
|
void _eqv_127(void *data, object cont, object args)
|
||||||
{
|
{
|
||||||
Cyc_check_num_args(data, "eqv?", 2, args);
|
Cyc_check_num_args(data, "eqv?", 2, args);
|
||||||
_eq_127(data, cont, args);
|
return_closcall1(data, cont, Cyc_eqv(car(args), cadr(args)));
|
||||||
}
|
}
|
||||||
|
|
||||||
void _equal_127(void *data, object cont, object args)
|
void _equal_127(void *data, object cont, object args)
|
||||||
|
|
|
@ -662,7 +662,7 @@
|
||||||
((eq? p 'set-car!) "Cyc_set_car_cps")
|
((eq? p 'set-car!) "Cyc_set_car_cps")
|
||||||
((eq? p 'set-cdr!) "Cyc_set_cdr_cps")
|
((eq? p 'set-cdr!) "Cyc_set_cdr_cps")
|
||||||
((eq? p 'eq?) "Cyc_eq")
|
((eq? p 'eq?) "Cyc_eq")
|
||||||
((eq? p 'eqv?) "Cyc_eq")
|
((eq? p 'eqv?) "Cyc_eqv")
|
||||||
((eq? p 'equal?) "equalp")
|
((eq? p 'equal?) "equalp")
|
||||||
((eq? p 'Cyc-fast-member) "memberp")
|
((eq? p 'Cyc-fast-member) "memberp")
|
||||||
((eq? p 'Cyc-fast-assoc) "assoc")
|
((eq? p 'Cyc-fast-assoc) "assoc")
|
||||||
|
|
|
@ -202,6 +202,12 @@
|
||||||
(assert:equal "" (symbol->string 'a/test-01) "a/test-01")
|
(assert:equal "" (symbol->string 'a/test-01) "a/test-01")
|
||||||
(assert:equal "" (eq? 'a-1 'a-1) #t)
|
(assert:equal "" (eq? 'a-1 'a-1) #t)
|
||||||
(assert:equal "" (eq? (string->symbol "aa") 'aa) #t)
|
(assert:equal "" (eq? (string->symbol "aa") 'aa) #t)
|
||||||
|
(assert:equal "" (eq? 0.0 0.0) #f)
|
||||||
|
(assert:equal "" (eq? 33333333333333 3333333333333333) #f)
|
||||||
|
(assert:equal "" (eqv? 'a-1 'a-1) #t)
|
||||||
|
(assert:equal "" (eqv? (string->symbol "aa") 'aa) #t)
|
||||||
|
(assert:equal "" (eqv? 0.0 0.0) #t)
|
||||||
|
(assert:equal "" (eqv? 33333333333333 3333333333333333) #t)
|
||||||
(assert:equal "" (equal? (string->symbol "aa") 'aa) #t)
|
(assert:equal "" (equal? (string->symbol "aa") 'aa) #t)
|
||||||
|
|
||||||
;; Map
|
;; Map
|
||||||
|
|
Loading…
Add table
Reference in a new issue