~dieggsy/srfi-143

ae5331653bb1492e19a2be942620923f428e853d — dieggsy 3 years ago b9e6caf
Implement variadic arithmetic operators
3 files changed, 45 insertions(+), 13 deletions(-)

M srfi-143-impl.scm
M srfi-143.scm
M srfi-143.svnwiki
M srfi-143-impl.scm => srfi-143-impl.scm +3 -3
@@ 44,7 44,7 @@
(define (fxabs i)
  (if (fxnegative? i) (fxneg i) i))

(define (fxsquare i) (fx* i i))
(define (fxsquare i) (chicken:fx* i i))

(define (fxarithmetic-shift i count)
  (if (negative? count)


@@ 74,7 74,7 @@
  (fxand (mask start end) (fxarithmetic-shift n (- start))))

(define (fxbit-field-rotate n count start end)
  (define width (fx- end start))
  (define width (chicken:fx- end start))
  (set! count (modulo count width))
  (let ((mask (fxnot (fxarithmetic-shift -1 width))))
    (define zn (fxand mask (fxarithmetic-shift n (- start))))


@@ 86,7 86,7 @@

(define (fxreverse k n)
  (do ((m (if (negative? n) (fxnot n) n) (fxarithmetic-shift-right m 1))
       (k (fx+ -1 k) (fx+ -1 k))
       (k (chicken:fx+ -1 k) (chicken:fx+ -1 k))
       (rvs 0 (fxior (fxarithmetic-shift-left rvs 1) (fxand 1 m))))
      ((fxnegative? k) (if (fxnegative? n) (fxnot rvs) rvs))))


M srfi-143.scm => srfi-143.scm +24 -4
@@ 10,7 10,7 @@
  (export fixnum? fx=? fx<? fx>? fx<=? fx>=?
          fxzero? fxpositive? fxnegative?
          fxodd? fxeven? fxmax fxmin)
  (export fx+ fx- fxneg fx* fxquotient fxremainder
  (export fx+ fx- fxneg fx* fx/ fxquotient fxremainder
          fxabs fxsquare fxsqrt)
  (export fx+/carry fx-/carry fx*/carry)
  (export fxnot fxand fxior fxxor fxarithmetic-shift


@@ 23,7 23,8 @@
  (import (rename (only (chicken fixnum)
                        fxmax fxmin fx= fx< fx> fx<= fx>= fx/ fxlen fxrem
                        fxshl fxshr fixnum-bits
                        most-positive-fixnum most-negative-fixnum)
                        most-positive-fixnum most-negative-fixnum
                        fx+ fx- fx*)
                  (fxmax chicken:fxmax)
                  (fxmin chicken:fxmin)
                  (fx= chicken:fx=)


@@ 38,9 39,12 @@
                  (fxshr fxarithmetic-shift-right)
                  (fixnum-bits fx-width)
                  (most-positive-fixnum fx-greatest)
                  (most-negative-fixnum fx-least)))
                  (most-negative-fixnum fx-least)
                  (fx+ chicken:fx+)
                  (fx- chicken:fx-)
                  (fx* chicken:fx*)))
  (import (only (chicken base) fixnum?))
  (import (only (chicken fixnum) fx+ fx- fx* fxneg fxand fxior fxxor
  (import (only (chicken fixnum) fxneg fxand fxior fxxor
                fxnot fxodd? fxeven?))
  (import (only (chicken platform) register-feature!))



@@ 61,6 65,22 @@
              ((fxpositive? n) (logcnt n 0))
              (else 0)))))

  (define (fx+ . args)
    (foldr chicken:fx+ 0 args))

  (define (fx- x . args)
    (if (null? args)
        (fxneg x)
        (foldl chicken:fx- x args)))

  (define (fx* . args)
    (foldr chicken:fx* 1 args))

  (define (fx/ x . args)
    (if (null? args)
        (fxquotient 1 x)
        (foldl fxquotient x args)))


  (include "carries.scm")
  (include "srfi-143-impl.scm"))

M srfi-143.svnwiki => srfi-143.svnwiki +18 -6
@@ 46,6 46,14 @@ In CHICKEN, this SRFI uses the built-in
[[https://wiki.call-cc.org/man/5/Module%20(chicken%20fixnum)|(chicken fixnum)]]
module, in which overflows "wrap around".

=== Deviations from the specification

In the CHICKEN implementation, {{fx+}}, {{fx-}}, and {{fx*}} are variadic,
implemented with {{foldr}}, {{foldl}}, and {{foldr}}, respectively. For
completeness, a variadic {{fx/}} is provided as well, implemented with
{{foldl}}. It's not clear that this is much more useful than the SRFI's
{{fxquotient}}.

=== Specification

Fixnums are an implementation-defined subset of the exact integers. Every


@@ 143,21 151,25 @@ Semantically equivalent to {{min}}.

==== Basic arithmetic

<procedure>(fx+ i j)</procedure>
<procedure>(fx+ i ...)</procedure>

Semantically equivalent to {{+}}, but accepts exactly two arguments.
Semantically equivalent to {{+}}.

<procedure>(fx- i j)</procedure>
<procedure>(fx- i ...)</procedure>

Semantically equivalent to {{-}}, but accepts exactly two arguments.
Semantically equivalent to {{-}}.

<procedure>(fxneg i)</procedure>

Semantically equivalent to {{-}}, but accepts exactly one argument.

<procedure>(fx* i j)</procedure>
<procedure>(fx* i ...)</procedure>

Semantically equivalent to {{*}}.

<procedure>(fx/ i ...)</procedure>

Semantically equivalent to {{*}}, but accepts exactly two arguments.
Semantically equivalent to {{(foldr quotient i rest-args)}}.

<procedure>(fxquotient i j)</procedure>