Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-19 13:49:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Remove dependency on (scheme complex)

Browse source
This commit is contained in:
Justin Ethier 2019-02-14 13:55:56 -05:00
parent 0604fdf221
commit 74148a2f16
1 changed files with 20 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
srfi/69.sld
View file

@ -42,8 +42,7 @@
) )
(import (scheme base) (import (scheme base)
(scheme char) (scheme char)
(scheme complex) ;(scheme complex)
;(scheme cyclone util)
) )
(begin (begin
@ -74,6 +73,24 @@
"(void *data, object ptr, object sym)" "(void *data, object ptr, object sym)"
" return obj_int2obj(((long)sym) & 0x7FFFFFFF); ") " return obj_int2obj(((long)sym) & 0x7FFFFFFF); ")
(define-c %real-part
"(void *data, int argc, closure _, object k, object z)"
" if (boolean_t == Cyc_is_complex(z)) {
make_double(d, creal(complex_num_value(z)));
return_closcall1(data, k, &d);
} else {
return_closcall1(data, k, z);
} ")
(define-c %imag-part
"(void *data, int argc, closure _, object k, object z)"
" if (boolean_t == Cyc_is_complex(z)) {
make_double(d, cimag(complex_num_value(z)));
return_closcall1(data, k, &d);
} else {
return_closcall1(data, k, z);
} ")
(define (hash obj . maybe-bound) (define (hash obj . maybe-bound)
(let ((bound (if (null? maybe-bound) *default-bound* (car maybe-bound)))) (let ((bound (if (null? maybe-bound) *default-bound* (car maybe-bound))))
(cond ((integer? obj) (modulo obj bound)) (cond ((integer? obj) (modulo obj bound))
@ -84,7 +101,7 @@
) )
((real? obj) (modulo (+ (numerator obj) (denominator obj)) bound)) ((real? obj) (modulo (+ (numerator obj) (denominator obj)) bound))
((number? obj) ((number? obj)
(modulo (+ (hash (real-part obj)) (* 3 (hash (imag-part obj)))) (modulo (+ (hash (%real-part obj)) (* 3 (hash (%imag-part obj))))
bound)) bound))
((char? obj) (modulo (char->integer obj) bound)) ((char? obj) (modulo (char->integer obj) bound))
((vector? obj) (vector-hash obj bound)) ((vector? obj) (vector-hash obj bound))