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

Cleanup

Browse source
This commit is contained in:
Justin Ethier 2017-08-08 18:09:54 -04:00
parent 7d40369c10
commit 9643d8742b
2 changed files with 38 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
srfi/143.sld
View file

@ -21,8 +21,9 @@
fxabs
fxsquare
fxsqrt
; TODO:
; fx+/carry fx-/carry fx*/carry
; TODO: requires SRFI 141
; fx+/carry fx-/carry fx*/carry
fxnot fxand fxior fxxor
fxarithmetic-shift
@ -58,10 +59,7 @@
(define (fx-width) 31)
(define (fx-greatest) 1073741823)
(define (fx-least) -1073741824)
(define-c fixnum?
"(void *data, int argc, closure _, object k, object obj)"
" return_closcall1(data, k,
obj_is_int(obj) ? boolean_t : boolean_f); ")
(define-syntax bin-num-op
(er-macro-transformer
(lambda (expr rename compare)
@ -79,6 +77,8 @@
" object result = obj_int2obj(obj_obj2int(i) " op-str " obj_obj2int(j));
return_closcall1(data, k, result); ")))
`(define-c ,fnc ,args ,body)))))
;; TODO: should be able to support any number of arguments
(define-syntax cmp-op
(er-macro-transformer
(lambda (expr rename compare)
@ -93,51 +93,61 @@
object result = (obj_obj2int(i) " op-str " obj_obj2int(j)) ? boolean_t : boolean_f;
return_closcall1(data, k, result); ")))
`(define-c ,fnc ,args ,body)))))
(begin
(bin-num-op fx+ "+")
(bin-num-op fx- "-")
(bin-num-op fx* "*")
(bin-num-op fxquotient "/" #t)
(bin-num-op fxremainder "%" #t)
(bin-num-op fxand "&")
(bin-num-op fxior "|")
(bin-num-op fxxor "^")
(bin-num-op fxarithmetic-shift-left "<<")
(bin-num-op fxarithmetic-shift-right ">>")
(cmp-op fx=? "==")
(cmp-op fx<? "<")
(cmp-op fx>? ">")
(cmp-op fx<=? "<=")
(cmp-op fx>=? ">=")
)
(define-c fixnum?
"(void *data, int argc, closure _, object k, object obj)"
" return_closcall1(data, k,
obj_is_int(obj) ? boolean_t : boolean_f); ")
(define-c fxzero?
"(void* data, int argc, closure _, object k, object i)"
" Cyc_check_fixnum(data, i);
return_closcall1(data, k, obj_obj2int(i) == 0 ? boolean_t : boolean_f); ")
(define (fxpositive? i) (fx>? i 0))
(define (fxnegative? i) (fx<? i 0))
(define-c fxodd?
"(void* data, int argc, closure _, object k, object i)"
" Cyc_check_fixnum(data, i);
return_closcall1(data, k, obj_obj2int(i) % 2 ? boolean_t : boolean_f); ")
(define (fxeven? i)
(if (fxodd? i) #f #t))
(define (fxmax first . rest) (foldl (lambda (old new) (if (fx>? old new) old new)) first rest))
(define (fxmin first . rest) (foldl (lambda (old new) (if (fx<? old new) old new)) first rest))
(define fxsqrt exact-integer-sqrt)
(define (fxsquare i) (fx* i i))
(define (fxneg i) (fx- 0 i))
(define (fxabs i)
(if (fxnegative? i) (fxneg i) i))
(define (fxabs i) (if (fxnegative? i) (fxneg i) i))
(define-c fxnot
"(void* data, int argc, closure _, object k, object i)"
" Cyc_check_fixnum(data, i);
object result = obj_int2obj(~(int)(obj_obj2int(i)));
return_closcall1(data, k, result); ")
(bin-num-op fxand "&")
(bin-num-op fxior "|")
(bin-num-op fxxor "^")
(define (fxarithmetic-shift i count)
(if (fxpositive? count)
(fxarithmetic-shift-left i count)
(fxarithmetic-shift-right i (fxneg count))))
(bin-num-op fxarithmetic-shift-left "<<")
(bin-num-op fxarithmetic-shift-right ">>")
(define-c fxbit-count
"(void* data, int argc, closure _, object k, object i)"

3
tests/srfi-143-tests.scm
View file

@ -4,6 +4,9 @@
(test #t (fixnum? 32767))
(test #f (fixnum? 1.1))
(test #t (fx=? 1 1))
(test #f (fx=? 1 2))
(test #f (fx=? 2 3))
; (test #t (fx=? 1 1 1))
; (test #f (fx=? 1 2 2))
; (test #f (fx=? 1 1 2))