;;;; srfi-27-distributions-support.scm
;;;; Kon Lovett, Dec '17

; Chicken Generic Arithmetic!
; (could use fp/fl routines since only floating-point arithmetic)

(module srfi-27-distributions-support

(;export
  ;(use (only mathh mathh-consts))
  *pi* *one-third*
  ;
  nonzero-real? check-nonzero-real error-nonzero-real
  nonnegative-real? check-nonnegative-real error-nonnegative-real
  positive-real? check-positive-real error-positive-real
  check-real-open-interval
  check-real-closed-interval
  check-real-unit
  ;
  *reciprocal *-reciprocal)

(import scheme chicken)

(use
  (only type-errors error-argument-type)
  (only type-checks
    define-check+error-type
    check-procedure
    check-cardinal-integer
    check-real
    check-open-interval
    check-closed-interval)
  srfi-27)

;;; Constants

(define *pi* 3.1415926535897932384626433832795028841972)
(define *one-third* 0.3333333333333333333333333333333333333333)

;;; Chicken Generic Arithmetic Argument Checks

(define (nonzero-real? obj)
  (and (real? obj) (not (zero? obj))) )

(define (nonnegative-real? obj)
  (and (real? obj) (not (negative? obj))) )

(define (positive-real? obj)
  (and (real? obj) (positive? obj)) )

(define-check+error-type nonzero-real)
(define-check+error-type nonnegative-real)
(define-check+error-type positive-real)

(define (check-real-open-interval loc obj mn mx #!optional argnam)
  (check-real loc obj argnam)
  (check-real loc mn argnam)
  (check-real loc mx argnam)
  (check-open-interval loc obj mn mx argnam)
  obj )

(define (check-real-closed-interval loc obj mn mx #!optional argnam)
  (check-real loc obj argnam)
  (check-real loc mn argnam)
  (check-real loc mx argnam)
  (check-closed-interval loc obj mn mx argnam)
  obj )

(define (check-real-unit loc obj #!optional argnam)
  (check-real-closed-interval loc obj 0 1 argnam) )

;;; Mathh

;; (in case special processing needed near limits TBD)

(define (*reciprocal n)
  (/ 1.0 n) )

(define (*-reciprocal n)
  (/ -1.0 n) )

) ;module srfi-27-distributions-support