;;; If (rnrs arithmetic flonums) is unavailable, these definitions are used.

;;; Private.

(define (flop0-or-more name op)
  (lambda args
    (for-each (lambda (x) (check-flonum! name x)) args)
    (flonum (apply op args))))

(define (flop1-or-more name op)
  (lambda (x . args)
    (for-each (lambda (x) (check-flonum! name x)) (cons x args))
    (flonum (apply op x args))))

(define (flop2-or-more name op)
  (lambda (x y . args)
    (for-each (lambda (x) (check-flonum! name x)) (cons x (cons y args)))
    (flonum (apply op x y args))))

(define (flpred1 name op)
  (lambda (x)
    (check-flonum! name x)
    (op x)))

(define (flpred2-or-more name op)
  (lambda (x y . args)
    (for-each (lambda (x) (check-flonum! name x)) (cons x (cons y args)))
    (apply op x y args)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Exported.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; R6RS 11.7.4.1 says
;;;
;;;     If z is a complex number object, then (real? z) is true if
;;;     and only if (zero? (imag-part z)) and (exact? (imag-part z))
;;;     are both true.
;;;
;;; As explained in R6RS Rationale 11.6.6, some such rule is needed
;;; so the flonum and compnum representation types will be closed
;;; under operations that would be expected to return a flonum or
;;; compnum, respectively.  See especially the last two paragraphs
;;; of 11.6.6.2.
;;;
;;; FIXME: Unfortunately, some implementations of the R7RS have
;;; defined (imag-part x) to be inexact whenever x is an inexact
;;; real.

;; (define (flonum? x)
;;   (and (number? x)
;;        (real? x)        ; implies (exact? (imag-part x))
;;        (inexact? x)
;; #;     (exact? (imag-part x))))

(define (pair-boolfold f lst)
  (let loop ((lst lst))
    (if (null? (cddr lst))
        (f (car lst) (cadr lst))
        (and (f (car lst) (cadr lst))
             (pair-boolfold f (cdr lst))))))

(define (fl=? x y . rest)
  (pair-boolfold fp= (cons x (cons y rest))))
(define (fl<? x y . rest)
  (pair-boolfold fp< (cons x (cons y rest))))
(define (fl>? x y . rest)
  (pair-boolfold fp> (cons x (cons y rest))))
(define (fl<=? x y . rest)
  (pair-boolfold fp<= (cons x (cons y rest))))
(define (fl>=? x y . rest)
  (pair-boolfold fp>= (cons x (cons y rest))))

(define flinteger?  (conjoin flonum? integer?))
(define flzero?     (conjoin flonum? zero?))
(define flpositive? (conjoin flonum? positive?))
(define flnegative? (conjoin flonum? negative?))
(define flodd?      (conjoin flonum? odd?))
(define fleven?     (conjoin flonum? even?))
(define flfinite?   (conjoin flonum? finite?))
(define flinfinite? (conjoin flonum? infinite?))
(define flnan?      (conjoin flonum? nan?))

(define fl+
  (case-lambda
    (() 0.0)
    (args (foldr fp+ 0.0 args))))
(define fl*
  (case-lambda
    (() 1.0)
    (args (foldr fp* 1.0 args))))
(define fl-
  (case-lambda
    ((x) (fpneg x))
    ((x . rest) (foldl fp- x rest))))
(define fl/
  (case-lambda
    ((x) (fp/ 1.0 x))
    ((x . rest) (foldl fp/ x rest))))

(define flabs      fpabs)

(define flfloor    fpfloor)
(define flceiling  fpceiling)
(define flround    fpround)
(define fltruncate fptruncate)

(define r6rs:flnumerator   numerator)
(define r6rs:fldenominator denominator)

(define flexp      fpexp)
(define flsqrt     fpsqrt)
(define flexpt     fpexpt)
(define fllog      fplog)
(define flsin      fpsin)
(define flcos      fpcos)
(define fltan      fptan)
(define flasin     fpasin)
(define flacos     fpacos)
(define (flatan x #!optional y)
  (if y (fpatan2 x y) (fpatan x)))