~ chicken-core (chicken-5) b489a2fda90258b7bcd40d8967d0c137ba4f479c
commit b489a2fda90258b7bcd40d8967d0c137ba4f479c Author: Evan Hanson <evhan@foldling.org> AuthorDate: Thu Feb 25 13:57:36 2016 +1300 Commit: Evan Hanson <evhan@foldling.org> CommitDate: Tue Mar 8 22:52:35 2016 +1300 Move fixnum procedures to new chicken.fixnum module diff --git a/README b/README index 8333bb74..bf4e13d1 100644 --- a/README +++ b/README @@ -292,6 +292,7 @@ | | |-- chicken.eval.import.so | | |-- chicken.expand.import.so | | |-- chicken.files.import.so + | | |-- chicken.fixnum.import.so | | |-- chicken.flonum.import.so | | |-- chicken.foreign.import.so | | |-- chicken.format.import.so diff --git a/c-platform.scm b/c-platform.scm index ad5483cc..8cb1fa59 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -149,15 +149,19 @@ fpfloor fpceiling fptruncate fpround fpsin fpcos fptan fpasin fpacos fpatan fpatan2 fpexp fpexpt fplog fpsqrt fpabs fpinteger?))) -(set! default-extended-bindings - `(bignum? cplxnum? ratnum? ,@flonum-bindings +(define-constant fixnum-bindings + (map (lambda (x) (symbol-append 'chicken.fixnum# x)) + '(fx* fx*? fx+ fx+? fx- fx-? fx/ fx/? fx< fx<= fx= fx> fx>= fxand + fxeven? fxgcd fxior fxlen fxmax fxmin fxmod fxneg fxnot fxodd? + fxrem fxshl fxshr fxxor))) + +(define-constant extended-bindings + '(bignum? cplxnum? fixnum? flonum? ratnum? chicken.bitwise#integer-length chicken.bitwise#bitwise-and chicken.bitwise#bitwise-not chicken.bitwise#bitwise-ior chicken.bitwise#bitwise-xor chicken.bitwise#arithmetic-shift chicken.bitwise#bit-set? - add1 sub1 fx+ fx- fx* fx/ fxgcd fx+? fx-? fx*? fx/? fxmod fxrem - fx= fx> fx< fx>= fx<= fixnum? fxneg fxmax fxmin fxlen fxand fxnot fxior - fxxor fxshr fxshl fxodd? fxeven? exact-integer? flonum? nan? finite? infinite? + add1 sub1 exact-integer? nan? finite? infinite? void flush-output print print* error call/cc blob-size identity blob=? equal=? make-polar make-rectangular real-part imag-part string->symbol symbol-append foldl foldr setter @@ -212,6 +216,9 @@ chicken.io#read-string chicken.format#format chicken.format#printf chicken.format#sprintf chicken.format#fprintf)) +(set! default-extended-bindings + (append fixnum-bindings flonum-bindings extended-bindings)) + (set! internal-bindings '(##sys#slot ##sys#setslot ##sys#block-ref ##sys#block-set! ##sys#call-with-current-continuation ##sys#size ##sys#byte ##sys#setbyte @@ -527,28 +534,28 @@ (rewrite '##sys#slot 2 2 "C_slot" #t) ; consider as safe, the primitive is unsafe anyway. (rewrite '##sys#block-ref 2 2 "C_i_block_ref" #t) ;XXX must be safe for pattern matcher (anymore?) (rewrite '##sys#size 2 1 "C_block_size" #t) -(rewrite 'fxnot 2 1 "C_fixnum_not" #t) -(rewrite 'fx* 2 2 "C_fixnum_times" #t) -(rewrite 'fx+? 2 2 "C_i_o_fixnum_plus" #t) -(rewrite 'fx-? 2 2 "C_i_o_fixnum_difference" #t) -(rewrite 'fx*? 2 2 "C_i_o_fixnum_times" #t) -(rewrite 'fx/? 2 2 "C_i_o_fixnum_quotient" #t) -(rewrite 'fx= 2 2 "C_eqp" #t) -(rewrite 'fx> 2 2 "C_fixnum_greaterp" #t) -(rewrite 'fx< 2 2 "C_fixnum_lessp" #t) -(rewrite 'fx>= 2 2 "C_fixnum_greater_or_equal_p" #t) -(rewrite 'fx<= 2 2 "C_fixnum_less_or_equal_p" #t) +(rewrite 'chicken.fixnum#fxnot 2 1 "C_fixnum_not" #t) +(rewrite 'chicken.fixnum#fx* 2 2 "C_fixnum_times" #t) +(rewrite 'chicken.fixnum#fx+? 2 2 "C_i_o_fixnum_plus" #t) +(rewrite 'chicken.fixnum#fx-? 2 2 "C_i_o_fixnum_difference" #t) +(rewrite 'chicken.fixnum#fx*? 2 2 "C_i_o_fixnum_times" #t) +(rewrite 'chicken.fixnum#fx/? 2 2 "C_i_o_fixnum_quotient" #t) +(rewrite 'chicken.fixnum#fx= 2 2 "C_eqp" #t) +(rewrite 'chicken.fixnum#fx> 2 2 "C_fixnum_greaterp" #t) +(rewrite 'chicken.fixnum#fx< 2 2 "C_fixnum_lessp" #t) +(rewrite 'chicken.fixnum#fx>= 2 2 "C_fixnum_greater_or_equal_p" #t) +(rewrite 'chicken.fixnum#fx<= 2 2 "C_fixnum_less_or_equal_p" #t) (rewrite 'chicken.flonum#fp= 2 2 "C_flonum_equalp" #f) (rewrite 'chicken.flonum#fp> 2 2 "C_flonum_greaterp" #f) (rewrite 'chicken.flonum#fp< 2 2 "C_flonum_lessp" #f) (rewrite 'chicken.flonum#fp>= 2 2 "C_flonum_greater_or_equal_p" #f) (rewrite 'chicken.flonum#fp<= 2 2 "C_flonum_less_or_equal_p" #f) -(rewrite 'fxmax 2 2 "C_i_fixnum_max" #t) -(rewrite 'fxmin 2 2 "C_i_fixnum_min" #t) +(rewrite 'chicken.fixnum#fxmax 2 2 "C_i_fixnum_max" #t) +(rewrite 'chicken.fixnum#fxmin 2 2 "C_i_fixnum_min" #t) (rewrite 'chicken.flonum#fpmax 2 2 "C_i_flonum_max" #f) (rewrite 'chicken.flonum#fpmin 2 2 "C_i_flonum_min" #f) -(rewrite 'fxgcd 2 2 "C_i_fixnum_gcd" #t) -(rewrite 'fxlen 2 1 "C_i_fixnum_length" #t) +(rewrite 'chicken.fixnum#fxgcd 2 2 "C_i_fixnum_gcd" #t) +(rewrite 'chicken.fixnum#fxlen 2 1 "C_i_fixnum_length" #t) (rewrite 'char-numeric? 2 1 "C_u_i_char_numericp" #t) (rewrite 'char-alphabetic? 2 1 "C_u_i_char_alphabeticp" #t) (rewrite 'char-whitespace? 2 1 "C_u_i_char_whitespacep" #t) @@ -707,8 +714,8 @@ (rewrite 'even? 17 1 "C_i_evenp" "C_u_i_evenp") (rewrite 'odd? 17 1 "C_i_oddp" "C_u_i_oddp") -(rewrite 'fxodd? 2 1 "C_i_fixnumoddp" #t) -(rewrite 'fxeven? 2 1 "C_i_fixnumevenp" #t) +(rewrite 'chicken.fixnum#fxodd? 2 1 "C_i_fixnumoddp" #t) +(rewrite 'chicken.fixnum#fxeven? 2 1 "C_i_fixnumevenp" #t) (rewrite 'floor 15 'flonum 'fixnum 'chicken.flonum#fpfloor #f) (rewrite 'ceiling 15 'flonum 'fixnum 'chicken.flonum#fpceiling #f) @@ -779,17 +786,17 @@ '("C_i_setslot") ) ) callargs) ) ) ) ) ) -(rewrite 'fx+ 17 2 "C_fixnum_plus" "C_u_fixnum_plus") -(rewrite 'fx- 17 2 "C_fixnum_difference" "C_u_fixnum_difference") -(rewrite 'fxshl 17 2 "C_fixnum_shift_left") -(rewrite 'fxshr 17 2 "C_fixnum_shift_right") -(rewrite 'fxneg 17 1 "C_fixnum_negate" "C_u_fixnum_negate") -(rewrite 'fxxor 17 2 "C_fixnum_xor" "C_fixnum_xor") -(rewrite 'fxand 17 2 "C_fixnum_and" "C_u_fixnum_and") -(rewrite 'fxior 17 2 "C_fixnum_or" "C_u_fixnum_or") -(rewrite 'fx/ 17 2 "C_fixnum_divide" "C_u_fixnum_divide") -(rewrite 'fxmod 17 2 "C_fixnum_modulo" "C_u_fixnum_modulo") -(rewrite 'fxrem 17 2 "C_i_fixnum_remainder_checked") +(rewrite 'chicken.fixnum#fx+ 17 2 "C_fixnum_plus" "C_u_fixnum_plus") +(rewrite 'chicken.fixnum#fx- 17 2 "C_fixnum_difference" "C_u_fixnum_difference") +(rewrite 'chicken.fixnum#fxshl 17 2 "C_fixnum_shift_left") +(rewrite 'chicken.fixnum#fxshr 17 2 "C_fixnum_shift_right") +(rewrite 'chicken.fixnum#fxneg 17 1 "C_fixnum_negate" "C_u_fixnum_negate") +(rewrite 'chicken.fixnum#fxxor 17 2 "C_fixnum_xor" "C_fixnum_xor") +(rewrite 'chicken.fixnum#fxand 17 2 "C_fixnum_and" "C_u_fixnum_and") +(rewrite 'chicken.fixnum#fxior 17 2 "C_fixnum_or" "C_u_fixnum_or") +(rewrite 'chicken.fixnum#fx/ 17 2 "C_fixnum_divide" "C_u_fixnum_divide") +(rewrite 'chicken.fixnum#fxmod 17 2 "C_fixnum_modulo" "C_u_fixnum_modulo") +(rewrite 'chicken.fixnum#fxrem 17 2 "C_i_fixnum_remainder_checked") (rewrite 'chicken.bitwise#arithmetic-shift 8 diff --git a/chicken-install.scm b/chicken-install.scm index 046af215..be8d4038 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -47,6 +47,7 @@ "chicken.eval.import.so" "chicken.expand.import.so" "chicken.files.import.so" + "chicken.fixnum.import.so" "chicken.flonum.import.so" "chicken.foreign.import.so" "chicken.format.import.so" diff --git a/chicken-syntax.scm b/chicken-syntax.scm index 4b55dbeb..b7ccacb8 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -39,6 +39,8 @@ (no-bound-checks) (no-procedure-checks)) +(import chicken) + (include "common-declarations.scm") (include "mini-srfi-1.scm") diff --git a/chicken.import.scm b/chicken.import.scm index 08945845..cb2ded1d 100644 --- a/chicken.import.scm +++ b/chicken.import.scm @@ -70,39 +70,39 @@ features file-exists? finite? - fixnum-bits - fixnum-precision + (fixnum-bits . chicken.fixnum#fixnum-bits) + (fixnum-precision . chicken.fixnum#fixnum-precision) fixnum? flonum? flush-output foldl foldr force-finalizers - fx- - fx* - fx/ - fx+ - fx< - fx<= - fx= - fx> - fx>= - fxand - fxeven? - fxgcd - fxior - fxlen - fxmax - fxmin - fxmod - fxneg - fxnot - fxodd? - fxrem - fxshl - fxshr - fxxor - fxlen + (fx- . chicken.fixnum#fx-) + (fx* . chicken.fixnum#fx*) + (fx/ . chicken.fixnum#fx/) + (fx+ . chicken.fixnum#fx+) + (fx< . chicken.fixnum#fx<) + (fx<= . chicken.fixnum#fx<=) + (fx= . chicken.fixnum#fx=) + (fx> . chicken.fixnum#fx>) + (fx>= . chicken.fixnum#fx>=) + (fxand . chicken.fixnum#fxand) + (fxeven? . chicken.fixnum#fxeven?) + (fxgcd . chicken.fixnum#fxgcd) + (fxior . chicken.fixnum#fxior) + (fxlen . chicken.fixnum#fxlen) + (fxmax . chicken.fixnum#fxmax) + (fxmin . chicken.fixnum#fxmin) + (fxmod . chicken.fixnum#fxmod) + (fxneg . chicken.fixnum#fxneg) + (fxnot . chicken.fixnum#fxnot) + (fxodd? . chicken.fixnum#fxodd?) + (fxrem . chicken.fixnum#fxrem) + (fxshl . chicken.fixnum#fxshl) + (fxshr . chicken.fixnum#fxshr) + (fxxor . chicken.fixnum#fxxor) + (fxlen . chicken.fixnum#fxlen) gensym get get-call-chain @@ -128,8 +128,8 @@ make-promise make-property-condition module-environment - most-negative-fixnum - most-positive-fixnum + (most-negative-fixnum . chicken.fixnum#most-negative-fixnum) + (most-positive-fixnum . chicken.fixnum#most-positive-fixnum) nan? notice on-exit diff --git a/defaults.make b/defaults.make index e636c9fd..cce0e26a 100644 --- a/defaults.make +++ b/defaults.make @@ -264,8 +264,8 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile) PRIMITIVE_IMPORT_LIBRARIES = chicken csi chicken.foreign DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4 -DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise flonum format gc io keyword \ - locative posix pretty-print random time +DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise fixnum flonum format gc io \ + keyword locative posix pretty-print random time DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \ eval expand files internal irregex lolevel ports read-syntax \ repl tcp utils diff --git a/distribution/manifest b/distribution/manifest index 3d9c63ba..1531b192 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -258,6 +258,8 @@ chicken.expand.import.scm chicken.expand.import.c chicken.files.import.scm chicken.files.import.c +chicken.fixnum.import.scm +chicken.fixnum.import.c chicken.flonum.import.scm chicken.flonum.import.c chicken.foreign.import.scm diff --git a/eval.scm b/eval.scm index b3522fd9..635efc23 100644 --- a/eval.scm +++ b/eval.scm @@ -1429,6 +1429,8 @@ ) ; eval module +(import chicken chicken.eval) + ;;; Simple invocation API: (declare @@ -1465,13 +1467,13 @@ (define-external (CHICKEN_eval (scheme-object exp) ((c-pointer "C_word") result)) bool (run-safe (lambda () - (store-result (chicken.eval#eval exp) result)))) + (store-result (eval exp) result)))) (define-external (CHICKEN_eval_string (c-string str) ((c-pointer "C_word") result)) bool (run-safe (lambda () (let ((i (open-input-string str))) - (store-result (chicken.eval#eval (read i)) result))))) + (store-result (eval (read i)) result))))) #> #define C_copy_result_string(str, buf, n) (C_memcpy((char *)C_block_item(buf, 0), C_c_string(str), C_unfix(n)), ((char *)C_block_item(buf, 0))[ C_unfix(n) ] = '\0', C_SCHEME_TRUE) @@ -1490,7 +1492,7 @@ (run-safe (lambda () (let ((o (open-output-string))) - (write (chicken.eval#eval exp) o) + (write (eval exp) o) (store-string (get-output-string o) bufsize buf)) ) ) ) (define-external (CHICKEN_eval_string_to_string (c-string str) ((c-pointer "char") buf) @@ -1499,7 +1501,7 @@ (run-safe (lambda () (let ((o (open-output-string))) - (write (chicken.eval#eval (read (open-input-string str))) o) + (write (eval (read (open-input-string str))) o) (store-string (get-output-string o) bufsize buf)) ) ) ) (define-external (CHICKEN_apply (scheme-object func) (scheme-object args) @@ -1523,7 +1525,7 @@ (store-result (read i) result) ) ) ) ) (define-external (CHICKEN_load (c-string str)) bool - (run-safe (lambda () (chicken.eval#load str) #t))) + (run-safe (lambda () (load str) #t))) (define-external (CHICKEN_get_error_message ((c-pointer "char") buf) (int bufsize)) void (store-string (or last-error "No error") bufsize buf) ) diff --git a/expand.scm b/expand.scm index 43f48c5f..b87f4644 100644 --- a/expand.scm +++ b/expand.scm @@ -927,8 +927,7 @@ ;;; Macro definitions: -(import chicken.expand - chicken.internal) +(import chicken chicken.expand chicken.internal) (##sys#extend-macro-environment 'import-syntax '() diff --git a/library.scm b/library.scm index ea593d20..463c1721 100644 --- a/library.scm +++ b/library.scm @@ -164,6 +164,51 @@ EOF (provide* library) ; TODO remove after snapshot release + +;;; Fixnum arithmetic: + +(module chicken.fixnum * +(import chicken scheme chicken.foreign) + +(define most-positive-fixnum (foreign-value "C_MOST_POSITIVE_FIXNUM" int)) +(define most-negative-fixnum (foreign-value "C_MOST_NEGATIVE_FIXNUM" int)) +(define fixnum-bits (foreign-value "(C_WORD_SIZE - 1)" int)) +(define fixnum-precision (foreign-value "(C_WORD_SIZE - (1 + 1))" int)) + +(define (fx+ x y) (##core#inline "C_fixnum_plus" x y)) +(define (fx- x y) (##core#inline "C_fixnum_difference" x y)) +(define (fx* x y) (##core#inline "C_fixnum_times" x y)) +(define (fx= x y) (eq? x y)) +(define (fx> x y) (##core#inline "C_fixnum_greaterp" x y)) +(define (fx< x y) (##core#inline "C_fixnum_lessp" x y)) +(define (fx>= x y) (##core#inline "C_fixnum_greater_or_equal_p" x y)) +(define (fx<= x y) (##core#inline "C_fixnum_less_or_equal_p" x y)) +(define (fxmin x y) (##core#inline "C_i_fixnum_min" x y)) +(define (fxmax x y) (##core#inline "C_i_fixnum_max" x y)) +(define (fxneg x) (##core#inline "C_fixnum_negate" x)) +(define (fxand x y) (##core#inline "C_fixnum_and" x y)) +(define (fxior x y) (##core#inline "C_fixnum_or" x y)) +(define (fxxor x y) (##core#inline "C_fixnum_xor" x y)) +(define (fxnot x) (##core#inline "C_fixnum_not" x)) +(define (fxshl x y) (##core#inline "C_fixnum_shift_left" x y)) +(define (fxshr x y) (##core#inline "C_fixnum_shift_right" x y)) +(define (fxodd? x) (##core#inline "C_i_fixnumoddp" x)) +(define (fxeven? x) (##core#inline "C_i_fixnumevenp" x)) +(define (fxlen x) (##core#inline "C_i_fixnum_length" x)) +(define (fx/ x y) (##core#inline "C_fixnum_divide" x y) ) +(define (fxgcd x y) (##core#inline "C_i_fixnum_gcd" x y)) +(define (fxmod x y) (##core#inline "C_fixnum_modulo" x y) ) +(define (fxrem x y) (##core#inline "C_i_fixnum_remainder_checked" x y) ) + +;; these are currently undocumented +(define (fx+? x y) (##core#inline "C_i_o_fixnum_plus" x y) ) +(define (fx-? x y) (##core#inline "C_i_o_fixnum_difference" x y) ) +(define (fx*? x y) (##core#inline "C_i_o_fixnum_times" x y) ) +(define (fx/? x y) (##core#inline "C_i_o_fixnum_quotient" x y))) + +(import chicken.fixnum) + + ;;; System routines: (define (exit #!optional (code 0)) ((##sys#exit-handler) code)) @@ -771,43 +816,7 @@ EOF ;; [MpNT] Tiplea at al., "MpNT: A Multi-Precision Number Theory Package" ;; [MCA] Richard P. Brent & Paul Zimmermann, "Modern Computer Arithmetic" -(define most-positive-fixnum (foreign-value "C_MOST_POSITIVE_FIXNUM" int)) -(define most-negative-fixnum (foreign-value "C_MOST_NEGATIVE_FIXNUM" int)) -(define fixnum-bits (foreign-value "(C_WORD_SIZE - 1)" int)) -(define fixnum-precision (foreign-value "(C_WORD_SIZE - (1 + 1))" int)) - (define (fixnum? x) (##core#inline "C_fixnump" x)) -(define (fx+ x y) (##core#inline "C_fixnum_plus" x y)) -(define (fx- x y) (##core#inline "C_fixnum_difference" x y)) -(define (fx* x y) (##core#inline "C_fixnum_times" x y)) -(define (fx= x y) (eq? x y)) -(define (fx> x y) (##core#inline "C_fixnum_greaterp" x y)) -(define (fx< x y) (##core#inline "C_fixnum_lessp" x y)) -(define (fx>= x y) (##core#inline "C_fixnum_greater_or_equal_p" x y)) -(define (fx<= x y) (##core#inline "C_fixnum_less_or_equal_p" x y)) -(define (fxmin x y) (##core#inline "C_i_fixnum_min" x y)) -(define (fxmax x y) (##core#inline "C_i_fixnum_max" x y)) -(define (fxneg x) (##core#inline "C_fixnum_negate" x)) -(define (fxand x y) (##core#inline "C_fixnum_and" x y)) -(define (fxior x y) (##core#inline "C_fixnum_or" x y)) -(define (fxxor x y) (##core#inline "C_fixnum_xor" x y)) -(define (fxnot x) (##core#inline "C_fixnum_not" x)) -(define (fxshl x y) (##core#inline "C_fixnum_shift_left" x y)) -(define (fxshr x y) (##core#inline "C_fixnum_shift_right" x y)) -(define (fxodd? x) (##core#inline "C_i_fixnumoddp" x)) -(define (fxeven? x) (##core#inline "C_i_fixnumevenp" x)) -(define (fxlen x) (##core#inline "C_i_fixnum_length" x)) -(define (fx/ x y) (##core#inline "C_fixnum_divide" x y) ) -(define (fxgcd x y) (##core#inline "C_i_fixnum_gcd" x y)) -(define (fxmod x y) (##core#inline "C_fixnum_modulo" x y) ) -(define (fxrem x y) (##core#inline "C_i_fixnum_remainder_checked" x y) ) - -;; these are currently undocumented -(define (fx+? x y) (##core#inline "C_i_o_fixnum_plus" x y) ) -(define (fx-? x y) (##core#inline "C_i_o_fixnum_difference" x y) ) -(define (fx*? x y) (##core#inline "C_i_o_fixnum_times" x y) ) -(define (fx/? x y) (##core#inline "C_i_o_fixnum_quotient" x y) ) - (define (flonum? x) (##core#inline "C_i_flonump" x)) (define (bignum? x) (##core#inline "C_i_bignump" x)) (define (ratnum? x) (##core#inline "C_i_ratnump" x)) @@ -2073,7 +2082,7 @@ EOF (module chicken.keyword (keyword? get-keyword keyword->string string->keyword) -(import scheme chicken) +(import scheme chicken chicken.fixnum) (define (keyword? x) (and (symbol? x) (fx= 0 (##sys#byte (##sys#slot x 1) 0))) ) @@ -5330,8 +5339,7 @@ EOF (module chicken.gc (current-gc-milliseconds gc memory-statistics set-finalizer! set-gc-report!) -(import scheme chicken - chicken.foreign) +(import scheme chicken chicken.fixnum chicken.foreign) ;;; GC info: diff --git a/manual/Unit library b/manual/Unit library index d314893c..3d6ad5b3 100644 --- a/manual/Unit library +++ b/manual/Unit library @@ -65,6 +65,18 @@ Like {{exact-integer-sqrt}}, but with any base value. Calculates {{s}} and {{r}} where {{s^N + r = K}} and {{K < (s+1)^N}}. +==== fixnum? + +<procedure>(fixnum? X)</procedure> + +Returns {{#t}} if {{X}} is a fixnum, or {{#f}} otherwise. + +==== flonum? + +<procedure>(flonum? X)</procedure> + +Returns {{#t}} if {{X}} is a flonum, or {{#f}} otherwise. + ==== bignum? <procedure>(bignum? X)</procedure> @@ -114,6 +126,9 @@ large numbers. ==== Arithmetic fixnum operations +The following procedures are provided by the {{(chicken fixnum)}} +module. + <procedure>(fx+ N1 N2)</procedure> <procedure>(fx- N1 N2)</procedure> <procedure>(fx* N1 N2)</procedure> @@ -153,12 +168,6 @@ respectively. Comparison of fixnums and predicates on them. -==== fixnum? - -<procedure>(fixnum? X)</procedure> - -Returns {{#t}} if {{X}} is a fixnum, or {{#f}} otherwise. - ==== Fixnum limits <constant>most-positive-fixnum</constant><br> @@ -213,12 +222,6 @@ application. Note: {{fpround}} uses the rounding mode that your C library implements, which is usually different from R5RS. -==== flonum? - -<procedure>(flonum? X)</procedure> - -Returns {{#t}} if {{X}} is a flonum, or {{#f}} otherwise. - ==== Flonum limits <constant>maximum-flonum</constant><br> diff --git a/modules.scm b/modules.scm index e8fd6d86..6fcd1be3 100644 --- a/modules.scm +++ b/modules.scm @@ -947,6 +947,7 @@ (##sys#register-module-alias 'data-structures 'chicken.data-structures) (##sys#register-module-alias 'expand 'chicken.expand) (##sys#register-module-alias 'files 'chicken.files) +(##sys#register-module-alias 'fixnum 'chicken.fixnum) (##sys#register-module-alias 'flonum 'chicken.flonum) (##sys#register-module-alias 'foreign 'chicken.foreign) (##sys#register-module-alias 'format 'chicken.format) diff --git a/profiler.scm b/profiler.scm index a664101a..c13f5658 100644 --- a/profiler.scm +++ b/profiler.scm @@ -31,6 +31,8 @@ (unsafe) (disable-interrupts)) +(import chicken) + (include "common-declarations.scm") (define-foreign-variable profile-id int "C_getpid()") diff --git a/rules.make b/rules.make index f5ca9722..f6b309c8 100644 --- a/rules.make +++ b/rules.make @@ -519,6 +519,7 @@ $(foreach lib, $(filter-out chicken,$(COMPILER_OBJECTS_1)),\ # special cases for modules not corresponding directly to units $(eval $(call declare-emitted-import-lib-dependency,chicken.posix,$(POSIXFILE))) $(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library)) +$(eval $(call declare-emitted-import-lib-dependency,chicken.fixnum,library)) $(eval $(call declare-emitted-import-lib-dependency,chicken.flonum,library)) $(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library)) $(eval $(call declare-emitted-import-lib-dependency,chicken.keyword,library)) @@ -761,6 +762,7 @@ bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTION library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) \ -emit-import-library chicken.bitwise \ + -emit-import-library chicken.fixnum \ -emit-import-library chicken.flonum \ -emit-import-library chicken.gc \ -emit-import-library chicken.keyword \ diff --git a/scheduler.scm b/scheduler.scm index 078318a7..fd0562e6 100644 --- a/scheduler.scm +++ b/scheduler.scm @@ -133,7 +133,7 @@ C_inline void C_fdset_add(int fd, int input, int output) { EOF ) ) -(import chicken.format) +(import chicken chicken.format) (include "common-declarations.scm") diff --git a/types.db b/types.db index ccda394a..0f5620a5 100644 --- a/types.db +++ b/types.db @@ -285,11 +285,11 @@ ((*) (##core#inline "C_i_negativep" #(1)))) (max (#(procedure #:clean #:enforce #:foldable) max (#!rest number) number) - ((fixnum fixnum) (fxmax #(1) #(2))) + ((fixnum fixnum) (chicken.fixnum#fxmax #(1) #(2))) ((float float) (##core#inline "C_i_flonum_max" #(1) #(2)))) (min (#(procedure #:clean #:enforce #:foldable) min (#!rest number) number) - ((fixnum fixnum) (fxmin #(1) #(2))) + ((fixnum fixnum) (chicken.fixnum#fxmin #(1) #(2))) ((float float) (##core#inline "C_i_flonum_min" #(1) #(2)))) (+ (#(procedure #:clean #:enforce #:foldable) + (#!rest number) number) @@ -403,7 +403,7 @@ (> (#(procedure #:clean #:enforce #:foldable) > (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) - ((fixnum fixnum) (fx> #(1) #(2))) + ((fixnum fixnum) (chicken.fixnum#fx> #(1) #(2))) ((float float) (##core#inline "C_flonum_greaterp" #(1) #(2))) ((integer integer) (##core#inline "C_i_integer_greaterp" #(1) #(2))) ((* *) (##core#inline "C_i_greaterp" #(1) #(2)))) @@ -411,7 +411,7 @@ (< (#(procedure #:clean #:enforce #:foldable) < (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) - ((fixnum fixnum) (fx< #(1) #(2))) + ((fixnum fixnum) (chicken.fixnum#fx< #(1) #(2))) ((integer integer) (##core#inline "C_i_integer_lessp" #(1) #(2))) ((float float) (##core#inline "C_flonum_lessp" #(1) #(2))) ((* *) (##core#inline "C_i_lessp" #(1) #(2)))) @@ -419,7 +419,7 @@ (>= (#(procedure #:clean #:enforce #:foldable) >= (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) - ((fixnum fixnum) (fx>= #(1) #(2))) + ((fixnum fixnum) (chicken.fixnum#fx>= #(1) #(2))) ((integer integer) (##core#inline "C_i_integer_greater_or_equalp" #(1) #(2))) ((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2))) ((* *) (##core#inline "C_i_greater_or_equalp" #(1) #(2)))) @@ -427,7 +427,7 @@ (<= (#(procedure #:clean #:enforce #:foldable) <= (#!rest number) boolean) (() '#t) ((number) (let ((#(tmp) #(1))) '#t)) - ((fixnum fixnum) (fx<= #(1) #(2))) + ((fixnum fixnum) (chicken.fixnum#fx<= #(1) #(2))) ((integer integer) (##core#inline "C_i_integer_less_or_equalp" #(1) #(2))) ((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2))) ((* *) (##core#inline "C_i_less_or_equalp" #(1) #(2)))) @@ -492,7 +492,7 @@ (gcd (#(procedure #:clean #:enforce #:foldable) gcd (#!rest (or integer float)) (or integer float)) (() '0) - ((fixnum fixnum) (fixnum) (fxgcd #(1) #(2))) + ((fixnum fixnum) (fixnum) (chicken.fixnum#fxgcd #(1) #(2))) ((float float) (float) (chicken.flonum#fpgcd #(1) #(2))) ((integer integer) (integer) (##core#inline_allocate ("C_s_a_u_i_integer_gcd" 6) #(1) #(2))) @@ -896,7 +896,11 @@ (exact-integer-sqrt (#(procedure #:clean #:enforce #:foldable) exact-integer-sqrt (integer) integer integer) ((integer) (##sys#exact-integer-sqrt #(1)))) +(fixnum? (#(procedure #:pure #:predicate fixnum) fixnum? (*) boolean)) +(flonum? (#(procedure #:pure #:predicate float) flonum? (*) boolean)) (bignum? (#(procedure #:pure #:predicate bignum) bignum? (*) boolean)) +(ratnum? (#(procedure #:pure #:predicate ratnum) ratnum? (*) boolean)) +(cplxnum? (#(procedure #:pure #:predicate cplxnum) cplxnum? (*) boolean)) (chicken.bitwise#bit-set? (#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bit-set? (integer integer) boolean) @@ -978,8 +982,6 @@ (#(procedure #:clean #:enforce) chicken.read-syntax#set-sharp-read-syntax! (char (or false (procedure (input-port) . *))) undefined)) -(cplxnum? (#(procedure #:pure #:predicate cplxnum) cplxnum? (*) boolean)) - (current-error-port (#(procedure #:clean #:enforce) current-error-port (#!optional output-port) output-port) ((output-port) (let ((#(tmp1) #(1))) @@ -1053,12 +1055,6 @@ ((float) (##core#inline "C_u_i_flonum_finitep" #(1))) ((*) (##core#inline "C_i_finitep" #(1)))) -(fixnum-bits fixnum) -(fixnum-precision fixnum) - -(fixnum? (#(procedure #:pure #:predicate fixnum) fixnum? (*) boolean)) -(flonum? (#(procedure #:pure #:predicate float) flonum? (*) boolean)) - ;; flonum (chicken.flonum#flonum-decimal-precision fixnum) @@ -1161,31 +1157,37 @@ (chicken.flonum#fptruncate (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fptruncate (float) float) ((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1) ))) +;; fixnum + +(chicken.fixnum#fixnum-bits fixnum) +(chicken.fixnum#fixnum-precision fixnum) + ;;XXX should these be enforcing? -(fx- (#(procedure #:clean #:foldable) fx- (fixnum fixnum) fixnum)) -(fx* (#(procedure #:clean #:foldable) fx* (fixnum fixnum) fixnum)) -(fx/ (#(procedure #:clean #:foldable) fx/ (fixnum fixnum) fixnum)) -(fxgcd (#(procedure #:clean #:foldable) fxgcd (fixnum fixnum) fixnum)) -(fx+ (#(procedure #:clean #:foldable) fx+ (fixnum fixnum) fixnum)) -(fx< (#(procedure #:clean #:foldable) fx< (fixnum fixnum) boolean)) -(fx<= (#(procedure #:clean #:foldable) fx<= (fixnum fixnum) boolean)) -(fx= (#(procedure #:clean #:foldable) fx= (fixnum fixnum) boolean)) -(fx> (#(procedure #:clean #:foldable) fx> (fixnum fixnum) boolean)) -(fx>= (#(procedure #:clean #:foldable) fx>= (fixnum fixnum) boolean)) -(fxand (#(procedure #:clean #:foldable) fxand (fixnum fixnum) fixnum)) -(fxeven? (#(procedure #:clean #:foldable) fxeven? (fixnum) boolean)) -(fxior (#(procedure #:clean #:foldable) fxior (fixnum fixnum) fixnum)) -(fxmax (#(procedure #:clean #:foldable) fxmax (fixnum fixnum) fixnum)) -(fxmin (#(procedure #:clean #:foldable) fxmin (fixnum fixnum) fixnum)) -(fxmod (#(procedure #:clean #:foldable) fxmod (fixnum fixnum) fixnum)) -(fxrem (#(procedure #:clean #:foldable) fxrem (fixnum fixnum) fixnum)) -(fxneg (#(procedure #:clean #:foldable) fxneg (fixnum) fixnum)) -(fxnot (#(procedure #:clean #:foldable) fxnot (fixnum) fixnum)) -(fxodd? (#(procedure #:clean #:foldable) fxodd? (fixnum) boolean)) -(fxshl (#(procedure #:clean #:foldable) fxshl (fixnum fixnum) fixnum)) -(fxshr (#(procedure #:clean #:foldable) fxshr (fixnum fixnum) fixnum)) -(fxxor (#(procedure #:clean #:foldable) fxxor (fixnum fixnum) fixnum)) -(fxlen (#(procedure #:clean #:foldable) fxlen (fixnum) fixnum)) +(chicken.fixnum#fx- (#(procedure #:clean #:foldable) chicken.fixnum#fx- (fixnum fixnum) fixnum)) +(chicken.fixnum#fx* (#(procedure #:clean #:foldable) chicken.fixnum#fx* (fixnum fixnum) fixnum)) +(chicken.fixnum#fx/ (#(procedure #:clean #:foldable) chicken.fixnum#fx/ (fixnum fixnum) fixnum)) +(chicken.fixnum#fxgcd (#(procedure #:clean #:foldable) chicken.fixnum#fxgcd (fixnum fixnum) fixnum)) +(chicken.fixnum#fx+ (#(procedure #:clean #:foldable) chicken.fixnum#fx+ (fixnum fixnum) fixnum)) +(chicken.fixnum#fx< (#(procedure #:clean #:foldable) chicken.fixnum#fx< (fixnum fixnum) boolean)) +(chicken.fixnum#fx<= (#(procedure #:clean #:foldable) chicken.fixnum#fx<= (fixnum fixnum) boolean)) +(chicken.fixnum#fx= (#(procedure #:clean #:foldable) chicken.fixnum#fx= (fixnum fixnum) boolean)) +(chicken.fixnum#fx> (#(procedure #:clean #:foldable) chicken.fixnum#fx> (fixnum fixnum) boolean)) +(chicken.fixnum#fx>= (#(procedure #:clean #:foldable) chicken.fixnum#fx>= (fixnum fixnum) boolean)) +(chicken.fixnum#fxand (#(procedure #:clean #:foldable) chicken.fixnum#fxand (fixnum fixnum) fixnum)) +(chicken.fixnum#fxeven? (#(procedure #:clean #:foldable) chicken.fixnum#fxeven? (fixnum) boolean)) +(chicken.fixnum#fxior (#(procedure #:clean #:foldable) chicken.fixnum#fxior (fixnum fixnum) fixnum)) +(chicken.fixnum#fxmax (#(procedure #:clean #:foldable) chicken.fixnum#fxmax (fixnum fixnum) fixnum)) +(chicken.fixnum#fxmin (#(procedure #:clean #:foldable) chicken.fixnum#fxmin (fixnum fixnum) fixnum)) +(chicken.fixnum#fxmod (#(procedure #:clean #:foldable) chicken.fixnum#fxmod (fixnum fixnum) fixnum)) +(chicken.fixnum#fxrem (#(procedure #:clean #:foldable) chicken.fixnum#fxrem (fixnum fixnum) fixnum)) +(chicken.fixnum#fxneg (#(procedure #:clean #:foldable) chicken.fixnum#fxneg (fixnum) fixnum)) +(chicken.fixnum#fxnot (#(procedure #:clean #:foldable) chicken.fixnum#fxnot (fixnum) fixnum)) +(chicken.fixnum#fxodd? (#(procedure #:clean #:foldable) chicken.fixnum#fxodd? (fixnum) boolean)) +(chicken.fixnum#fxshl (#(procedure #:clean #:foldable) chicken.fixnum#fxshl (fixnum fixnum) fixnum)) +(chicken.fixnum#fxshr (#(procedure #:clean #:foldable) chicken.fixnum#fxshr (fixnum fixnum) fixnum)) +(chicken.fixnum#fxxor (#(procedure #:clean #:foldable) chicken.fixnum#fxxor (fixnum fixnum) fixnum)) +(chicken.fixnum#fxlen (#(procedure #:clean #:foldable) chicken.fixnum#fxlen (fixnum) fixnum)) + (gensym (#(procedure #:clean) gensym (#!optional (or string symbol)) symbol)) (get (#(procedure #:clean #:enforce) get (symbol symbol #!optional *) *) @@ -1231,9 +1233,9 @@ (make-property-condition (#(procedure #:clean #:enforce) make-property-condition (symbol #!rest *) (struct condition))) (chicken.flonum#maximum-flonum float) (chicken.flonum#minimum-flonum float) +(chicken.fixnum#most-negative-fixnum fixnum) +(chicken.fixnum#most-positive-fixnum fixnum) (module-environment (#(procedure #:clean #:enforce) module-environment ((or symbol (list-of (or symbol fixnum))) #!optional *) (struct environment))) -(most-negative-fixnum fixnum) -(most-positive-fixnum fixnum) (on-exit (#(procedure #:clean #:enforce) on-exit ((procedure () . *)) undefined)) (open-input-string (#(procedure #:clean #:enforce) open-input-string (string #!rest) input-port)) (open-output-string (#(procedure #:clean) open-output-string (#!rest) output-port)) @@ -1266,8 +1268,6 @@ (quit (procedure quit (#!optional *) noreturn)) -(ratnum? (#(procedure #:pure #:predicate ratnum) ratnum? (*) boolean)) - (register-feature! (#(procedure #:clean #:enforce) register-feature! (#!rest symbol) undefined)) (remprop! (#(procedure #:clean #:enforce) remprop! (symbol symbol) undefined)) (rename-file (#(procedure #:clean #:enforce) rename-file (string string) string)) @@ -1673,7 +1673,7 @@ (chicken.irregex#irregex-match-num-submatches (#(procedure #:enforce) chicken.irregex#irregex-match-num-submatches ((struct regexp-match)) fixnum) (((struct regexp-match)) - (fx- (fx/ (##sys#size (##sys#slot #(1) '1)) '4) '2))) + (chicken.fixnum#fx- (chicken.fixnum#fx/ (##sys#size (##sys#slot #(1) '1)) '4) '2))) (chicken.irregex#irregex-new-matches (procedure chicken.irregex#irregex-new-matches (*) *)) ; really only for internal use.. (chicken.irregex#irregex-opt (#(procedure #:clean #:enforce) chicken.irregex#irregex-opt (list) *))Trap