Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-15 16:57:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

eqv? behavior per R7RS

Browse source
This commit is contained in:
Justin Ethier 2020-05-21 18:12:54 -04:00
parent 6d0b082f37
commit 3dc451d016
4 changed files with 21 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
include/cyclone/runtime.h
View file

@ -443,6 +443,7 @@ double MRG32k3a (double seed);
*/
/**@{*/
//object Cyc_eq(object x, object y);
object Cyc_eqv(object x, object y);
#define Cyc_eq(x, y) (make_boolean(x == y))
int equal(object, object);
object equalp(object, object);

14
runtime.c
View file

@ -2041,6 +2041,18 @@ object Cyc_is_procedure(void *data, object o)
// 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)
{
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)
{
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)

2
scheme/cyclone/primitives.sld
View file

@ -662,7 +662,7 @@
((eq? p 'set-car!) "Cyc_set_car_cps")
((eq? p 'set-cdr!) "Cyc_set_cdr_cps")
((eq? p 'eq?) "Cyc_eq")
((eq? p 'eqv?) "Cyc_eq")
((eq? p 'eqv?) "Cyc_eqv")
((eq? p 'equal?) "equalp")
((eq? p 'Cyc-fast-member) "memberp")
((eq? p 'Cyc-fast-assoc) "assoc")

6
tests/unit-tests.scm
View file

@ -202,6 +202,12 @@
(assert:equal "" (symbol->string 'a/test-01) "a/test-01")
(assert:equal "" (eq? 'a-1 'a-1) #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)
;; Map