;;
;; 
;; Implementation of a logarithmic number system.
;;
;; Copyright 2009 Ivan Raikov and the Okinawa Institute of Science and
;; Technology.
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.
;;

(module lognum *

(import scheme chicken)

(require-extension extras matchable datatype)

(define-datatype lognum lognum?
  (L (s integer?) (n number?)))

(define (number->lognum x)
  (cond ((zero? x)      (L 0 0))
	((positive? x)  (L 1 (log x)))
	((negative? x)  (L -1 (log (- x))))))
	

(define (lognum->number x)
  (match x
	 (($ lognum 'L s n)
	  (case s ((0) 0) ((-1) (- (exp n))) 
		((1) (exp n))))
	 (else #f)))
			     

(define (lognum-sign x)
  (match x
	 (($ lognum 'L s n) s)
	 (else #f)))
			     
(define (lognum-value x)
  (match x
	 (($ lognum 'L s n) n)
	 (else #f)))
			     

(define (logify2 op)
  (lambda (x y)
    (number->lognum (op (lognum->number x)  (lognum->number y)))))

(define-record-printer (lognum x out)
  (fprintf out "~S" (lognum->number x) ))

(define lognum+ (logify2 +))

(define lognum- (logify2 -))

(define (lognum* x y)
  (match (list x y)
	 ((($ lognum 'L s n) ($ lognum 'L s1 n1))
	  (if (or (zero? s) (zero? s1)) (L 0 0)
	      (L (* s s1) (+ n n1))))
	 (else #f)))

(define (lognum-neg x)
  (match x (($ lognum 'L s n) (L (- s) n))
	 (else #f)))

(define (lognum-abs x)
  (match x (($ lognum 'L s n) (L (abs s) n))
	 (else #f)))

(define (lognum-signum x)
  (match x (($ lognum 'L s n) (L s 0))
	 (else #f)))

(define (lognum/ x y)
  (match (list x y)
	 ((($ lognum 'L 0 n) _) (error 'lognum/ "division by zero"))
	 ((($ lognum 'L s n) ($ lognum 'L s1 n1))
	  (L (* s s1) (- n n1)))
	 (else #f)))

(define (lognum-recip x)
  (match x (($ lognum 'L s n) (L s (- n)))
	 (else #f)))
  

#|

    fromRational x = (fromInteger $ numerator x) / (fromInteger $ denominator x)

|#
)