;;;; fp-extn.scm
;;;; Kon Lovett, Apr '17
;;;; Kon Lovett, May '06

;;; For use in modules that perform full-numeric-tower arithmetic

(module fp-extn

(;export
  fpzero?
  fppositive?
  fpnegative?
  fpeven?
  fpodd?
  fpmodulo
  fpquotient
  #;fpremainder
  fpfraction)

(import scheme chicken foreign)

(declare
  (bound-to-procedure
    ##sys#flonum-fraction
    ##sys#check-inexact) )

;;

(define C_fmod
  (foreign-lambda double "fmod" double double))

#;
(define C_remainder
  (foreign-lambda double "remainder" double double))

(define (*fpeven? n)
  (fpzero? (fpfraction (fp/ n 2.0))) )

;;

(define (fpzero? n)
  (fp= 0.0 n) )

(define (fppositive? n)
  (fp< 0.0 n) )

(define (fpnegative? n)
  (fp> 0.0 n) )

(define (fpeven? n)
  (and
    (fpinteger? n)
    (*fpeven? n)) )

(define (fpodd? n)
  (and
    (fpinteger? n)
    (not (*fpeven? n))) )

;;

(define (fpmodulo x y)
  (##sys#check-inexact x 'fpmodulo)
  (##sys#check-inexact y 'fpmodulo)
  (fptruncate (C_fmod x y)) )

(define (fpquotient x y)
  (fptruncate (fp/ x y)) )

#;
(define (fpremainder x y)
  (##sys#check-inexact x 'fpremainder)
  (##sys#check-inexact y 'fpremainder)
  (fptruncate (C_remainder x y)) )

;;

(define (fpfraction n)
	(##sys#flonum-fraction n) )

) ;module fp-extn