diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 1fa9228f..3916e72d 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -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); diff --git a/runtime.c b/runtime.c index 849cced4..be64d352 100644 --- a/runtime.c +++ b/runtime.c @@ -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) diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld index 5dd4ec34..8d7e5ced 100644 --- a/scheme/cyclone/primitives.sld +++ b/scheme/cyclone/primitives.sld @@ -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") diff --git a/tests/unit-tests.scm b/tests/unit-tests.scm index 66005bb1..86d01acd 100644 --- a/tests/unit-tests.scm +++ b/tests/unit-tests.scm @@ -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