Add some SRFI-143 renames to primitive arithmetic.

diff --git a/src/runtime/predicate.scm b/src/runtime/predicate.scm
index bb0c6e60299ed99c50ab59e149a71a64eeeaade7..b96d79918340b4f97bae9d2ed24ed0a100d003f1 100644 (file)
--- a/src/runtime/predicate.scm
+++ b/src/runtime/predicate.scm
@@ -201,9 +201,6 @@ USA.
    (register-predicate! exact-rational? 'exact-rational '<= rational?)
 
    (register-predicate! fix:fixnum? 'fixnum '<= exact-integer?)
-   (register-predicate! index-fixnum? 'index-fixnum
-                       '<= fix:fixnum?
-                       '<= exact-nonnegative-integer?)
    (register-predicate! negative-fixnum? 'negative-fixnum '<= fix:fixnum?)
    (register-predicate! positive-fixnum? 'positive-fixnum
                        '<= fix:fixnum?

diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm
index 942e4d950ff4a5da612bf863335a8f16f8bcda57..f2488b8425ebfd56b58cd38792921f537063ca78 100644 (file)
--- a/src/runtime/primitive-arithmetic.scm
+++ b/src/runtime/primitive-arithmetic.scm
@@ -32,82 +32,79 @@ USA.
 ;;;; Fixnums
 
 (define-primitives
-  (fix:fixnum? fixnum? 1)
-  (fixnum? fixnum? 1)
-  (index-fixnum? index-fixnum? 1)
-  (fix:zero? zero-fixnum? 1)
-  (fix:negative? negative-fixnum? 1)
-  (fix:positive? positive-fixnum? 1)
-  (fix:= equal-fixnum? 2)
-  (fix:< less-than-fixnum? 2)
-  (fix:> greater-than-fixnum? 2)
-  (fix:1+ one-plus-fixnum 1)
-  (fix:-1+ minus-one-plus-fixnum 1)
-  (fix:+ plus-fixnum 2)
-  (fix:- minus-fixnum 2)
-  (fix:* multiply-fixnum 2)
   (fix:divide divide-fixnum 2)
-  (fix:quotient fixnum-quotient 2)
-  (fix:remainder fixnum-remainder 2)
   (fix:gcd gcd-fixnum 2)
-  (fix:andc fixnum-andc 2)
-  (fix:and fixnum-and 2)
-  (fix:or fixnum-or 2)
-  (fix:xor fixnum-xor 2)
-  (fix:not fixnum-not 1)
-  (fix:lsh fixnum-lsh 2))
+  (fixnum? fixnum? 1)
+  (fx* multiply-fixnum 2)
+  (fx+ plus-fixnum 2)
+  (fx- minus-fixnum 2)
+  (fx<? less-than-fixnum? 2)
+  (fx=? equal-fixnum? 2)
+  (fx>? greater-than-fixnum? 2)
+  (fxand fixnum-and 2)
+  (fxandc fixnum-andc 2)
+  (fxarithmetic-shift fixnum-lsh 2)
+  (fxdecr minus-one-plus-fixnum 1)
+  (fxincr one-plus-fixnum 1)
+  (fxior fixnum-or 2)
+  (fxnegative? negative-fixnum? 1)
+  (fxnot fixnum-not 1)
+  (fxpositive? positive-fixnum? 1)
+  (fxquotient fixnum-quotient 2)
+  (fxremainder fixnum-remainder 2)
+  (fxxor fixnum-xor 2)
+  (fxzero? zero-fixnum? 1)
+  (non-negative-fixnum? index-fixnum? 1))
+
+(define (fx<=? n m) (not (fx>? n m)))
+(define (fx>=? n m) (not (fx<? n m)))
+(define (fxabs n) (if (fx<? n 0) (fx- 0 n) n))
+(define (fxarithmetic-shift-right n m) (fxarithmetic-shift n (fx- 0 m)))
+(define (fxmax n m) (if (fx>? n m) n m))
+(define (fxmin n m) (if (fx<? n m) n m))
+(define (fxneg n) (fx- 0 n))
+(define (fxsquare n) (fx* n n))
 
 (define (positive-fixnum? object)
   (and (fixnum? object)
-       (fix:positive? object)))
+       (fxpositive? object)))
 
 (define (negative-fixnum? object)
   (and (fixnum? object)
-       (fix:negative? object)))
-
-(define (non-negative-fixnum? object)
-  (and (fixnum? object)
-       (not (fix:negative? object))))
+       (fxnegative? object)))
 
 (define (non-positive-fixnum? object)
   (and (fixnum? object)
-       (not (fix:positive? object))))
+       (not (fxpositive? object))))
 \f
 (define (guarantee-limited-index-fixnum object limit #!optional caller)
   (guarantee index-fixnum? object caller)
   (if (not (fix:< object limit))
       (error:bad-range-argument object caller)))
 
-(define (fix:<= n m) (not (fix:> n m)))
-(define (fix:>= n m) (not (fix:< n m)))
-(define (fix:min n m) (if (fix:< n m) n m))
-(define (fix:max n m) (if (fix:> n m) n m))
-
-(define (fix:largest-value)
-  (force largest-fixnum-promise))
-
-(define largest-fixnum-promise
-  (delay
-    (let loop ((n 1))
-      (if (fix:fixnum? n)
-         (loop (* n 2))
-         (let ((n (- n 1)))
-           (if (not (fix:fixnum? n))
-               (error "Unable to compute largest fixnum:" n))
-           n)))))
-
-(define (fix:smallest-value)
-  (force smallest-fixnum-promise))
-
-(define smallest-fixnum-promise
-  (delay
-    (let loop ((n -1))
-      (if (fix:fixnum? n)
-         (loop (* n 2))
-         (let ((n (quotient n 2)))
-           (if (not (fix:fixnum? n))
-               (error "Unable to compute smallest fixnum:" n))
-           n)))))
+(define (fix:largest-value) fx-greatest)
+(define (fix:smallest-value) fx-least)
+
+(define fx-width)
+(define fx-greatest)
+(define fx-least)
+(add-boot-init!
+ (lambda ()
+   (let loop ((n 1) (w 1))
+     (if (fixnum? n)
+        (loop (int:* n 2) (int:+ w 1))
+        (let ((n (int:- n 1)))
+          (if (not (fixnum? n))
+              (error "Unable to compute largest fixnum:" n))
+          (set! fx-greatest n)
+          (set! fx-width w))))
+   (let loop ((n -1))
+     (if (fixnum? n)
+        (loop (int:* n 2))
+        (let ((n (int:quotient n 2)))
+          (if (not (fixnum? n))
+              (error "Unable to compute smallest fixnum:" n))
+          (set! fx-least n))))))
 
 (define (fix:iota count #!optional start step)
   (guarantee index-fixnum? count 'fix:iota)
@@ -115,13 +112,13 @@ USA.
         (if (default-object? start)
             0
             (begin
-              (guarantee fix:fixnum? start 'fix:iota)
+              (guarantee fixnum? start 'fix:iota)
               start)))
        (step
         (if (default-object? step)
             1
             (begin
-              (guarantee fix:fixnum? step 'fix:iota)
+              (guarantee fixnum? step 'fix:iota)
               step))))
     (let loop
        ((index (fix:- count 1))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a32088b545607a2451174d2f4a37c3e22eecf6db..e9128a59065edf8f73bfd8346387104255446ca2 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -257,42 +257,70 @@ USA.
          (smallest-fixnum fix:smallest-value))
   (export ()
          (exact-integer? int:integer?)
+         (fix:* fx*)
+         (fix:+ fx+)
+         (fix:- fx-)
+         (fix:-1+ fxdecr)
+         (fix:1+ fxincr)
+         (fix:< fx<?)
+         (fix:<= fx<=?)
+         (fix:= fx=?)
+         (fix:> fx>?)
+         (fix:>= fx>=?)
+         (fix:and fxand)
+         (fix:andc fxandc)
+         (fix:andc fxandc)
+         (fix:fixnum? fixnum?)
+         (fix:lsh fxarithmetic-shift)
+         (fix:max fxmax)
+         (fix:min fxmin)
+         (fix:negative? fxnegative?)
+         (fix:not fxnot)
+         (fix:or fxior)
+         (fix:positive? fxpositive?)
+         (fix:quotient fxquotient)
+         (fix:remainder fxremainder)
+         (fix:xor fxxor)
+         (fix:zero? fxzero?)
          (flo:ldexp flo:denormalize)
          (flo:scalbn flo:denormalize)
+         (fxarithmetic-shift-left fxarithmetic-shift) ;SRFI-143
+         (index-fixnum? non-negative-fixnum?)
          ->flonum
          exact-integer-sqrt
-         fix:*
-         fix:+
-         fix:-
-         fix:-1+
-         fix:1+
-         fix:<
-         fix:<=
-         fix:=
-         fix:>
-         fix:>=
-         fix:and
-         fix:andc
          fix:divide
          fix:end-index
-         fix:fixnum?
          fix:gcd
          fix:iota
          fix:largest-value
-         fix:lsh
-         fix:max
-         fix:min
-         fix:negative?
-         fix:not
-         fix:or
-         fix:positive?
-         fix:quotient
-         fix:remainder
          fix:smallest-value
          fix:start-index
-         fix:xor
-         fix:zero?
-         fixnum?
+         fixnum?                       ;SRFI-143
+         fx*                           ;SRFI-143
+         fx+                           ;SRFI-143
+         fx-                           ;SRFI-143
+         fx-greatest                   ;SRFI-143
+         fx-least                      ;SRFI-143
+         fx-width                      ;SRFI-143
+         fxabs                         ;SRFI-143
+         fxand                         ;SRFI-143
+         fxandc
+         fxarithmetic-shift            ;SRFI-143
+         fxarithmetic-shift-right      ;SRFI-143
+         fxdecr
+         fxincr
+         fxior                         ;SRFI-143
+         fxmax                         ;SRFI-143
+         fxmin                         ;SRFI-143
+         fxneg                         ;SRFI-143
+         fxnegative?                   ;SRFI-143
+         fxnot                         ;SRFI-143
+         fxpositive?                   ;SRFI-143
+         fxquotient                    ;SRFI-143
+         fxremainder                   ;SRFI-143
+         fxsquare                      ;SRFI-143
+         fxxor                         ;SRFI-143
+         fxzero?                       ;SRFI-143
          flo:*
          flo:*+
          flo:+
@@ -393,7 +421,6 @@ USA.
          flo:yn
          flo:zero?
          guarantee-limited-index-fixnum
-         index-fixnum?
          int:*
          int:+
          int:-