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

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

;;

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

  (else

    ;;

    (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-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-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-type fixnum)
(define-check-type flonum)
(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 number)

;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)
    (apply error-range loc start end args) )
  (values start end) )