Add usual-integrations for SRFI-143 bindings.

diff --git a/src/sf/gconst.scm b/src/sf/gconst.scm
index 01d90f5695b489c7cee3979b00fd48c18f914025..da65fdd623c0f45f7aa8a4fbe9d9ec9adbea1968 100644 (file)
--- a/src/sf/gconst.scm
+++ b/src/sf/gconst.scm
@@ -33,6 +33,9 @@ USA.
   '(char-bits-limit
     char-code-limit
     false
+    fx-greatest
+    fx-least
+    fx-width
     scode-lambda-name:unnamed          ;needed for cold load
     system-global-environment          ;suppresses warnings about (access ...)
     the-empty-stream
@@ -50,8 +53,8 @@ USA.
     (%tagged-object-datum %tagged-object-datum 1)
     (%tagged-object-tag %tagged-object-tag 1)
     (%tagged-object? %tagged-object? 1)
-    (%weak-cons weak-cons 2)
     (%weak-car weak-car 1)
+    (%weak-cons weak-cons 2)
     (%weak-set-car! weak-set-car! 2)
     (bit-string->unsigned-integer bit-string->unsigned-integer)
     (bit-string-allocate bit-string-allocate)
@@ -166,6 +169,26 @@ USA.
     (flo:vector-ref floating-vector-ref)
     (flo:vector-set! floating-vector-set!)
     (flo:zero? flonum-zero?)
+    (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)
+    (fxarithmetic-shift-left 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)
     (general-car-cdr general-car-cdr)
     (get-fixed-objects-vector get-fixed-objects-vector)
     (get-interrupt-enables get-interrupt-enables)
@@ -197,6 +220,7 @@ USA.
     (make-bit-string make-bit-string)
     (make-cell make-cell)
     (make-non-pointer-object make-non-pointer-object)
+    (non-negative-fixnum? index-fixnum? 1)
     (not not)
     (null? null?)
     (object-datum object-datum)
@@ -237,8 +261,8 @@ USA.
     (vector-set! vector-set!)
     (vector? vector?)
     (weak-cdr weak-cdr 1)
-    (weak-pair? weak-pair? 1)
     (weak-pair/car? weak-car 1)
+    (weak-pair? weak-pair? 1)
     (weak-set-cdr! weak-set-cdr! 2)
     (with-history-disabled with-history-disabled)
     (with-interrupt-mask with-interrupt-mask)

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 1760e80b0f373a44c6c69c9991f101b631ae4f9a..8e3118e6956e0bfd900aec7ac0bac5cba3e57a87 100644 (file)
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -128,12 +128,6 @@ USA.
 \f
 ;;;; Fixnum Operations
 
-(define (fix:zero?-expansion expr operands block)
-  (if (and (pair? operands) (null? (cdr operands)))
-      (make-combination expr block (ucode-primitive eq?)
-                       (list (car operands) (constant/make #f 0)))
-      #f))
-
 (define (fix:=-expansion expr operands block)
   (if (and (pair? operands)
           (pair? (cdr operands))
@@ -171,6 +165,31 @@ USA.
                               (ucode-primitive less-than-fixnum?)
                               operands)))
       #f))
+
+(define (fxneg-expansion expr operands block)
+  (if (and (pair? operands)
+          (null? (cdr operands)))
+      (make-combination expr
+                       block
+                       (ucode-primitive minus-fixnum)
+                       (constant/make #f 0)
+                       (car operands))
+      #f))
+
+(define (fxarithmetic-shift-right-expansion expr operands block)
+  (if (and (pair? operands)
+          (pair? (cdr operands))
+          (null? (cddr operands)))
+      (make-combination expr
+                       block
+                       (ucode-primitive fixnum-lsh)
+                       (car operands)
+                       (make-combination #f
+                                         block
+                                         (ucode-primitive minus-fixnum)
+                                         (constant/make #f 0)
+                                         (cadr operands)))
+      #f))
 \f
 ;;;; N-ary Arithmetic Field Operations
 
@@ -763,6 +782,11 @@ USA.
            fix:=
            fix:>=
            fourth
+           fx<=?
+           fx=?
+           fx>=?
+           fxarithmetic-shift-right
+           fxneg
            guarantee
            int:->flonum
            int:integer?
@@ -843,6 +867,11 @@ USA.
           fix:=-expansion
           fix:>=-expansion
           fourth-expansion
+          fix:<=-expansion
+          fix:=-expansion
+          fix:>=-expansion
+          fxarithmetic-shift-right-expansion
+          fxneg-expansion
           guarantee-expansion
           int:->flonum-expansion
           exact-integer?-expansion