From d6acec19d3b4f227f941f9959b8ab99687187ce9 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 4 Nov 2019 20:06:03 -0800
Subject: [PATCH] Add some SRFI-143 renames to primitive arithmetic.

---
 src/runtime/predicate.scm            |   3 -
 src/runtime/primitive-arithmetic.scm | 119 +++++++++++++--------------
 src/runtime/runtime.pkg              |  79 ++++++++++++------
 3 files changed, 111 insertions(+), 90 deletions(-)

diff --git a/src/runtime/predicate.scm b/src/runtime/predicate.scm
index bb0c6e602..b96d79918 100644
--- 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 942e4d950..f2488b842 100644
--- 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))))
 
 (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 a32088b54..e9128a590 100644
--- 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:-
-- 
2.25.1