;;;; type-checks-numbers.impl.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

;; Issues
;;
;; - Chicken Generic Arithmetic!
;;
;; - check-negative-* (< X 0), check-non-positive-* (<= X 0)

;;


(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)

;;

(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)

    (define (check-closed-interval loc obj . _) obj)
    (define (check-open-interval loc obj . _) obj)
    (define (check-half-closed-interval loc obj . _) obj)
    (define (check-half-open-interval loc obj . _) obj)
    (define (check-range 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 )

    ;;

    ;closed interval
    (define (check-closed-interval loc num min max . args)
      (unless (and (<= min num) (<= num max))
        (error-closed-interval loc num min max (optional args)))
      num )

    ;open interval
    (define (check-open-interval loc num min max . args)
      (unless (and (< min num) (< num max))
        (error-open-interval loc num min max (optional args)))
      num )

    ;closed+open interval
    (define (check-half-open-interval loc num min max . args)
      (unless (and (< min num) (<= num max))
        (error-half-open-interval loc num min max (optional args)))
      num )

    ;open+closed interval
    (define (check-half-closed-interval loc num min max . args)
      (unless (and (<= min num) (< num max))
        (error-half-closed-interval loc num min max (optional args)))
      num)

    ;check half-closed-interval itself
    (define (check-range loc start end . args)
      (unless (<= start end)
        (error-range loc start end (optional args)) )
      (values start end) ) ) )