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