;		       Copyright (C) 1992 by Marc Feeley -- all rights reserved

;; "_numbers.scm"

(##include "header.scm")

;------------------------------------------------------------------------------

; Number stuff

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; There are 5 internal representations for numbers:
;
; fixnum, bignum, ratnum, flonum, cpxnum
;
; Fixnums and bignums form the class of exact-int.
; Fixnums, bignums and ratnums form the class of exact-real.
; Fixnums, bignums, ratnums and flonums form the class of non-cpxnum.

; The representation has some invariants:
;
; The numerator of a ratnum is an exact-int.
; The denominator of a ratnum is a positive (>1) exact-int.
; The numerator and denominator have no common divisors.
;
; The real part of a cpxnum is a non-cpxnum.
; The imaginary part of a cpxnum is a non-cpxnum != fixnum 0

; The following table gives the mapping of the Scheme exact numbers to their
; internal representation:
;
;    type          representation
; exact integer  = exact-int (fixnum, bignum)
; exact rational = exact-real (fixnum, bignum, ratnum)
; exact real     = exact-real (fixnum, bignum, ratnum)
; exact complex  = exact-real or cpxnum with exact-real real and imag parts

; For inexact numbers, the representation is not quite as straightforward.
;
; There are 3 "special" classes of inexact representation:
; flonum-int : flonum with integer value
; cpxnum-real: cpxnum with imag part = flonum 0.0
; cpxnum-int : cpxnum-real with exact-int or flonum-int real part
;
; This gives to the following table for Scheme's inexact numbers:
;
;      type          representation
; inexact integer  = flonum-int or cpxnum-int
; inexact rational = flonum     or cpxnum-real
; inexact real     = flonum     or cpxnum-real
; inexact complex  = flonum     or cpxnum

(##define-macro (exact-int? x) ; x can be any object
  `(or (##fixnum? ,x) (##bignum? ,x)))

(##define-macro (exact-real? x) ; x can be any object
  `(or (exact-int? ,x) (##ratnum? ,x)))

(##define-macro (flonum-zero? x) ; x can be any object
  `(and (##flonum? ,x) (##flonum.zero? ,x)))

(##define-macro (flonum-int? x) ; x must be a flonum
  `(##flonum.= ,x (##flonum.truncate ,x)))

(##define-macro (non-cpxnum-int? x) ; x must be in fixnum/bignum/ratnum/flonum
  `(if (##flonum? ,x) (flonum-int? ,x) (##not (##ratnum? ,x))))

(##define-macro (non-cpxnum-zero? x) ; x must be in fixnum/bignum/ratnum/flonum
  `(if (##fixnum? ,x) (##fixnum.= ,x 0) (flonum-zero? ,x)))

(##define-macro (cpxnum-int? x) ; x must be a cpxnum
  `(and (cpxnum-real? ,x)
        (let ((real (cpxnum-real ,x))) (non-cpxnum-int? ,x))))

(##define-macro (cpxnum-real? x) ; x must be a cpxnum
  `(let ((imag (cpxnum-imag ,x))) (flonum-zero? imag)))

(##define-macro (inexact-+2)     2.0)
(##define-macro (inexact--2)    -2.0)
(##define-macro (inexact-+1)     1.0)
(##define-macro (inexact--1)    -1.0)
(##define-macro (inexact-+1/2)   0.5)
(##define-macro (inexact-0)      0.0)
(##define-macro (inexact-+pi)    3.141592653589793)
(##define-macro (inexact--pi)   -3.141592653589793)
(##define-macro (inexact-+pi/2)  1.5707963267948966)
(##define-macro (inexact--pi/2) -1.5707963267948966)
(##define-macro (cpxnum-+2i)    +2i)
(##define-macro (cpxnum--i)     -i)
(##define-macro (cpxnum-+i)     +i)

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Numerical type predicates

(define (##complex? x)
  (number-dispatch x #f #t #t #t #t #t))

(define (##real? x)
  (number-dispatch x #f #t #t #t #t (cpxnum-real? x)))

(define (##rational? x)
  (number-dispatch x #f #t #t #t #t (cpxnum-real? x)))

(define (##integer? x)
  (number-dispatch x #f #t #t #f (flonum-int? x) (cpxnum-int? x)))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Exactness predicates

(define (##exact? x)

  (define (error) (##trap-check-number 'exact? x))

  (number-dispatch x (error) #t #t #t #f
    (and (##not (##flonum? (cpxnum-real x)))
         (##not (##flonum? (cpxnum-imag x))))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Numerical comparison predicates

(define (##eqv? x y)
  (number-dispatch x (##eq? x y)
    (if (##fixnum? y) (##fixnum.= x y) #f)
    (if (##bignum? y) (##bignum.= x y) #f)
    (if (##ratnum? y) (##ratnum.= x y) #f)
    (and (##complex? y) (##not (##exact? y)) (##= x y))
    (and (##complex? y) (##eq? (##exact? x) (##exact? y)) (##= x y))))

(define (##= x y)

  (define (error) (##trap-check-number '= x y))

  (number-dispatch x (error)

    (number-dispatch y (error) ; x = fixnum
      (##fixnum.= x y)
      #f
      #f
      (##flonum.= (##flonum.<-fixnum x) y)
      (##cpxnum.= (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = bignum
      #f
      (##bignum.= x y)
      #f
      (##flonum.= (##flonum.<-bignum x) y)
      (##cpxnum.= (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = ratnum
      #f
      #f
      (##ratnum.= x y)
      (##ratnum.= x (##flonum.->ratnum y))
      (##cpxnum.= (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = flonum
      (##ratnum.= (##flonum.->ratnum x) (##ratnum.<-exact-int y))
      (##ratnum.= (##flonum.->ratnum x) (##ratnum.<-exact-int y))
      (##ratnum.= (##flonum.->ratnum x) y)
      (##flonum.= x y)
      (##cpxnum.= (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = cpxnum
      (##cpxnum.= x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.= x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.= x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.= x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.= x y))))

(define (##< x y)

  (define (error) (##trap-check-real '< x y))

  (number-dispatch x (error)

    (number-dispatch y (error) ; x = fixnum
      (##fixnum.< x y)
      (bignum-positive? y)
      (##ratnum.< (##ratnum.<-exact-int x) y)
      (##flonum.< (##flonum.<-fixnum x) y)
      (if (cpxnum-real? y) (##< x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = bignum
      (bignum-negative? x)
      (##bignum.< x y)
      (##ratnum.< (##ratnum.<-exact-int x) y)
      (##flonum.< (##flonum.<-bignum x) y)
      (if (cpxnum-real? y) (##< x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = ratnum
      (##ratnum.< x (##ratnum.<-exact-int y))
      (##ratnum.< x (##ratnum.<-exact-int y))
      (##ratnum.< x y)
      (##ratnum.< x (##flonum.->ratnum y))
      (if (cpxnum-real? y) (##< x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = flonum
      (##ratnum.< (##flonum.->ratnum x) (##ratnum.<-exact-int y))
      (##ratnum.< (##flonum.->ratnum x) (##ratnum.<-exact-int y))
      (##ratnum.< (##flonum.->ratnum x) y)
      (##flonum.< x y)
      (if (cpxnum-real? y) (##< x (cpxnum-real y)) (error)))

    (if (cpxnum-real? x) ; x = cpxnum
      (number-dispatch y (error)
        (##< (cpxnum-real x) y)
        (##< (cpxnum-real x) y)
        (##< (cpxnum-real x) y)
        (##< (cpxnum-real x) y)
        (if (cpxnum-real? y) (##< (cpxnum-real x) (cpxnum-real y)) (error)))
      (error))))

(define (##zero? x)

  (define (error) (##trap-check-number 'zero? x))

  (number-dispatch x (error) (##fixnum.= x 0) #f #f (##flonum.zero? x)
    (let ((imag (cpxnum-imag x)))
      (and (flonum-zero? imag)
           (let ((real (cpxnum-real x)))
             (non-cpxnum-zero? real))))))

(define (##positive? x)

  (define (error) (##trap-check-real 'positive? x))

  (number-dispatch x (error)
    (##fixnum.positive? x)
    (bignum-positive? x)
    (##positive? (ratnum-numerator x))
    (##flonum.positive? x)
    (if (cpxnum-real? x) (##positive? (cpxnum-real x)) (error))))

(define (##negative? x)

  (define (error) (##trap-check-real 'negative? x))

  (number-dispatch x (error)
    (##fixnum.negative? x)
    (bignum-negative? x)
    (##negative? (ratnum-numerator x))
    (##flonum.negative? x)
    (if (cpxnum-real? x) (##negative? (cpxnum-real x)) (error))))

(define (##odd? x)

  (define (error) (##trap-check-integer 'odd? x))

  (number-dispatch x (error)
    (##fixnum.odd? x)
    (bignum-odd? x)
    (error)
    (if (flonum-int? x) (##odd? (##flonum.->exact-int x)) (error))
    (if (cpxnum-int? x) (##odd? (cpxnum-real x)) (error))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Max and min

(define (##max x y)

  (define (error) (##trap-check-real 'max x y))

  (define (m x y) (if (##< x y) y x))

  (number-dispatch x (error)

    (number-dispatch y (error) ; x = fixnum
      (m x y)
      (m x y)
      (m x y)
      (if (##< x y) y (##flonum.<-fixnum x))
      (if (cpxnum-real? y) (##max x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = bignum
      (m x y)
      (m x y)
      (m x y)
      (if (##< x y) y (##flonum.<-bignum x))
      (if (cpxnum-real? y) (##max x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = ratnum
      (m x y)
      (m x y)
      (m x y)
      (if (##< x y) y (##flonum.<-ratnum x))
      (if (cpxnum-real? y) (##max x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = flonum
      (if (##< x y) (##flonum.<-fixnum y) x)
      (if (##< x y) (##flonum.<-bignum y) x)
      (if (##< x y) (##flonum.<-ratnum y) x)
      (m x y)
      (if (cpxnum-real? y) (##max x (cpxnum-real y)) (error)))

    (if (cpxnum-real? x) ; x = cpxnum
      (number-dispatch y (error)
        (##max (cpxnum-real x) y)
        (##max (cpxnum-real x) y)
        (##max (cpxnum-real x) y)
        (##max (cpxnum-real x) y)
        (if (cpxnum-real? y) (##max (cpxnum-real x) (cpxnum-real y)) (error)))
      (error))))

(define (##min x y)

  (define (error) (##trap-check-real 'min x y))

  (define (m x y) (if (##< x y) x y))

  (number-dispatch x (error)

    (number-dispatch y (error) ; x = fixnum
      (m x y)
      (m x y)
      (m x y)
      (if (##< x y) (##flonum.<-fixnum x) y)
      (if (cpxnum-real? y) (##min x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = bignum
      (m x y)
      (m x y)
      (m x y)
      (if (##< x y) (##flonum.<-bignum x) y)
      (if (cpxnum-real? y) (##min x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = ratnum
      (m x y)
      (m x y)
      (m x y)
      (if (##< x y) (##flonum.<-ratnum x) y)
      (if (cpxnum-real? y) (##min x (cpxnum-real y)) (error)))

    (number-dispatch y (error) ; x = flonum
      (if (##< x y) x (##flonum.<-fixnum y))
      (if (##< x y) x (##flonum.<-bignum y))
      (if (##< x y) x (##flonum.<-ratnum y))
      (m x y)
      (if (cpxnum-real? y) (##min x (cpxnum-real y)) (error)))

    (if (cpxnum-real? x) ; x = cpxnum
      (number-dispatch y (error)
        (##min (cpxnum-real x) y)
        (##min (cpxnum-real x) y)
        (##min (cpxnum-real x) y)
        (##min (cpxnum-real x) y)
        (if (cpxnum-real? y) (##min (cpxnum-real x) (cpxnum-real y)) (error)))
      (error))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; +, *, -, /

(define (##+ x y)

  (define (error) (##trap-check-number '+ x y))

  (number-dispatch x (error)

    (number-dispatch y (error) ; x = fixnum
      (##bignum.+/fixnum-fixnum x y)
      (##bignum.+/bignum-fixnum y x)
      (##ratnum.+ (##ratnum.<-exact-int x) y)
      (##flonum.+ (##flonum.<-fixnum x) y)
      (##cpxnum.+ (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = bignum
      (##bignum.+/bignum-fixnum x y)
      (##bignum.+ x y)
      (##ratnum.+ (##ratnum.<-exact-int x) y)
      (##flonum.+ (##flonum.<-bignum x) y)
      (##cpxnum.+ (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = ratnum
      (##ratnum.+ x (##ratnum.<-exact-int y))
      (##ratnum.+ x (##ratnum.<-exact-int y))
      (##ratnum.+ x y)
      (##flonum.+ (##flonum.<-ratnum x) y)
      (##cpxnum.+ (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = flonum
      (##flonum.+ x (##flonum.<-fixnum y))
      (##flonum.+ x (##flonum.<-bignum y))
      (##flonum.+ x (##flonum.<-ratnum y))
      (##flonum.+ x y)
      (##cpxnum.+ (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = cpxnum
      (##cpxnum.+ x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.+ x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.+ x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.+ x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.+ x y))))

(define (##* x y)

  (define (error) (##trap-check-number '* x y))

  (number-dispatch x (error)

    (number-dispatch y (error) ; x = fixnum
      (##bignum.*/fixnum-fixnum x y)
      (##bignum.*/bignum-fixnum y x)
      (##ratnum.* (##ratnum.<-exact-int x) y)
      (##flonum.* (##flonum.<-fixnum x) y)
      (##cpxnum.* (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = bignum
      (##bignum.*/bignum-fixnum x y)
      (##bignum.* x y)
      (##ratnum.* (##ratnum.<-exact-int x) y)
      (##flonum.* (##flonum.<-bignum x) y)
      (##cpxnum.* (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = ratnum
      (##ratnum.* x (##ratnum.<-exact-int y))
      (##ratnum.* x (##ratnum.<-exact-int y))
      (##ratnum.* x y)
      (##flonum.* (##flonum.<-ratnum x) y)
      (##cpxnum.* (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = flonum
      (##flonum.* x (##flonum.<-fixnum y))
      (##flonum.* x (##flonum.<-bignum y))
      (##flonum.* x (##flonum.<-ratnum y))
      (##flonum.* x y)
      (##cpxnum.* (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = cpxnum
      (##cpxnum.* x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.* x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.* x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.* x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.* x y))))

(define (##- x y)

  (define (error) (##trap-check-number '- x y))

  (number-dispatch x (error)

    (number-dispatch y (error) ; x = fixnum
      (##bignum.-/fixnum-fixnum x y)
      (##bignum.-/fixnum-bignum x y)
      (##ratnum.- (##ratnum.<-exact-int x) y)
      (##flonum.- (##flonum.<-fixnum x) y)
      (##cpxnum.- (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = bignum
      (##bignum.-/bignum-fixnum x y)
      (##bignum.- x y)
      (##ratnum.- (##ratnum.<-exact-int x) y)
      (##flonum.- (##flonum.<-bignum x) y)
      (##cpxnum.- (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = ratnum
      (##ratnum.- x (##ratnum.<-exact-int y))
      (##ratnum.- x (##ratnum.<-exact-int y))
      (##ratnum.- x y)
      (##flonum.- (##flonum.<-ratnum x) y)
      (##cpxnum.- (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = flonum
      (##flonum.- x (##flonum.<-fixnum y))
      (##flonum.- x (##flonum.<-bignum y))
      (##flonum.- x (##flonum.<-ratnum y))
      (##flonum.- x y)
      (##cpxnum.- (##cpxnum.<-non-cpxnum x) y))

    (number-dispatch y (error) ; x = cpxnum
      (##cpxnum.- x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.- x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.- x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.- x (##cpxnum.<-non-cpxnum y))
      (##cpxnum.- x y))))

(define (##/ x y)

  (define (divide-by-zero) (##trap-divide-by-zero '/ x y))

  (define (error) (##trap-check-number '/ x y))

  (number-dispatch y (error)

    (if (##fixnum.= y 0) ; y = fixnum
      (divide-by-zero)
      (number-dispatch x (error)
        (##ratnum./ (##ratnum.<-exact-int x) (##ratnum.<-exact-int y))
        (##ratnum./ (##ratnum.<-exact-int x) (##ratnum.<-exact-int y))
        (##ratnum./ x (##ratnum.<-exact-int y))
        (##flonum./ x (##flonum.<-fixnum y))
        (##cpxnum./ x (##cpxnum.<-non-cpxnum y))))

    (number-dispatch x (error) ; y = bignum
      (##ratnum./ (##ratnum.<-exact-int x) (##ratnum.<-exact-int y))
      (##ratnum./ (##ratnum.<-exact-int x) (##ratnum.<-exact-int y))
      (##ratnum./ x (##ratnum.<-exact-int y))
      (##flonum./ x (##flonum.<-bignum y))
      (##cpxnum./ x (##cpxnum.<-non-cpxnum y)))

    (number-dispatch x (error) ; y = ratnum
      (##ratnum./ (##ratnum.<-exact-int x) y)
      (##ratnum./ (##ratnum.<-exact-int x) y)
      (##ratnum./ x y)
      (##flonum./ x (##flonum.<-ratnum y))
      (##cpxnum./ x (##cpxnum.<-non-cpxnum y)))

    (if (##flonum.zero? y) ; y = flonum
      (divide-by-zero)
      (number-dispatch x (error)
        (##flonum./ (##flonum.<-fixnum x) y)
        (##flonum./ (##flonum.<-bignum x) y)
        (##flonum./ (##flonum.<-ratnum x) y)
        (##flonum./ x y)
        (##cpxnum./ x (##cpxnum.<-non-cpxnum y))))

    (let ((imag (cpxnum-imag y))) ; y = cpxnum
      (if (and (flonum-zero? imag)
               (let ((real (cpxnum-real y)))
                 (non-cpxnum-zero? real)))
        (divide-by-zero)
        (number-dispatch x (error)
          (##cpxnum./ (##cpxnum.<-non-cpxnum x) y)
          (##cpxnum./ (##cpxnum.<-non-cpxnum x) y)
          (##cpxnum./ (##cpxnum.<-non-cpxnum x) y)
          (##cpxnum./ (##cpxnum.<-non-cpxnum x) y)
          (##cpxnum./ x y))))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; abs

(define (##abs x)

  (define (error) (##trap-check-real 'abs x))

  (number-dispatch x (error)
    (if (##fixnum.negative? x) (##bignum.-/fixnum-fixnum 0 x) x)
    (if (bignum-negative? x) (##bignum.-/fixnum-bignum 0 x) x)
    (if (##negative? (ratnum-numerator x))
      (ratnum-make (##- 0 (ratnum-numerator x)) (ratnum-denominator x))
      x)
    (##flonum.abs x)
    (if (cpxnum-real? x) (##abs (cpxnum-real x)) (error))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; quotient, remainder, modulo

(define (##quotient x y)

  (define (divide-by-zero) (##trap-divide-by-zero 'quotient x y))

  (define (error) (##trap-check-integer 'quotient x y))

  (define (inexact-quotient)
    (##exact->inexact (##quotient (##inexact->exact x) (##inexact->exact y))))

  (number-dispatch y (error)

    (if (##fixnum.= y 0) ; y = fixnum
      (divide-by-zero)
      (number-dispatch x (error)
        (if (##fixnum.= y -1)
          (##bignum.-/fixnum-fixnum 0 x)
          (##fixnum.quotient x y))
        (##bignum.quotient/bignum-fixnum x y)
        (error)
        (if (flonum-int? x) (inexact-quotient) (error))
        (if (cpxnum-int? x) (inexact-quotient) (error))))

    (number-dispatch x (error) ; y = bignum
      (##bignum.quotient/fixnum-bignum x y)
      (##bignum.quotient x y)
      (error)
      (if (flonum-int? x) (inexact-quotient) (error))
      (if (cpxnum-int? x) (inexact-quotient) (error)))

    (error) ; y = ratnum

    (if (flonum-int? y) ; y = flonum
      (number-dispatch x (error)
        (inexact-quotient)
        (inexact-quotient)
        (error)
        (if (flonum-int? x) (inexact-quotient) (error))
        (if (cpxnum-int? x) (inexact-quotient) (error)))
      (error))

    (if (cpxnum-int? y) ; y = cpxnum
      (number-dispatch x (error)
        (inexact-quotient)
        (inexact-quotient)
        (error)
        (if (flonum-int? x) (inexact-quotient) (error))
        (if (cpxnum-int? x) (inexact-quotient) (error)))
      (error))))

(define (##remainder x y)

  (define (divide-by-zero) (##trap-divide-by-zero 'remainder x y))

  (define (error) (##trap-check-integer 'remainder x y))

  (define (inexact-remainder)
    (##exact->inexact (##remainder (##inexact->exact x) (##inexact->exact y))))

  (number-dispatch y (error)

    (if (##fixnum.= y 0) ; y = fixnum
      (divide-by-zero)
      (number-dispatch x (error)
        (##fixnum.remainder x y)
        (##bignum.remainder/bignum-fixnum x y)
        (error)
        (if (flonum-int? x) (inexact-remainder) (error))
        (if (cpxnum-int? x) (inexact-remainder) (error))))

    (number-dispatch x (error) ; y = bignum
      (##bignum.remainder/fixnum-bignum x y)
      (##bignum.remainder x y)
      (error)
      (if (flonum-int? x) (inexact-remainder) (error))
      (if (cpxnum-int? x) (inexact-remainder) (error)))

    (error) ; y = ratnum

    (if (flonum-int? y) ; y = flonum
      (number-dispatch x (error)
        (inexact-remainder)
        (inexact-remainder)
        (error)
        (if (flonum-int? x) (inexact-remainder) (error))
        (if (cpxnum-int? x) (inexact-remainder) (error)))
      (error))

    (if (cpxnum-int? y) ; y = cpxnum
      (number-dispatch x (error)
        (inexact-remainder)
        (inexact-remainder)
        (error)
        (if (flonum-int? x) (inexact-remainder) (error))
        (if (cpxnum-int? x) (inexact-remainder) (error)))
      (error))))

(define (##modulo x y)

  (define (divide-by-zero) (##trap-divide-by-zero 'modulo x y))

  (define (error) (##trap-check-integer 'modulo x y))

  (define (inexact-modulo)
    (##exact->inexact (##modulo (##inexact->exact x) (##inexact->exact y))))

  (number-dispatch y (error)

    (if (##fixnum.= y 0) ; y = fixnum
      (divide-by-zero)
      (number-dispatch x (error)
        (##fixnum.modulo x y)
        (##bignum.modulo/bignum-fixnum x y)
        (error)
        (if (flonum-int? x) (inexact-modulo) (error))
        (if (cpxnum-int? x) (inexact-modulo) (error))))

    (number-dispatch x (error) ; y = bignum
      (##bignum.modulo/fixnum-bignum x y)
      (##bignum.modulo x y)
      (error)
      (if (flonum-int? x) (inexact-modulo) (error))
      (if (cpxnum-int? x) (inexact-modulo) (error)))

    (error) ; y = ratnum

    (if (flonum-int? y) ; y = flonum
      (number-dispatch x (error)
        (inexact-modulo)
        (inexact-modulo)
        (error)
        (if (flonum-int? x) (inexact-modulo) (error))
        (if (cpxnum-int? x) (inexact-modulo) (error)))
      (error))

    (if (cpxnum-int? y) ; y = cpxnum
      (number-dispatch x (error)
        (inexact-modulo)
        (inexact-modulo)
        (error)
        (if (flonum-int? x) (inexact-modulo) (error))
        (if (cpxnum-int? x) (inexact-modulo) (error)))
      (error))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; gcd, lcm

(define (##gcd x y)

  (define (exact-gcd x y)
    (let loop ((x (##abs x)) (y (##abs y)))
      (if (##eq? y 0) x (loop y (##remainder x y)))))

  (if (and (##integer? x) (##integer? y))
    (if (and (##exact? x) (##exact? y))
      (exact-gcd x y)
      (##exact->inexact (exact-gcd (##inexact->exact x) (##inexact->exact y))))
    (##trap-check-integer 'gcd x y)))

(define (##lcm x y)

  (define (exact-gcd x y)
    (let loop ((x (##abs x)) (y (##abs y)))
      (if (##eq? y 0) x (loop y (##remainder x y)))))

  (define (exact-lcm x y)
    (if (or (##eq? x 0) (##eq? y 0))
      0
      (##quotient (##abs (##* x y)) (exact-gcd x y))))

  (if (and (##integer? x) (##integer? y))
    (if (and (##exact? x) (##exact? y))
      (exact-lcm x y)
      (##exact->inexact (exact-lcm (##inexact->exact x) (##inexact->exact y))))
    (##trap-check-integer 'lcm x y)))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; numerator, denominator

(define (##numerator x)

  (define (error) (##trap-check-rational 'numerator x))

  (number-dispatch x (error)
    x
    x
    (ratnum-numerator x)
    (##numerator (##flonum.inexact->exact x))
    (if (cpxnum-real? x) (##numerator (cpxnum-real x)) (error))))

(define (##denominator x)

  (define (error) (##trap-check-rational 'denominator x))

  (number-dispatch x (error)
    1
    1
    (ratnum-denominator x)
    (##denominator (##flonum.inexact->exact x))
    (if (cpxnum-real? x) (##denominator (cpxnum-real x)) (error))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; floor, ceiling, truncate, round

(define (##floor x)

  (define (error) (##trap-check-real 'floor x))

  (number-dispatch x (error)
    x
    x
    (##ratnum.floor x)
    (##flonum.floor x)
    (if (cpxnum-real? x) (##floor (cpxnum-real x)) (error))))

(define (##ceiling x)

  (define (error) (##trap-check-real 'ceiling x))

  (number-dispatch x (error)
    x
    x
    (##ratnum.ceiling x)
    (##flonum.ceiling x)
    (if (cpxnum-real? x) (##ceiling (cpxnum-real x)) (error))))

(define (##truncate x)

  (define (error) (##trap-check-real 'truncate x))

  (number-dispatch x (error)
    x
    x
    (##ratnum.truncate x)
    (##flonum.truncate x)
    (if (cpxnum-real? x) (##truncate (cpxnum-real x)) (error))))

(define (##round x)

  (define (error) (##trap-check-real 'round x))

  (number-dispatch x (error)
    x
    x
    (##ratnum.round x)
    (##flonum.round x)
    (if (cpxnum-real? x) (##round (cpxnum-real x)) (error))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; rationalize

(define (##rationalize x y)

  (define (simplest-rational1 x y)
    (cond ((##< y x)
           (simplest-rational2 y x))
          ((##not (##< x y))
           x)
          ((##positive? x)
           (simplest-rational2 x y))
          ((##negative? y)
           (##- 0 (simplest-rational2 (##- 0 y) (##- 0 x))))
          (else
           0)))

  (define (simplest-rational2 x y)
    (let ((fx (##floor x))
          (fy (##floor y)))
      (cond ((##not (##< fx x))
             fx)
            ((##= fx fy)
             (##+ fx
                  (##/ 1
                       (simplest-rational2
                         (##/ 1 (##- y fy))
                         (##/ 1 (##- x fx))))))
            (else
             (##+ fx 1)))))

  (if (and (##real? x) (##real? y))
    (simplest-rational1 (##- x y) (##+ x y))
    (##trap-check-real 'rationalize x y)))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; trigonometry and complex numbers

(define (##exp x)
  (number-dispatch x (##trap-check-number 'exp x)
    (if (##eq? x 0) 1 (##flonum.exp (##flonum.<-fixnum x)))
    (##flonum.exp (##flonum.<-bignum x))
    (##flonum.exp (##flonum.<-ratnum x))
    (##flonum.exp x)
    (##make-polar (##exp (cpxnum-real x)) (cpxnum-imag x))))

(define (##log x)

  (define (error) (##trap-check-range 'log x))

  (define (negative-log x)
    (cpxnum-make (##log (##- 0 x)) (inexact-+pi)))

  (number-dispatch x (##trap-check-number 'log x)
    (if (##fixnum.positive? x)
      (if (##eq? x 1) 0 (##flonum.log (##flonum.<-fixnum x)))
      (if (##fixnum.= x 0) (error) (negative-log x)))
    (if (bignum-positive? x)
      (##flonum.log (##flonum.<-bignum x))
      (negative-log x))
    (if (##positive? (ratnum-numerator x))
      (##flonum.log (##flonum.<-ratnum x))
      (negative-log x))
    (if (##flonum.positive? x)
      (##flonum.log x)
      (if (##flonum.zero? x) (error) (negative-log x)))
    (##make-rectangular (##log (##magnitude x)) (##angle x))))

(define (##sin x)
  (number-dispatch x (##trap-check-number 'sin x)
    (if (##eq? x 0) 0 (##flonum.sin (##flonum.<-fixnum x)))
    (##flonum.sin (##flonum.<-bignum x))
    (##flonum.sin (##flonum.<-ratnum x))
    (##flonum.sin x)
    (##/ (##- (##exp (cpxnum-make (##- 0 (cpxnum-imag x)) (cpxnum-real x)))
              (##exp (cpxnum-make (cpxnum-imag x) (##- 0 (cpxnum-real x)))))
         (cpxnum-+2i))))

(define (##cos x)
  (number-dispatch x (##trap-check-number 'cos x)
    (if (##eq? x 0) 1 (##flonum.cos (##flonum.<-fixnum x)))
    (##flonum.cos (##flonum.<-bignum x))
    (##flonum.cos (##flonum.<-ratnum x))
    (##flonum.cos x)
    (##/ (##+ (##exp (cpxnum-make (##- 0 (cpxnum-imag x)) (cpxnum-real x)))
              (##exp (cpxnum-make (cpxnum-imag x) (##- 0 (cpxnum-real x)))))
         2)))

(define (##tan x)
  (number-dispatch x (##trap-check-number 'tan x)
    (if (##eq? x 0) 0 (##flonum.tan (##flonum.<-fixnum x)))
    (##flonum.tan (##flonum.<-bignum x))
    (##flonum.tan (##flonum.<-ratnum x))
    (##flonum.tan x)
    (let ((a (##exp (cpxnum-make (##- 0 (cpxnum-imag x)) (cpxnum-real x))))
          (b (##exp (cpxnum-make (cpxnum-imag x) (##- 0 (cpxnum-real x))))))
      (let ((c (##/ (##- a b) (##+ a b))))
        (##make-rectangular (##imag-part c) (##- 0 (##real-part c)))))))

(define (##asin x)

  (define (safe-case x)
    (##* (cpxnum--i)
         (##log (##+ (##* (cpxnum-+i) x)
                     (##sqrt (##- 1 (##* x x)))))))

  (define (unsafe-case x)
    (##- 0 (safe-case (##- 0 x))))

  (define (real-case x)
    (cond ((##< x -1)
           (unsafe-case x))
          ((##< 1 x)
           (safe-case x))
          (else
           (##flonum.asin (##exact->inexact x)))))

  (number-dispatch x (##trap-check-number 'asin x)
    (if (##eq? x 0) 0 (real-case x))
    (real-case x)
    (real-case x)
    (real-case x)
    (let ((imag (cpxnum-imag x)))
      (if (or (##positive? imag)
              (and (flonum-zero? imag) (##negative? (cpxnum-real x))))
        (unsafe-case x)
        (safe-case x)))))

(define (##acos x)

  (define (complex-case x)
    (##* (cpxnum--i)
         (##log (##+ x
                     (##* (cpxnum-+i) (##sqrt (##- 1 (##* x x))))))))

  (define (real-case x)
    (if (or (##< x -1) (##< 1 x))
      (complex-case x)
      (##flonum.acos (##exact->inexact x))))

  (number-dispatch x (##trap-check-number 'acos x)
    (if (##eq? x 0) 0 (real-case x))
    (real-case x)
    (real-case x)
    (real-case x)
    (complex-case x)))

(define (##atan x)
  (number-dispatch x (##trap-check-number 'atan x)
    (if (##eq? x 0) 0 (##flonum.atan (##flonum.<-fixnum x)))
    (##flonum.atan (##flonum.<-bignum x))
    (##flonum.atan (##flonum.<-ratnum x))
    (##flonum.atan x)
    (let ((a (cpxnum-make (##- 0 (cpxnum-imag x)) (cpxnum-real x))))
      (##/ (##- (##log (##+ a 1)) (##log (##- 1 a)))
           (cpxnum-+2i)))))

(define (##atan2 y x)
  (if (and (##real? x) (##real? y))
    (let ((x (##exact->inexact x)) (y (##exact->inexact y)))
      (cond ((##flonum.positive? x)
             (##flonum.atan (##flonum./ y x)))
            ((##flonum.negative? y)
             (if (##flonum.zero? x)
               (inexact--pi/2)
               (##flonum.+ (##flonum.atan (##flonum./ y x)) (inexact--pi))))
            (else
             (if (##flonum.zero? x)
               (inexact-+pi/2)
               (##flonum.+ (##flonum.atan (##flonum./ y x)) (inexact-+pi))))))
    (##trap-check-real 'atan y x)))

(define (##sqrt x)

  (define (exact-int-sqrt x)
    (cond ((##eq? x 0)
           0)
          ((##negative? x)
           (cpxnum-make 0 (exact-int-sqrt (##- 0 x))))
          (else
           (let ((y (##exact-int.root x 2)))
             (if (##= x (##* y y))
               y
               (##flonum.sqrt (##exact->inexact x)))))))

  (number-dispatch x (##trap-check-number 'sqrt x)
    (exact-int-sqrt x)
    (exact-int-sqrt x)
    (##/ (exact-int-sqrt (ratnum-numerator x))
         (exact-int-sqrt (ratnum-denominator x)))
    (if (##flonum.negative? x)
      (cpxnum-make 0 (##flonum.sqrt (##flonum.- (inexact-0) x)))
      (##flonum.sqrt x))
    (##make-polar (##sqrt (##magnitude x)) (##/ (##angle x) 2))))

(define (##expt x y)

  (define (error) (##trap-check-number 'expt x y))

  (define (general-expt x y)
    (##exp (##* (##log x) y)))

  (define (exact-int-expt x y)
    (cond ((##eq? y 0)
           1)
          ((or (##zero? x) (##= x 1))
           x)
          (else
           (let loop ((x x) (y y) (result 1))
             (if (##eq? y 1)
               (##* x result)
               (loop (##* x x)
                     (##quotient y 2)
                     (if (##odd? y) (##* x result) result)))))))

  (if (##complex? x)
    (cond ((exact-int? y)
           (if (##negative? y)
             (##/ 1 (exact-int-expt x (##- 0 y)))
             (exact-int-expt x y)))
          ((##complex? y)
           (cond ((##zero? y) (inexact-+1))
                 ((##zero? x) (if (##eq? x 0) 0 (inexact-0)))
                 (else        (general-expt x y))))
          (else
           (error)))
    (error)))

(define (##make-rectangular x y)
  (if (and (##real? x) (##real? y))
    (if (##eq? y 0)
      x
      (cpxnum-make (##real-part x) (##real-part y)))
    (##trap-check-real 'make-rectangular x y)))

(define (##make-polar x y)
  (if (and (##real? x) (##real? y))
    (let ((x* (##real-part x)) (y* (##real-part y)))
      (##make-rectangular (##* x* (##cos y*)) (##* x* (##sin y*))))
    (##trap-check-real 'make-polar x y)))

(define (##real-part x)
  (number-dispatch x (##trap-check-number 'real-part x)
    x x x x (cpxnum-real x)))

(define (##imag-part x)
  (number-dispatch x (##trap-check-number 'imag-part x)
    0 0 0 0 (cpxnum-imag x)))

(define (##magnitude x)
  (number-dispatch x (##trap-check-number 'magnitude x)
    (if (##fixnum.negative? x) (##bignum.-/fixnum-fixnum 0 x) x)
    (if (bignum-negative? x) (##bignum.-/fixnum-bignum 0 x) x)
    (if (##negative? (ratnum-numerator x))
      (ratnum-make (##- 0 (ratnum-numerator x)) (ratnum-denominator x))
      x)
    (##flonum.abs x)
    (let ((r (##abs (##real-part x))) (i (##abs (##imag-part x))))
      (define (complex-magn a b)
        (if (##zero? b)
          b
          (let ((c (##/ a b)))
            (##* b (##sqrt (##+ (##* c c) 1))))))
      (if (##< r i) (complex-magn r i) (complex-magn i r)))))

(define (##angle x)
  (number-dispatch x (##trap-check-number 'angle x)
    (if (##fixnum.negative? x) (inexact-+pi) 0)
    (if (bignum-negative? x) (inexact-+pi) 0)
    (if (##negative? (ratnum-numerator x)) (inexact-+pi) 0)
    (if (##flonum.negative? x) (inexact-+pi) (inexact-0))
    (if (##zero? x)
      (inexact-0)
      (##atan2 (cpxnum-imag x) (cpxnum-real x)))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; exact->inexact, inexact->exact

(define (##exact->inexact x)
  (number-dispatch x (##trap-check-number 'exact->inexact x)
    (##flonum.<-fixnum x)
    (##flonum.<-bignum x)
    (##flonum.<-ratnum x)
    x
    (##make-rectangular (##exact->inexact (cpxnum-real x))
                        (##exact->inexact (cpxnum-imag x)))))

(define (##inexact->exact x)
  (number-dispatch x (##trap-check-number 'inexact->exact x)
    x
    x
    x
    (##flonum.inexact->exact x)
    (##make-rectangular (##inexact->exact (cpxnum-real x))
                        (##inexact->exact (cpxnum-imag x)))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; number->string, string->number

(define (##number->string x rad)

  (define (non-cpxnum->string x)
    (cond ((exact-int? x)
           (##exact-int.number->string x rad))
          ((##ratnum? x)
           (##string-append (##exact-int.number->string (ratnum-numerator x) rad)
                            "/"
                            (##exact-int.number->string (ratnum-denominator x) rad)))
          ((##flonum? x)
           (##flonum.number->string x))
          (else
           (##trap-check-number 'number->string x rad))))

  (if (or (##eq? rad 2)
          (##eq? rad 8)
          (##eq? rad 10)
          (##eq? rad 16))
    (if (##cpxnum? x)
      (let* ((real (cpxnum-real x))
             (real-str (if (##eq? real 0) "" (non-cpxnum->string real))))
        (let ((imag (cpxnum-imag x)))
          (cond ((##eq? imag 1)
                 (##string-append real-str "+i"))
                ((##eq? imag -1)
                 (##string-append real-str "-i"))
                ((##negative? imag)
                 (##string-append real-str (non-cpxnum->string imag) "i"))
                (else
                 (##string-append real-str "+" (non-cpxnum->string imag) "i")))))
      (non-cpxnum->string x))
    (##trap-check-range 'number->string x rad)))

(define (##exact-int.number->string x rad)
  (if (##fixnum? x)
    (##fixnum.number->string x rad)
    (##bignum.number->string x rad)))

(define (##flonum.number->string x)

  (define (num->str x)
    (let ((z (##flonum.->exact-exponential-format x)))
      (##flonum.printout (##car z) (##cdr z))))

  (cond ((##flonum.zero? x)
         "0.")
        ((##flonum.negative? x)
         (##string-append "-" (num->str (##flonum.abs x))))
        (else
         (num->str x))))

(##define-macro (two) 2)
(##define-macro (ten) 10)
(##define-macro (ten-minus-1) 9)

(define (##flonum.printout m e)

  (define (done h k d)
    (let ((str (##exact-int.number->string d (ten))))
      (cond ((and (##fixnum.< h -1)
                  (or ; (##fixnum.< -5 h)
                      (##fixnum.< (##fixnum.- 0 (flonum-max-digits)) k)))
             (##string-append "."
                              (##make-string (##fixnum.- -1 h) #\0)
                              str))
            ((and (##fixnum.< 0 k)
                  (or ; (##fixnum.< k 3)
                      (##fixnum.< h (flonum-max-digits))))
             (##string-append str
                              (##make-string k #\0)
                              "."))
            ((and (##fixnum.< -2 h) (##fixnum.< k 1))
             (let ((n (##fixnum.+ h 1)))
               (##string-append (##substring str 0 n)
                                "."
                                (##substring str n (##string-length str)))))
            (else
             (##string-append (##substring str 0 1)
                              "."
                              (##substring str 1 (##string-length str))
                              "e"
                              (##exact-int.number->string h (ten)))))))

  (define (fixup-loop1 k r s ceiling-s-div-ten m- m+)
    (if (##< r ceiling-s-div-ten)
      (fixup-loop1 (##fixnum.- k 1)
                   (##* r (ten))
                   s
                   ceiling-s-div-ten
                   (##* m- (ten))
                   (##* m+ (ten)))
      (let fixup-loop2 ((k k) (r r) (s s) (m- m-) (m+ m+))
        (if (##not (##< (##+ (##* r 2) m+) (##* s 2)))
          (fixup-loop2 (##fixnum.+ k 1) r (##* s (ten)) m- m+)
          (let ((h (##fixnum.- k 1)))
            (let ((ur (##exact-int.div (##* r (ten)) s)))
              (let loop ((k (##fixnum.- k 1))
                         (u (##car ur))
                         (r (##cdr ur))
                         (m- (##* m- (ten)))
                         (m+ (##* m+ (ten)))
                         (d 0))
                (let ((r*2 (##* r 2)) (s*2 (##* s 2)))
                  (cond ((##< r*2 m-)
                         (if (##< (##- s*2 m+) r*2)
                           (if (##not (##< s r*2))
                             (done h k (##+ d u))
                             (done h k (##+ d (##fixnum.+ u 1))))
                           (done h k (##+ d u))))
                        ((##< (##- s*2 m+) r*2)
                         (done h k (##+ d (##fixnum.+ u 1))))
                        (else
                         (let ((ur (##exact-int.div (##* r (ten)) s)))
                           (loop (##fixnum.- k 1)
                                 (##car ur)
                                 (##cdr ur)
                                 (##* m- (ten))
                                 (##* m+ (ten))
                                 (##* (##+ d u) (ten))))))))))))))

  (define (fixup r s m-)
    (if (##= m (flonum-+m-min))
      (let ((r* (##* r (two)))
            (s* (##* s (two)))
            (m+ (##* m- (two))))
        (fixup-loop1 0 r* s* (##quotient (##+ s* (ten-minus-1)) (ten)) m- m+))
      (fixup-loop1 0 r s (##quotient (##+ s (ten-minus-1)) (ten)) m- m-)))

  (if (##fixnum.negative? e)
    (fixup m (##expt (two) (##fixnum.- 0 e)) 1)
    (let ((two-to-the-e (##expt (two) e)))
      (fixup (##* m two-to-the-e) 1 two-to-the-e))))

(define (##string->number s rad)

  (define (make-real e n r p)       ; Note: this algorithm does not satisfy the
    (let ((x (##* n (##expt r p)))) ; accuracy required by the IEEE standard
      (if (##eq? e 'E) x (##exact->inexact x))))

  (define (make-rec a b)
    (##make-rectangular a b))

  (define (make-pol a b)
    (##make-polar a b))

  (define (ex e x)
    (if (##eq? e 'I) (##exact->inexact x) x))

  (define (end s i x)
    (if (##eq? i (##string-length s)) x #f))

  (define (radix-prefix s i)
    (if (##fixnum.< (##fixnum.+ i 1) (##string-length s))
      (if (##char=? (##string-ref s i) #\#)
        (let ((c (##string-ref s (##fixnum.+ i 1))))
          (cond ((or (##char=? c #\b) (##char=? c #\B))  2)
                ((or (##char=? c #\o) (##char=? c #\O))  8)
                ((or (##char=? c #\d) (##char=? c #\D)) 10)
                ((or (##char=? c #\x) (##char=? c #\X)) 16)
                (else                                   #f)))
        #f)
      #f))

  (define (exactness-prefix s i)
    (if (##fixnum.< (##fixnum.+ i 1) (##string-length s))
      (if (##char=? (##string-ref s i) #\#)
        (let ((c (##string-ref s (##fixnum.+ i 1))))
          (cond ((or (##char=? c #\i) (##char=? c #\I)) 'I)
                ((or (##char=? c #\e) (##char=? c #\E)) 'E)
                (else                                   #f)))
        #f)
      #f))

  (define (sign s i)
    (if (##fixnum.< i (##string-length s))
      (let ((c (##string-ref s i)))
        (cond ((##char=? c #\+) '+)
              ((##char=? c #\-) '-)
              (else             #f)))
      #f))

  (define (imaginary s i)
    (if (##fixnum.< i (##string-length s))
      (let ((c (##string-ref s i)))
        (or (##char=? c #\i) (##char=? c #\I)))
      #f))

  (define (polar s i)
    (if (##fixnum.< i (##string-length s))
      (##char=? (##string-ref s i) #\@)
      #f))

  (define (ratio s i)
    (if (##fixnum.< i (##string-length s))
      (##char=? (##string-ref s i) #\/)
      #f))

  (define (exponent s i)
    (if (##fixnum.< i (##string-length s))
      (let ((c (##string-ref s i)))
        (cond ((or (##char=? c #\e) (##char=? c #\E)) 'E)
              ((or (##char=? c #\s) (##char=? c #\S)) 'S)
              ((or (##char=? c #\f) (##char=? c #\F)) 'F)
              ((or (##char=? c #\d) (##char=? c #\D)) 'D)
              ((or (##char=? c #\l) (##char=? c #\L)) 'L)
              (else                                   #f)))
      #f))

  (define (digit c r)
    (let ((d (cond ((##not (or (##char<? c #\0) (##char<? #\9 c)))
                    (##fixnum.- (##char->integer c) 48))
                   ((##not (or (##char<? c #\a) (##char<? #\z c)))
                    (##fixnum.- (##char->integer c) 87))
                   ((##not (or (##char<? c #\A) (##char<? #\Z c)))
                    (##fixnum.- (##char->integer c) 55))
                   (else
                    #f))))
      (if (and d (##fixnum.< d r)) d #f)))

  (define (prefix s i r cont)
    (let ((e1 (exactness-prefix s i)))
      (if e1
        (let ((r1 (radix-prefix s (##fixnum.+ i 2))))
          (if r1
            (cont s (##fixnum.+ i 4) r1 e1)
            (cont s (##fixnum.+ i 2) r e1)))
        (let ((r2 (radix-prefix s i)))
          (if r2
            (let ((e2 (exactness-prefix s (##fixnum.+ i 2))))
              (if e2
                (cont s (##fixnum.+ i 4) r2 e2)
                (cont s (##fixnum.+ i 2) r2 #f)))
            (cont s i r #f))))))

  (define (num s i r)
    (prefix s i r complex))

  (define (complex s i r e)
    (let ((+/- (sign s i)))
      (ucomplex s (if +/- (##fixnum.+ i 1) i) r e +/-)))

  (define (ucomplex s i r e +/-)
    (if (and +/- (imaginary s i))
      (end s (##fixnum.+ i 1)
        (make-rec (ex e 0) (ex e (if (##eq? +/- '-) -1 1))))
      (ureal s i r e +/- #f
        (lambda (s i r e +/- dummy x)
          (let ((y (if (##eq? +/- '-) (##- 0 x) x)))
            (cond ((and +/- (imaginary s i))
                   (end s (##fixnum.+ i 1) (make-rec (ex e 0) y)))
                  ((polar s i)
                   (let ((+/-2 (sign s (##fixnum.+ i 1))))
                     (ureal s (##fixnum.+ i (if +/-2 2 1)) r e +/-2 y
                       (lambda (s i r e +/-2 y z)
                         (end s i
                           (make-pol y (if (##eq? +/-2 '-) (##- 0 z) z)))))))
                  (else
                   (let ((+/-2 (sign s i)))
                     (if +/-2
                       (if (imaginary s (##fixnum.+ i 1))
                         (end s (##fixnum.+ i 2)
                           (make-rec y (ex e (if (##eq? +/-2 '-) -1 1))))
                         (ureal s (##fixnum.+ i 1) r e +/-2 y
                           (lambda (s i r e +/-2 y z)
                             (and (imaginary s i)
                                  (end s (##fixnum.+ i 1)
                                    (make-rec y (if (##eq? +/-2 '-) (##- 0 z) z)))))))
                       (end s i y))))))))))

  (define (ureal s i r e +/- x cont)
    (uinteger s i r e +/- x cont (##eq? r 10)
      (lambda (s i r e +/- x cont ex? n p)
        (if p ; decimal point or exponent?
          (cont s i r e +/- x (make-real e n r p))
          (if (ratio s i)
            (uinteger s (##fixnum.+ i 1) r e +/- x cont #f
              (lambda (s i r e +/- x cont ex2? n2 p2)
                (let ((y (##/ n n2)))
                  (cont s i r e +/- x (ex (or e (if (and ex? ex2?) #f 'I)) y)))))
            (cont s i r e +/- x (ex (or e (if ex? #f 'I)) n)))))))

  (define (uinteger s i r a1 a2 a3 a4 decimal? cont)
    (let loop1 ((i i) (state 0) (n 0) (p #f))

      (define (suffix)
        (if (##eq? state 0)
          #f
          (let ((mark (exponent s i)))
            (if (and mark decimal?)
              (let ((+/- (sign s (##fixnum.+ i 1))) (p (or p 0)))
                (let loop2 ((i (##fixnum.+ i (if +/- 2 1))) (j #f))
                  (if (and (##fixnum.< i (##string-length s))
                           (digit (##string-ref s i) 10))
                    (loop2 (##fixnum.+ i 1)
                           (##+ (##* (or j 0) 10)
                                (digit (##string-ref s i) 10)))
                    (and j (cont s i r a1 a2 a3 a4 #f n
                             (##+ p (if (##eq? +/- '-) (##- 0 j) j)))))))
              (cont s i r a1 a2 a3 a4 (##not (or (##eq? state 2) p)) n p)))))

      (if (##fixnum.< i (##string-length s))
        (let ((c (##string-ref s i)))
          (if (and (##char=? c #\.) decimal? (##not p))
            (loop1 (##fixnum.+ i 1) state n 0)
            (if (and (##char=? c #\#) (##fixnum.< 0 state))
              (loop1 (##fixnum.+ i 1) 2 (##* n r) (and p (##fixnum.- p 1)))
              (if (##fixnum.< state 2)
                (let ((d (digit c r)))
                  (if d
                    (loop1 (##fixnum.+ i 1)
                           1
                           (##+ (##* n r) d)
                           (and p (##fixnum.- p 1)))
                    (suffix)))
                (suffix)))))
        (suffix))))

  (if (or (##eq? rad 2)
          (##eq? rad 8)
          (##eq? rad 10)
          (##eq? rad 16))

    (num s 0 rad)

    (##trap-check-range 'string->number s rad)))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; ##logior, ##logxor, ##logand, ##lognot, ##ash

(define-nary0 (##fixnum.logior x y)  0 x (##fixnum.logior x y) no-touch)
(define-nary0 (##fixnum.logxor x y)  0 x (##fixnum.logxor x y) no-touch)
(define-nary0 (##fixnum.logand x y) -1 x (##fixnum.logand x y) no-touch)
(define-system (##fixnum.lognot x) (##fixnum.- -1 x))
(define-system (##fixnum.ash x y))

(define-nary0 (##logior x y)  0 x (####logior x y) touch-vars)
(define-nary0 (##logxor x y)  0 x (####logxor x y) touch-vars)
(define-nary0 (##logand x y) -1 x (####logand x y) touch-vars)
(define (##lognot x) (touch-vars (x) (####lognot x)))
(define (##ash x y) (touch-vars (x y) (####ash x y)))

(define (####logior x y)

  (define (otherwise x y)
    (##trap-check-integer '##logior x y))

  (cond ((##fixnum? y)
         (cond ((##fixnum? x)
                (##fixnum.logior x y))
               ((##bignum? x)
                (##bignum.logior/bignum-fixnum x y))
               (else
                (otherwise x y))))
        ((##bignum? y)
         (cond ((##fixnum? x)
                (##bignum.logior/bignum-fixnum y x))
               ((##bignum? x)
                (##bignum.logior x y))
               (else
                (otherwise x y))))
        (else
         (otherwise x y))))

(define (####logxor x y)

  (define (otherwise x y)
    (##trap-check-integer '##logxor x y))

  (cond ((##fixnum? y)
         (cond ((##fixnum? x)
                (##fixnum.logxor x y))
               ((##bignum? x)
                (##bignum.logxor/bignum-fixnum x y))
               (else
                (otherwise x y))))
        ((##bignum? y)
         (cond ((##fixnum? x)
                (##bignum.logxor/bignum-fixnum y x))
               ((##bignum? x)
                (##bignum.logxor x y))
               (else
                (otherwise x y))))
        (else
         (otherwise x y))))

(define (####logand x y)

  (define (otherwise x y)
    (##trap-check-integer '##logand x y))

  (cond ((##fixnum? y)
         (cond ((##fixnum? x)
                (##fixnum.logand x y))
               ((##bignum? x)
                (##bignum.logand/bignum-fixnum x y))
               (else
                (otherwise x y))))
        ((##bignum? y)
         (cond ((##fixnum? x)
                (##bignum.logand/bignum-fixnum y x))
               ((##bignum? x)
                (##bignum.logand x y))
               (else
                (otherwise x y))))
        (else
         (otherwise x y))))

(define (####lognot x)

  (define (otherwise x)
    (##trap-check-integer '##lognot x))

  (cond ((##fixnum? x)
         (##fixnum.lognot x))
        ((##bignum? x)
         (##bignum.-/fixnum-bignum -1 x))
        (else
         (otherwise x))))

(define (####ash x y)

  (define (otherwise x y)
    (##trap-check-integer '##ash x y))

  (cond ((##fixnum? y)
         (cond ((##fixnum? x)
                (##bignum.ash/fixnum-fixnum x y))
               ((##bignum? x)
                (##bignum.ash/bignum-fixnum x y))
               (else
                (otherwise x y))))
        ((##bignum? y)
         (cond ((##fixnum? x)
                (##bignum.ash/fixnum-bignum x y))
               ((##bignum? x)
                (##bignum.ash x y))
               (else
                (otherwise x y))))
        (else
         (otherwise x y))))

(define (##bignum.logior/bignum-fixnum x y)
  (##bignum.logior x (##bignum.<-fixnum y)))

(define (##bignum.logxor/bignum-fixnum x y)
  (##bignum.logxor x (##bignum.<-fixnum y)))

(define (##bignum.logand/bignum-fixnum x y)
  (##bignum.logand x (##bignum.<-fixnum y)))

(define (##bignum.ash/fixnum-fixnum x y)
  (##bignum.ash (##bignum.<-fixnum x) (##bignum.<-fixnum y)))

(define (##bignum.ash/bignum-fixnum x y)
  (##bignum.ash x (##bignum.<-fixnum y)))

(define (##bignum.ash/fixnum-bignum x y)
  (##bignum.ash (##bignum.<-fixnum x) y))

(define (##bignum.logior x y)
  (##trap-unimplemented '##logior x y))

(define (##bignum.logxor x y)
  (##trap-unimplemented '##logxor x y))

(define (##bignum.logand x y)
  (##trap-unimplemented '##logand x y))

(define (##bignum.ash x y)
  (##trap-unimplemented '##ash x y))

; other utilities

(define (##exact-int.width x)
  (if (##fixnum? x)
    (##fixnum.width x)
    (##bignum.width x)))

(define (##fixnum.width x)
  (if (##fixnum.negative? x)
    (let loop1 ((w 0) (x x))
      (if (##fixnum.< x -1) (loop1 (##fixnum.+ w 1) (##fixnum.ash x -1)) w))
    (let loop2 ((w 0) (x x))
      (if (##fixnum.< 0 x) (loop2 (##fixnum.+ w 1) (##fixnum.ash x -1)) w))))

(define (##bignum.width x)
  (if (bignum-negative? x)
    (##bignum.width (##- -1 x)) ; lazy...
    (let ((len (bignum-length x)))
      (##fixnum.+ (##fixnum.* (##fixnum.- len 2) (radix-width))
                  (##fixnum.width (bignum-digit-ref x (##fixnum.- len 1)))))))

(define (##exact-int.root x y)
  (let loop ((g (##expt 2
                        (##quotient (##+ (##exact-int.width x) (##- y 1)) y))))
    (let ((a (##expt g (##- y 1))))
      (let ((b (##* a y)))
        (let ((c (##* a (##- y 1))))
          (let ((d (##quotient (##+ x (##* g c)) b)))
            (if (##< d g) (loop d) g)))))))

(define (##exact-int.div x y)

  (define (div x y)
    (let ((z (##bignum.div x y)))
      (##set-car! z (##bignum.normalize (##car z)))
      (##set-cdr! z (##bignum.normalize (##cdr z)))
      z))

  (if (##fixnum? x)
    (if (##fixnum? y)
      (##cons (##fixnum.quotient x y) (##fixnum.remainder x y))
      (div (##bignum.<-fixnum x) y))
    (if (##fixnum? y)
      (div x (##bignum.<-fixnum y))
      (div x y))))

;------------------------------------------------------------------------------

; Fixnum operations
; -----------------

(define-system (##fixnum.zero? x)
  (##eq? x 0))

(define-system (##fixnum.positive? x)
  (##fixnum.< 0 x))

(define-system (##fixnum.negative? x)
  (##fixnum.< x 0))

(define-system (##fixnum.odd? x)
  (##eq? (##fixnum.modulo x 2) 1))

(define-system (##fixnum.even? x)
  (##eq? (##fixnum.modulo x 2) 0))

(define-nary0-boolean (##fixnum.= x y)
  (##eq? x y) no-check no-touch)

(define-nary0-boolean (##fixnum.< x y)
  (##fixnum.< x y) no-check no-touch)

(define-nary0-boolean (##fixnum.> x y)
  (##fixnum.< y x) no-check no-touch)

(define-nary0-boolean (##fixnum.<= x y)
  (##not (##fixnum.< y x)) no-check no-touch)

(define-nary0-boolean (##fixnum.>= x y)
  (##not (##fixnum.< x y)) no-check no-touch)

(define-nary0 (##fixnum.+ x y) 0 x (##fixnum.+ x y) no-touch)
(define-nary0 (##fixnum.* x y) 1 x (##fixnum.* x y) no-touch)
(define-nary1 (##fixnum.- x y) (##fixnum.- 0 x) (##fixnum.- x y) no-touch)

(define-system (##fixnum.quotient x y))

(define-system (##fixnum.remainder x y)
  (##fixnum.- x (##fixnum.* (##fixnum.quotient x y) y)))

(define-system (##fixnum.modulo x y)
  (let ((r (##fixnum.remainder x y)))
    (if (##eq? r 0)
      0
      (if (##fixnum.< x 0)
        (if (##fixnum.< y 0) r (##fixnum.+ r y))
        (if (##fixnum.< y 0) (##fixnum.+ r y) r)))))

(define (##fixnum.number->string n rad)

  (define (loop k n i)
    (let ((x (##fixnum.quotient n rad)))
      (let ((s (if (##eq? x 0)
                 (##make-string (##fixnum.+ i k) #\space)
                 (loop k x (##fixnum.+ i 1)))))
        (##string-set! s
                       (##fixnum.- (##string-length s) i)
                       (##string-ref "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                                     (##fixnum.- 0 (##fixnum.remainder n rad)))))))

  (if (##fixnum.< n 0)
    (##string-set! (loop 1 n 1) 0 #\-)
    (loop 0 (##fixnum.- 0 n) 1)))

;------------------------------------------------------------------------------

; Bignum operations
; -----------------

; Bignums are represented with 'word' vectors:
;
; assuming that the bignum 'n' is represented by the word vector 'v' of
; length 'l', we have
;
;                       l-2
;                      -----
;                      \                   i
; n  =  (v[0]*2-1)  *   >   v[i+1] * radix
;                      /
;                      -----
;                      i = 0
;
; note: v[0] = 0 if number is negative, v[0] = 1 if number is positive.
;
; 'radix' must be less than or equal to sqrt(max fixnum)+1.  This guarantees
; that the result of an arithmetic operation on bignum digits will be a fixnum
; (this includes the product of two digits).

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Bignum comparison

(define (##bignum.= x y)
  (if (##not (##eq? (bignum-sign x) (bignum-sign y)))
    #f
    (let ((lx (bignum-length x)))
      (if (##not (##eq? lx (bignum-length y)))
        #f
        (let loop ((i (##fixnum.- lx 1)))
          (if (##fixnum.< 0 i)
            (if (##not (##eq? (bignum-digit-ref x i)
                              (bignum-digit-ref y i)))
              #f
              (loop (##fixnum.- i 1)))
            #t))))))

(define (##bignum.< x y)
  (if (##not (##eq? (bignum-sign x) (bignum-sign y)))
    (bignum-negative? x)
    (let ((lx (bignum-length x))
          (ly (bignum-length y)))
      (cond ((##fixnum.< lx ly)
             (bignum-positive? x))
            ((##fixnum.< ly lx)
             (bignum-negative? x))
            (else
             (let loop ((i (##fixnum.- lx 1)))
               (if (##fixnum.< 0 i)
                 (let ((dx (bignum-digit-ref x i))
                       (dy (bignum-digit-ref y i)))
                   (cond ((##fixnum.< dx dy) (bignum-positive? x))
                         ((##fixnum.< dy dx) (bignum-negative? x))
                         (else               (loop (##fixnum.- i 1)))))
                 #f)))))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Operations on fixnums that might result in a bignum

(define (##bignum.+/fixnum-fixnum x y)
  (if (##fixnum.< x 0)
    (if (##fixnum.< y 0)
      (let ((r (##fixnum.+ x y)))
        (if (##fixnum.< r 0)
          r
          (##bignum.+/bignum-fixnum ##bignum.2*min-fixnum r)))
      (##fixnum.+ x y))
    (if (##fixnum.< y 0)
      (##fixnum.+ x y)
      (let ((r (##fixnum.+ x y)))
        (if (##fixnum.< r 0)
          (##bignum.-/fixnum-bignum r ##bignum.2*min-fixnum)
          r)))))

(define (##bignum.-/fixnum-fixnum x y)
  (if (##fixnum.< x 0)
    (if (##fixnum.< y 0)
      (##fixnum.- x y)
      (let ((r (##fixnum.- x y)))
        (if (##fixnum.< r 0)
          r
          (##bignum.+/bignum-fixnum ##bignum.2*min-fixnum r))))
    (if (##fixnum.< y 0)
      (let ((r (##fixnum.- x y)))
        (if (##fixnum.< r 0)
          (##bignum.-/fixnum-bignum r ##bignum.2*min-fixnum)
          r))
      (##fixnum.- x y))))

(define (##bignum.*/fixnum-fixnum x y)
  (cond ((and (##not (##fixnum.< x (minus-radix))) (##fixnum.< x (radix))
              (##fixnum.< (minus-radix) y) (##not (##fixnum.< (radix) y)))
         (##fixnum.* x y))
        ((or (##fixnum.= x 0) (##fixnum.= y 0))
         0)
        ((##fixnum.= x 1)
         y)
        ((##fixnum.= y 1)
         x)
        (else
         (##bignum.* (##bignum.<-fixnum x) (##bignum.<-fixnum y)))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Mixed representation operations

(define (##bignum.+/bignum-fixnum x y)
  (##bignum.+ x (##bignum.<-fixnum y)))

(define (##bignum.-/bignum-fixnum x y)
  (##bignum.- x (##bignum.<-fixnum y)))

(define (##bignum.-/fixnum-bignum x y)
  (##bignum.- (##bignum.<-fixnum x) y))

(define (##bignum.*/bignum-fixnum x y)
  (cond ((##fixnum.= y 0)
         0)
        ((##fixnum.= y 1)
         x)
        (else
         (##bignum.* x (##bignum.<-fixnum y)))))

(define (##bignum.quotient/bignum-fixnum x y)
  (##bignum.quotient x (##bignum.<-fixnum y)))

(define (##bignum.quotient/fixnum-bignum x y)
  (##bignum.quotient (##bignum.<-fixnum x) y))

(define (##bignum.remainder/bignum-fixnum x y)
  (##bignum.remainder x (##bignum.<-fixnum y)))

(define (##bignum.remainder/fixnum-bignum x y)
  (##bignum.remainder (##bignum.<-fixnum x) y))

(define (##bignum.modulo/bignum-fixnum x y)
  (##bignum.modulo x (##bignum.<-fixnum y)))

(define (##bignum.modulo/fixnum-bignum x y)
  (##bignum.modulo (##bignum.<-fixnum x) y))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Operations where arguments are in bignum format

; Addition and substraction

(define (##bignum.+ x y)
  (##bignum.normalize (##bignum.sum x y (bignum-sign x) (bignum-sign y))))

(define (##bignum.- x y)
  (##bignum.normalize (##bignum.sum x y (bignum-sign x) (bignum-sign* y))))

(define (##bignum.sum x y sign-x sign-y)

  (define (adjust-sign! x s)
    (if (##eq? (bignum-sign x) s)
      (bignum-set-positive! x)
      (bignum-set-negative! x))
    x)

  (cond ((##eq? sign-x sign-y) ; same sign
         (adjust-sign! (##bignum.add x y) sign-x))
        ((##fixnum.< (bignum-length x) (bignum-length y))
         (adjust-sign! (##bignum.sub y x) sign-y))
        (else
         (adjust-sign! (##bignum.sub x y) sign-x))))

(define (##bignum.add x y)

  (define (add x y lx ly)
    (let ((r (bignum-make (##fixnum.+ lx 1))))

      (bignum-set-positive! r)

      (let loop1 ((i 1) (c 0)) ; add digits in y
        (if (##fixnum.< i ly)

          (let ((w (##fixnum.+ (##fixnum.+ (bignum-digit-ref x i)
                                           (bignum-digit-ref y i))
                               c)))
            (if (##fixnum.< w (radix))
              (begin
                (bignum-digit-set! r i w)
                (loop1 (##fixnum.+ i 1) 0))
              (begin
                (bignum-digit-set! r i (##fixnum.- w (radix)))
                (loop1 (##fixnum.+ i 1) 1))))

          (let loop2 ((i i) (c c)) ; propagate carry
            (if (##fixnum.< i lx)

              (let ((w (##fixnum.+ (bignum-digit-ref x i) c)))
                (if (##fixnum.< w (radix))
                  (begin
                    (bignum-digit-set! r i w)
                    (loop2 (##fixnum.+ i 1) 0))
                  (begin
                    (bignum-digit-set! r i (##fixnum.- w (radix)))
                    (loop2 (##fixnum.+ i 1) 1))))

              (if (##eq? c 0)
                (bignum-shrink! r lx)
                (bignum-digit-set! r lx c))))))

      r))

  (let ((lx (bignum-length x))
        (ly (bignum-length y)))
    (if (##fixnum.< lx ly)
      (add y x ly lx)
      (add x y lx ly))))

(define (##bignum.sub x y)

  (define (complement! r)
    (let ((lr (bignum-length r)))
      (let loop ((i 1) (c 0))
        (if (##fixnum.< i lr)

          (let ((w (##fixnum.+ (bignum-digit-ref r i) c)))
            (if (##fixnum.< 0 w)
              (begin
                (bignum-digit-set! r i (##fixnum.- (radix) w))
                (loop (##fixnum.+ i 1) 1))
              (begin
                (bignum-digit-set! r i 0)
                (loop (##fixnum.+ i 1) 0))))))))

  (define (sub x y lx ly)
    (let ((r (bignum-make lx)))

      (let loop1 ((i 1) (b 0)) ; substract digits in y
        (if (##fixnum.< i ly)

          (let ((w (##fixnum.- (##fixnum.- (bignum-digit-ref x i)
                                           (bignum-digit-ref y i))
                               b)))
            (if (##fixnum.< w 0)
              (begin
                (bignum-digit-set! r i (##fixnum.+ w (radix)))
                (loop1 (##fixnum.+ i 1) 1))
              (begin
                (bignum-digit-set! r i w)
                (loop1 (##fixnum.+ i 1) 0))))

          (let loop2 ((i i) (b b)) ; propagate borrow
            (if (##fixnum.< i lx)

              (let ((w (##fixnum.- (bignum-digit-ref x i) b)))
                (if (##fixnum.< w 0)
                  (begin
                    (bignum-digit-set! r i (##fixnum.+ w (radix)))
                    (loop2 (##fixnum.+ i 1) 1))
                  (begin
                    (bignum-digit-set! r i w)
                    (loop2 (##fixnum.+ i 1) 0))))

              (if (##eq? b 0)
                (bignum-set-positive! r)
                (begin
                  (bignum-set-negative! r)
                  (complement! r)))))))

      (##bignum.remove-leading-0s! r)

      r))
    
  (sub x y (bignum-length x) (bignum-length y)))

; Multiplication

(define (##bignum.* x y)

  (define (mul x y lx ly)
    (let ((r (bignum-make (##fixnum.- (##fixnum.+ lx ly) 1))))

      (if (##eq? (bignum-sign x) (bignum-sign y))
        (bignum-set-positive! r)
        (bignum-set-negative! r))

      (let loop1 ((j 1)) ; for each digit in y
        (if (##fixnum.< j ly)

          (let ((d (bignum-digit-ref y j)))
            (let loop2 ((i 1) (k j) (c 0)) ; multiply and add
              (if (##fixnum.< i lx)

                (let ((w (##fixnum.+ (##fixnum.+ (bignum-digit-ref r k) c)
                                     (##fixnum.* (bignum-digit-ref x i) d))))
                  (bignum-digit-set! r k (##fixnum.modulo w (radix)))
                  (loop2 (##fixnum.+ i 1)
                         (##fixnum.+ k 1)
                         (##fixnum.quotient w (radix))))

                (begin
                  (bignum-digit-set! r k c)
                  (loop1 (##fixnum.+ j 1))))))))

      (##bignum.remove-leading-0s! r)

      r))

  (##bignum.normalize (mul x y (bignum-length x) (bignum-length y))))

; Division

(define (##bignum.quotient x y)
  (##bignum.normalize (##car (##bignum.div x y))))

(define (##bignum.remainder x y)
  (##bignum.normalize (##cdr (##bignum.div x y))))

(define (##bignum.modulo x y)
  (let ((r (##cdr (##bignum.div x y))))
    (if (bignum-zero? r)
      0
      (if (bignum-negative? x)
        (if (bignum-negative? y) (##bignum.normalize r) (##bignum.+ r y))
        (if (bignum-negative? y) (##bignum.+ r y) (##bignum.normalize r))))))

(define (##bignum.div x y)

  (define (single-digit-divisor-div x y lx ly r)

    ; simple algo for single digit divisor

    (let ((d (bignum-digit-ref y 1)))
      (let loop1 ((i (##fixnum.- lx 1)) (k 0))
        (if (##fixnum.< 0 i)
          (let ((w (##fixnum.+ (##fixnum.* k (radix)) (bignum-digit-ref x i))))
            (bignum-digit-set! r i (##fixnum.quotient w d))
            (loop1 (##fixnum.- i 1) (##fixnum.remainder w d)))
          (begin
            (##bignum.remove-leading-0s! r)
            (##cons r (##bignum.<-fixnum
                        (if (bignum-negative? x) (##fixnum.- 0 k) k))))))))

  (define (multi-digit-divisor-div x y lx ly r)

    ; general algo from knuth

    ; STEP 1: normalize x and y

    (let loop2 ((shift 1)
                (n (##fixnum.* (bignum-digit-ref y (##fixnum.- ly 1)) 2)))
      (if (##fixnum.< n (radix))
        (loop2 (##fixnum.* shift 2) (##fixnum.* n 2))

        (let ((nx (bignum-make (##fixnum.+ lx 1)))
              (ny (bignum-make ly)))

          (bignum-sign-set! nx (bignum-sign x))

          (let loop3 ((i 1) (c 0))
            (if (##fixnum.< i lx)
              (let ((w (##fixnum.+ (##fixnum.* (bignum-digit-ref x i) shift) c)))
                (bignum-digit-set! nx i (##fixnum.modulo w (radix)))
                (loop3 (##fixnum.+ i 1) (##fixnum.quotient w (radix))))
              (bignum-digit-set! nx i c)))

          (let loop4 ((i 1) (c 0))
            (if (##fixnum.< i ly)
              (let ((w (##fixnum.+ (##fixnum.* (bignum-digit-ref y i) shift) c)))
                (bignum-digit-set! ny i (##fixnum.modulo w (radix)))
                (loop4 (##fixnum.+ i 1) (##fixnum.quotient w (radix))))))

          (let loop5 ((i lx))
            (if (##not (##fixnum.< i ly))

              ; STEP 2: calculate next digit in quotient

              (let ((msd-of-ny
                     (bignum-digit-ref ny (##fixnum.- ly 1)))
                    (next-msd-of-ny
                     (bignum-digit-ref ny (##fixnum.- ly 2)))
                    (msd-of-nx
                     (bignum-digit-ref nx i))
                    (next-msd-of-nx
                     (bignum-digit-ref nx (##fixnum.- i 1)))
                    (next-next-msd-of-nx
                     (bignum-digit-ref nx (##fixnum.- i 2))))

                (define (next-digit q u)
                  (if (##fixnum.< u (radix))
                    (let* ((temp1 (##fixnum.* q next-msd-of-ny))
                           (temp2 (##fixnum.quotient temp1 (radix))))
                      (if (or (##fixnum.< u temp2)
                              (and (##eq? temp2 u)
                                   (##fixnum.<
                                     next-next-msd-of-nx
                                     (##fixnum.remainder temp1 (radix)))))
                        (next-digit (##fixnum.- q 1) (##fixnum.+ u msd-of-ny))
                        q))
                    q))

                (let ((q (if (##eq? msd-of-nx msd-of-ny)
                           (next-digit
                             (radix-minus-1)
                             (##fixnum.+ msd-of-ny next-msd-of-nx))
                           (let ((temp (##fixnum.+
                                         (##fixnum.* msd-of-nx (radix))
                                         next-msd-of-nx)))
                             (next-digit
                               (##fixnum.quotient temp msd-of-ny)
                               (##fixnum.modulo temp msd-of-ny))))))

                  ; STEP 3: multiply and substract

                  (let loop7 ((j 1)
                              (k (##fixnum.- i (##fixnum.- ly 1)))
                              (b 0))
                    (if (##fixnum.< j ly)

                      (let ((w (##fixnum.-
                                 (##fixnum.+ (bignum-digit-ref nx k) b)
                                 (##fixnum.* (bignum-digit-ref ny j) q))))
                        (bignum-digit-set! nx k (##fixnum.modulo w (radix)))
                        (loop7 (##fixnum.+ j 1)
                               (##fixnum.+ k 1)
                               (##fixnum.quotient (##fixnum.- w (radix-minus-1))
                                                  (radix))))

                      (let ((w (##fixnum.+ (bignum-digit-ref nx k) b)))
                        (bignum-digit-set! nx k (##fixnum.modulo w (radix)))
                        (if (##fixnum.< w 0)
                          (begin
                            (bignum-digit-set!
                              r
                              (##fixnum.- i (##fixnum.- ly 1))
                              (##fixnum.- q 1))
                            (let loop8 ((j 1)
                                        (k (##fixnum.- i (##fixnum.- ly 1)))
                                        (c 0))
                              (if (##fixnum.< j ly)

                                (let ((w (##fixnum.+
                                           (##fixnum.+
                                             (bignum-digit-ref nx k)
                                             (bignum-digit-ref ny j))
                                           c)))
                                  (bignum-digit-set!
                                    nx
                                    k
                                    (##fixnum.modulo w (radix)))
                                  (loop8 (##fixnum.+ j 1)
                                         (##fixnum.+ k 1)
                                         (##fixnum.quotient w (radix))))
                                (bignum-digit-set!
                                  nx
                                  k
                                  (##fixnum.modulo
                                    (##fixnum.+ (bignum-digit-ref nx k) c)
                                    (radix))))))
                            (bignum-digit-set!
                              r
                              (##fixnum.- i (##fixnum.- ly 1))
                              q))
                        (loop5 (##fixnum.- i 1)))))))))

          (let loop9 ((i (##fixnum.- ly 1)) (k 0))
            (if (##fixnum.< 0 i)
              (let ((w (##fixnum.+ (##fixnum.* k (radix))
                                   (bignum-digit-ref nx i))))
                (bignum-digit-set! nx i (##fixnum.quotient w shift))
                (loop9 (##fixnum.- i 1)
                       (##fixnum.remainder w shift)))))

          (##bignum.remove-leading-0s! nx)
          (##bignum.remove-leading-0s! r)
          (##cons r nx)))))

  (define (div x y lx ly)
    (if (##fixnum.< lx ly)

      (##cons ##bignum.0 x)

      (let ((r (bignum-make (##fixnum.+ (##fixnum.- lx ly) 2))))

        (if (##eq? (bignum-sign x) (bignum-sign y))
          (bignum-set-positive! r)
          (bignum-set-negative! r))

        (if (##eq? ly 2)
          (single-digit-divisor-div x y lx ly r)
          (multi-digit-divisor-div x y lx ly r)))))

  (div x y (bignum-length x) (bignum-length y)))

; Conversion to string

(define (##bignum.number->string n rad)

  (define (bignum->string n rad r r-log-rad radix-log-r-num)
    (let ((len (##fixnum.* (##fixnum.quotient
                             (##fixnum.+
                               (##fixnum.* (##fixnum.- (bignum-length n) 1)
                                           radix-log-r-num)
                               (##fixnum.- (radix-log-den) 1))
                             (radix-log-den))
                           r-log-rad)))
      (let ((n (##bignum.copy n))
            (s (##make-string (##fixnum.+ len 1) #\space)))

        (define (put-digits k i)
          (let loop1 ((k k) (i i) (j r-log-rad) (last-non-zero i))
            (if (##fixnum.< 0 j)
              (let ((d (##fixnum.remainder k rad)))
                (##string-set! s i
                  (##string-ref "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" d))
                (loop1 (##fixnum.quotient k rad)
                       (##fixnum.- i 1)
                       (##fixnum.- j 1)
                       (if (##eq? d 0) last-non-zero i)))
              last-non-zero)))

        (define (move-digits i j)
          (let loop2 ((i i) (j j))
            (if (##fixnum.< len i)
              (##string-shrink! s j)
              (begin
                (##string-set! s j (##string-ref s i))
                (loop2 (##fixnum.+ i 1) (##fixnum.+ j 1))))))

        (let loop3 ((i len))

          (let ((k
                 ; k = next digit in base `r'
                 ; use simple algo for dividing in place by `r'
                 ; (which is known to be less than or equal to radix)

                 (let loop4 ((j (##fixnum.- (bignum-length n) 1)) (k 0))
                   (if (##fixnum.< 0 j)
                     (let ((x (##fixnum.+ (##fixnum.* k (radix))
                                          (bignum-digit-ref n j))))
                       (bignum-digit-set! n j (##fixnum.quotient x r))
                       (loop4 (##fixnum.- j 1) (##fixnum.remainder x r)))
                     k))))

            (let ((last-non-zero (put-digits k i)))
              (##bignum.remove-leading-0s! n)
              (if (##not (bignum-zero? n))
                (loop3 (##fixnum.- i r-log-rad))
                (if (bignum-negative? n)
                  (begin
                    (##string-set! s 0 #\-)
                    (move-digits last-non-zero 1))
                  (move-digits last-non-zero 0)))))))))

  (cond ((##eq? rad 2)
         (bignum->string n rad (r.2) (r-log-rad.2) (radix-log-r-num.2)))
        ((##eq? rad 8)
         (bignum->string n rad (r.8) (r-log-rad.8) (radix-log-r-num.8)))
        ((##eq? rad 10)
         (bignum->string n rad (r.10) (r-log-rad.10) (radix-log-r-num.10)))
        (else
         (bignum->string n rad (r.16) (r-log-rad.16) (radix-log-r-num.16)))))

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; Utilities:

(define (##bignum.copy x)
  (let ((len (bignum-length x)))
    (let ((y (bignum-make len)))
      (let loop ((i (##fixnum.- len 1)))
        (if (##fixnum.< i 0)
          y
          (begin
            (bignum-digit-set! y i (bignum-digit-ref x i))
            (loop (##fixnum.- i 1))))))))

(define (##bignum.remove-leading-0s! x)
  (let ((sign (bignum-sign x)))
    (bignum-sign-set! x 1) ; set to something different than 0
    (let loop ((i (##fixnum.- (bignum-length x) 1)))
      (if (##eq? (bignum-digit-ref x i) 0)
        (loop (##fixnum.- i 1))
        (bignum-shrink! x (##fixnum.+ i 1))))
    (bignum-sign-set! x sign)))

(define (##bignum.normalize x)
  (let ((lx-minus-1 (##fixnum.- (bignum-length x) 1)))
    (if (##fixnum.< (max-digits-for-fixnum) lx-minus-1)
      x
      (let loop ((n 0) (i lx-minus-1))
        (cond ((##fixnum.< 0 i)
               (if (##fixnum.< n (min-fixnum-div-radix))
                 x
                 (let ((y (##fixnum.- (##fixnum.* n (radix))
                                      (bignum-digit-ref x i))))
                   (if (##fixnum.< y 0)
                     (loop y (##fixnum.- i 1))
                     x))))
              ((bignum-negative? x)
               n)
              (else
               (let ((n (##fixnum.- 0 n)))
                 (if (##fixnum.< n 0) x n))))))))

(define (##bignum.<-fixnum n)
  (if (or (##fixnum.< n -16) (##fixnum.< 16 n))
    (##bignum.<-fixnum* n)
    (##vector-ref ##bignum.constants (##fixnum.+ n 16))))

(define (##bignum.<-fixnum* n)
  (let ((neg-n (if (##fixnum.< n 0) n (##fixnum.- 0 n))))
    (let loop1 ((nb-digits 0) (x neg-n))
      (if (##not (##eq? x 0))
        (loop1 (##fixnum.+ nb-digits 1) (##fixnum.quotient x (radix)))
        (let ((r (bignum-make (##fixnum.+ nb-digits 1))))
          (if (##fixnum.< n 0)
            (bignum-set-negative! r)
            (bignum-set-positive! r))
          (let loop2 ((i 1) (x neg-n))
            (if (##not (##eq? x 0))
              (begin
                (bignum-digit-set!
                  r
                  i
                  (##fixnum.- 0 (##fixnum.remainder x (radix))))
                (loop2 (##fixnum.+ i 1) (##fixnum.quotient x (radix))))
              r)))))))

(define ##bignum.constants
  (let ((v (##make-vector 33 #f)))
    (let loop ((i 0) (n -16))
      (if (##not (##fixnum.< 16 n))
        (begin
          (##vector-set! v i (##bignum.<-fixnum* n))
          (loop (##fixnum.+ i 1) (##fixnum.+ n 1)))))
    v))

(define ##bignum.0
  (##bignum.<-fixnum 0))

(define ##bignum.2*min-fixnum
  (##bignum.* (##bignum.<-fixnum (min-fixnum)) (##bignum.<-fixnum 2)))

;------------------------------------------------------------------------------

; Ratnum operations
; -----------------

(define (##ratnum.= x y)
  (and (##= (ratnum-numerator x) (ratnum-numerator y))
       (##= (ratnum-denominator x) (ratnum-denominator y))))

(define (##ratnum.< x y)
  (##< (##* (ratnum-numerator x) (ratnum-denominator y))
       (##* (ratnum-denominator x) (ratnum-numerator y))))

(define (##ratnum.+ x y)
  (##ratnum.normalize
    (##+ (##* (ratnum-numerator x) (ratnum-denominator y))
         (##* (ratnum-denominator x) (ratnum-numerator y)))
    (##* (ratnum-denominator x) (ratnum-denominator y))))

(define (##ratnum.* x y)
  (##ratnum.normalize
    (##* (ratnum-numerator x) (ratnum-numerator y))
    (##* (ratnum-denominator x) (ratnum-denominator y))))

(define (##ratnum.- x y)
  (##ratnum.normalize
    (##- (##* (ratnum-numerator x) (ratnum-denominator y))
         (##* (ratnum-denominator x) (ratnum-numerator y)))
    (##* (ratnum-denominator x) (ratnum-denominator y))))

(define (##ratnum./ x y)
  (##ratnum.normalize
    (##* (ratnum-numerator x) (ratnum-denominator y))
    (##* (ratnum-denominator x) (ratnum-numerator y))))

(define (##ratnum.floor x)
  (let ((num (ratnum-numerator x))
        (den (ratnum-denominator x)))
    (if (##negative? num)
      (##quotient (##- num (##- den 1)) den)
      (##quotient num den))))

(define (##ratnum.ceiling x)
  (let ((num (ratnum-numerator x))
        (den (ratnum-denominator x)))
    (if (##negative? num)
      (##quotient num den)
      (##quotient (##+ num (##- den 1)) den))))

(define (##ratnum.truncate x)
  (##quotient (ratnum-numerator x) (ratnum-denominator x)))

(define (##ratnum.round x)
  (let ((num (ratnum-numerator x))
        (den (ratnum-denominator x)))
    (if (##eq? den 2)
      (if (##negative? num)
        (##* (##quotient (##- num 1) 4) 2)
        (##* (##quotient (##+ num 1) 4) 2))
      (##floor (##ratnum.normalize (##+ (##* num 2) den) (##* den 2))))))

(define (##ratnum.normalize num den)
  (let ((x (##gcd num den)))
    (let ((y (if (##negative? den) (##- 0 x) x)))
      (let ((num (##quotient num y))
            (den (##quotient den y)))
        (if (##eq? den 1)
          num
          (ratnum-make num den))))))

(define (##ratnum.<-exact-int x)
  (ratnum-make x 1))

;------------------------------------------------------------------------------

; Flonum operations
; -----------------

(define-system (##flonum.->fixnum x))

(define-system (##flonum.<-fixnum x))

(define-nary0 (##flonum.+ x y) (inexact-0) x (##flonum.+ x y) no-touch)
(define-nary0 (##flonum.* x y) (inexact-+1) x (##flonum.* x y) no-touch)
(define-nary1 (##flonum.- x y) (##flonum.- (inexact-0) x) (##flonum.- x y) no-touch)
(define-nary1 (##flonum./ x y) (##flonum./ (inexact-+1) x) (##flonum./ x y) no-touch)

(define-system (##flonum.abs x))

(define-system (##flonum.floor x)
  (let ((y (##flonum.truncate x)))
    (if (or (##flonum.= x y) (##flonum.positive? x))
      y
      (##flonum.- y (inexact-+1)))))

(define-system (##flonum.ceiling x)
  (let ((y (##flonum.truncate x)))
    (if (or (##flonum.= x y) (##flonum.negative? x))
      y
      (##flonum.+ y (inexact-+1)))))

(define-system (##flonum.truncate x))
(define-system (##flonum.round x))

(define-system (##flonum.exp x))
(define-system (##flonum.log x))
(define-system (##flonum.sin x))
(define-system (##flonum.cos x))
(define-system (##flonum.tan x))
(define-system (##flonum.asin x))
(define-system (##flonum.acos x))
(define-system (##flonum.atan x))
(define-system (##flonum.sqrt x))

(define-system (##flonum.zero? x)
  (##flonum.= x (inexact-0)))

(define-system (##flonum.positive? x)
  (##flonum.< (inexact-0) x))

(define-system (##flonum.negative? x)
  (##flonum.< x (inexact-0)))

(define-nary0-boolean (##flonum.= x y)
  (##flonum.= x y) no-check no-touch)

(define-nary0-boolean (##flonum.< x y)
  (##flonum.< x y) no-check no-touch)

(define-nary0-boolean (##flonum.> x y)
  (##flonum.< y x) no-check no-touch)

(define-nary0-boolean (##flonum.<= x y)
  (##not (##flonum.< y x)) no-check no-touch)

(define-nary0-boolean (##flonum.>= x y)
  (##not (##flonum.< x y)) no-check no-touch)

(define (##flonum.<-ratnum x)
  (##flonum./ (##exact->inexact (ratnum-numerator x))
              (##exact->inexact (ratnum-denominator x))))

(define (##flonum.<-bignum x)
  (let ((lx (bignum-length x)))
    (let loop ((i (##fixnum.- lx 1)) (res (inexact-0)))
      (if (##fixnum.< 0 i)
        (loop (##fixnum.- i 1)
              (##flonum.+ (##flonum.* res (inexact-radix))
                          (##flonum.<-fixnum (bignum-digit-ref x i))))
        (if (bignum-negative? x)
          (##flonum.- (inexact-0) res)
          res)))))

(define (##flonum.->exact-int x)
  (let loop1 ((z (##flonum.abs x)) (n 1))
    (if (##flonum.< (inexact-radix) z)
      (loop1 (##flonum./ z (inexact-radix)) (##fixnum.+ n 1))
      (let loop2 ((res 0) (z z) (n n))
        (if (##fixnum.< 0 n)
          (let ((truncated-z (##flonum.truncate z)))
            (loop2 (##+ (##flonum.->fixnum truncated-z) (##* res (radix)))
                   (##flonum.* (##flonum.- z truncated-z) (inexact-radix))
                   (##fixnum.- n 1)))
          (if (##flonum.negative? x)
            (##- 0 res)
            res))))))

(define (##flonum.->inexact-exponential-format x)

  (define (exp-form-pos x y i)
    (let ((i*2 (##fixnum.+ i i)))
      (let ((z (if (and (##not (##fixnum.< (flonum-e-bias) i*2))
                        (##not (##flonum.< x y)))
                 (exp-form-pos x (##flonum.* y y) i*2)
                 (##cons x 0))))
        (let ((a (##car z)) (b (##cdr z)))
          (let ((i+b (##fixnum.+ i b)))
            (if (and (##not (##fixnum.< (flonum-e-bias) i+b))
                     (##not (##flonum.< a y)))
              (begin
                (##set-car! z (##flonum./ a y))
                (##set-cdr! z i+b)))
            z)))))

  (define (exp-form-neg x y i)
    (let ((i*2 (##fixnum.+ i i)))
      (let ((z (if (and (##fixnum.< i*2 (flonum-e-bias-minus-1))
                        (##flonum.< x y))
                 (exp-form-neg x (##flonum.* y y) i*2)
                 (##cons x 0))))
        (let ((a (##car z)) (b (##cdr z)))
          (let ((i+b (##fixnum.+ i b)))
            (if (and (##fixnum.< i+b (flonum-e-bias-minus-1))
                     (##flonum.< a y))
              (begin
                (##set-car! z (##flonum./ a y))
                (##set-cdr! z i+b)))
            z)))))

  (define (exp-form x)
    (if (##flonum.< x (inexact-+1))
      (let ((z (exp-form-neg x (inexact-+1/2) 1)))
        (##set-car! z (##flonum.* (inexact-+2) (##car z)))
        (##set-cdr! z (##fixnum.- -1 (##cdr z)))
        z)
      (exp-form-pos x (inexact-+2) 1)))

  (if (##flonum.negative? x)
    (let ((z (exp-form (##flonum.abs x))))
      (##set-car! z (##flonum.- (inexact-0) (##car z)))
      z)
    (exp-form x)))

(define (##flonum.->exact-exponential-format x)
  (let ((z (##flonum.->inexact-exponential-format x)))
    (let ((y (##car z)))
      (cond ((##not (##flonum.< y (inexact-+2)))
             (##set-car! z (flonum-+m-min))
             (##set-cdr! z (flonum-e-bias-plus-1)))
            ((##not (##flonum.< (inexact--2) y))
             (##set-car! z (flonum--m-min))
             (##set-cdr! z (flonum-e-bias-plus-1)))
            (else
             (##set-car! z (##flonum.->exact-int (##flonum.* (##car z) (flonum-m-min))))))
      (##set-cdr! z (##fixnum.- (##cdr z) (flonum-m-bits)))
      z)))

(define (##flonum.inexact->exact x)
  (let ((z (##flonum.->exact-exponential-format x)))
    (##* (##car z) (##expt 2 (##cdr z)))))

(define (##flonum.->bits x)

  (define (bits a b)
    (if (##< a (flonum-+m-min))
      a
      (##+ (##- a (flonum-+m-min))
           (##* (##fixnum.+ (##fixnum.+ b (flonum-m-bits)) (flonum-e-bias))
                (flonum-+m-min)))))

  (let ((z (##flonum.->exact-exponential-format x)))
    (let ((a (##car z)) (b (##cdr z)))
      (if (##negative? a)
        (##+ (flonum-sign-bit) (bits (##- 0 a) b))
        (bits a b)))))

(define (##flonum.->ratnum x)
  (let ((y (##flonum.inexact->exact x)))
    (if (exact-int? y)
      (##ratnum.<-exact-int y)
      y)))

;------------------------------------------------------------------------------

; Cpxnum operations
; -----------------

(define (##cpxnum.= x y)
  (and (##= (cpxnum-real x) (cpxnum-real y))
       (##= (cpxnum-imag x) (cpxnum-imag y))))

(define (##cpxnum.+ x y)
  (let ((a (cpxnum-real x)) (b (cpxnum-imag x))
        (c (cpxnum-real y)) (d (cpxnum-imag y)))
    (##make-rectangular (##+ a c) (##+ b d))))

(define (##cpxnum.* x y)
  (let ((a (cpxnum-real x)) (b (cpxnum-imag x))
        (c (cpxnum-real y)) (d (cpxnum-imag y)))
    (##make-rectangular (##- (##* a c) (##* b d)) (##+ (##* a d) (##* b c)))))

(define (##cpxnum.- x y)
  (let ((a (cpxnum-real x)) (b (cpxnum-imag x))
        (c (cpxnum-real y)) (d (cpxnum-imag y)))
    (##make-rectangular (##- a c) (##- b d))))

(define (##cpxnum./ x y)
  (let ((a (cpxnum-real x)) (b (cpxnum-imag x))
        (c (cpxnum-real y)) (d (cpxnum-imag y)))
    (let ((q (##+ (##* c c) (##* d d))))
      (##make-rectangular (##/ (##+ (##* a c) (##* b d)) q)
                          (##/ (##- (##* b c) (##* a d)) q)))))

(define (##cpxnum.<-non-cpxnum x)
  (cpxnum-make x 0))

;------------------------------------------------------------------------------