;;;; type-checks-numbers.impl.scm  -*- Scheme -*-

;

(define float? flonum?)

;

(define-check-type number)
(define-check-type integer)

(define-check-type real)
(define-check-type complex)
(define-check-type rational)
(define-check-type exact)
(define-check-type inexact)

(define-check-type fixnum)
(define-check-type bignum)
(define-check-type ratnum)

(define-check-type flonum)
(define-check-type float)

(define-check-type cplxnum)

;"complex" bodies

(cond-expand

  (unsafe

    (define (check-positive-fixnum loc obj . _) obj)
    (define (check-natural-fixnum loc obj . _) obj)
    (define (check-negative-fixnum loc obj . _) obj)
    (define (check-non-positive-fixnum loc obj . _) obj)

    (define (check-positive-integer loc obj . _) obj)
    (define (check-natural-integer loc obj . _) obj)
    (define (check-negative-integer loc obj . _) obj)
    (define (check-non-positive-integer loc obj . _) obj)

    (define (check-positive-bignum loc obj . _) obj)
    (define (check-negative-bignum loc obj . _) obj)
    (define (check-non-positive-bignum loc obj . _) obj)

    (define (check-positive-ratnum loc obj . _) obj)
    (define (check-negative-ratnum loc obj . _) obj)
    (define (check-non-positive-ratnum loc obj . _) obj)

    (define (check-positive-number loc obj . _) obj)
    (define (check-natural-number loc obj . _) obj)
    (define (check-negative-number loc obj . _) obj)
    (define (check-non-positive-number loc obj . _) obj) )

  (else

    ;;

    (define (check-positive-number loc obj . args)
      (unless (and (number? obj) (positive? obj))
        (error-positive-number loc obj (optional args)))
      obj )

    (define (check-natural-number loc obj . args)
      (unless (and (number? obj) (<= 0 obj))
        (error-natural-number loc obj (optional args)))
      obj )

    (define (check-negative-number loc obj . args)
      (unless (and (number? obj) (negative? obj))
        (error-negative-number loc obj (optional args)))
      obj )

    (define (check-non-positive-number loc obj . args)
      (unless (and (number? obj) (>= 0 obj))
        (error-non-positive-number loc obj (optional args)))
      obj )

    ;;

    (define (check-positive-integer loc obj . args)
      (unless (and (integer? obj) (positive? obj))
        (error-positive-integer loc obj (optional args)))
      obj )

    (define (check-natural-integer loc obj . args)
      (unless (and (integer? obj) (<= 0 obj))
        (error-natural-integer loc obj (optional args)))
      obj )

    (define (check-negative-integer loc obj . args)
      (unless (and (integer? obj) (negative? obj))
        (error-negative-integer loc obj (optional args)))
      obj )

    (define (check-non-positive-integer loc obj . args)
      (unless (and (integer? obj) (>= 0 obj))
        (error-non-positive-integer loc obj (optional args)))
      obj )

    ;;

    (define (check-positive-fixnum loc obj . args)
      (unless (and (fixnum? obj) (fx< 0 obj))
        (error-positive-fixnum loc obj (optional args)))
      obj )

    (define (check-natural-fixnum loc obj . args)
      (unless (and (fixnum? obj) (fx<= 0 obj))
        (error-natural-fixnum loc obj (optional args)))
      obj )

    (define (check-negative-fixnum loc obj . args)
      (unless (and (fixnum? obj) (fx> 0 obj))
        (error-negative-fixnum loc obj (optional args)))
      obj )

    (define (check-non-positive-fixnum loc obj . args)
      (unless (and (fixnum? obj) (fx>= 0 obj))
        (error-non-positive-fixnum loc obj (optional args)))
      obj )

    ;;

    (define (check-positive-bignum loc obj . args)
      (unless (and (bignum? obj) (positive? obj))
        (error-positive-bignum loc obj (optional args)))
      obj )

    (define (check-negative-bignum loc obj . args)
      (unless (and (bignum? obj) (negative? obj))
        (error-negative-bignum loc obj (optional args)))
      obj )

    (define (check-non-positive-bignum loc obj . args)
      (unless (and (bignum? obj) (>= 0 obj))
        (error-non-positive-bignum loc obj (optional args)))
      obj )

    ;;

    (define (check-positive-ratnum loc obj . args)
      (unless (and (ratnum? obj) (positive? obj))
        (error-positive-ratnum loc obj (optional args)))
      obj )

    (define (check-negative-ratnum loc obj . args)
      (unless (and (ratnum? obj) (negative? obj))
        (error-negative-ratnum loc obj (optional args)))
      obj )

    (define (check-non-positive-ratnum loc obj . args)
      (unless (and (ratnum? obj) (>= 0 obj))
        (error-non-positive-ratnum loc obj (optional args)))
      obj ) ) )