;;; Procedures and macros concerning quantities

;;; define-unit
;;; This should really be part of the reader.

(define-macro (d!define-unit name value)
  `(set! *d!units* (cons (cons ',name ,value) *d!units*)))

(define-macro (d!m number unit . rest)
  (let ((dim (if (null? rest) 1 (car rest)))
	(unit-info (assoc unit *d!units*)))
    (if (not unit-info)
	(dr-error "unknown unit" unit))
    (d!* number (d!expt (cdr unit-info) dim))))

;;; n-ary arithmetic functions

(define (d!+ . args)
  (cond ((null? args) 0)
	((null? (cdr args)) (car args))
	(#t (d!b+ (car args) (apply d!+ (cdr args))))))


(define (d!* . rest)
  (if (null? rest)
      1
      (d!b* (car rest) (apply d!* (cdr rest)))))

(define (d!- first . rest)
  (if (null? rest)
      (make-quantity (- (quantity->number first)) (quantity-dimension first))
      (d!b- first (apply d!+ rest))))

(define (d!/ first . rest)
  (if (null? rest)
      (d!b/ 1 first)
      (d!b/ first (apply d!* rest))))

;;; binary versions

(define (d!b+ a b)
  (if (= (quantity-dimension a) (quantity-dimension b))
      (make-quantity (+ (quantity->number a) (quantity->number b))
		     (quantity-dimension a))
      (dr-error "incompatible dimensions for d!+" a b)))

(define (d!b- a b)
  (if (= (quantity-dimension a) (quantity-dimension b))
      (make-quantity (- (quantity->number a) (quantity->number b))
		     (quantity-dimension a))
      (dr-error "incompatible dimensions for d!-" a b)))

(define (d!b* a b)
  (make-quantity (* (quantity->number a) (quantity->number b))
		 (+ (quantity-dimension a) (quantity-dimension b))))

(define (d!b/ a b)
  (make-quantity (/ (quantity->number a) (quantity->number b))
		 (- (quantity-dimension a) (quantity-dimension b))))

(define --1 d!b-)
(define --2 d!-)

(define /-1 d!b/)
(define /-2 d!/)

;;; other arithmetic functions

(define (d!expt a b)
  ;; we allow (expt number number) and (expt quantity integer)
  (cond ((and (number? a) (number? b)) (expt a b))
	((and (d!quantity? a) (integer? b))
	 (make-quantity (expt (quantity->number a) b)
			(* (quantity-dimension a) b)))
	(#t (dr-error "bad argument types for d!expt" a b))))

;;; predicates

(define d!quantity?
  (lambda (a)
    (or (number? a)(quantity? a))))

(define d!inexact?
  (lambda (a)
    (or (quantity? a)(inexact? a))))

(define d!exact?
  (lambda (a)
    (if (quantity? a)
	#f
      (exact? a))))

(define-macro (def-comp opr bopr)
  `(define (,opr . args)
     (let loop ((first (car args))
		(rest (cdr args)))
	  (if (null? (cdr rest))
	      (,bopr first (car rest))
	    (and (,bopr first (car rest))
		 (loop (car rest)(cdr rest)))))))

(define (d!b> a b)
  (if (and (number? a)(number? b))
      (> a b)
    (if (and (quantity? a)(quantity? b)(= (quantity-dimension a)
					  (quantity-dimension b)))
	(> (quantity->number a)(quantity->number b))
      (dr-error "invalid args to d!>" a b))))

(def-comp d!> d!b>)

(define (d!b>= a b)
  (if (and (number? a)(number? b))
      (>= a b)
    (if (and (quantity? a)(quantity? b)(= (quantity-dimension a)
					  (quantity-dimension b)))
	(>= (quantity->number a)(quantity->number b))
      (dr-error "invalid args to d!>=" a b))))

(def-comp d!>= d!b>=)

(define d!b=
  (lambda (x y)
    (and (d!quantity? x)(d!quantity? y)
	 ;; real quantities have an equal? method
	 (equal? x y))))

(def-comp d!= d!b=)

(define (d!b< a b)
    (if (and (number? a)(number? b))
      (< a b)
    (if (and (quantity? a)(quantity? b)(= (quantity-dimension a)
					  (quantity-dimension b)))
	(< (quantity->number a)(quantity->number b))
      (dr-error "invalid args to d!<" a b))))

(def-comp d!< d!b<)

(define (d!b<= a b)
    (if (and (number? a)(number? b))
      (<= a b)
    (if (and (quantity? a)(quantity? b)(= (quantity-dimension a)
					  (quantity-dimension b)))
	(<= (quantity->number a)(quantity->number b))
      (dr-error "invalid args to d!<=" a b))))

(def-comp d!<= d!b<=)

(define d!floor
  (lambda (x)
    (if (number? x)
	(floor x)
      (dr-error "invalid arg to d!floor" x))))

(define d!ceiling
  (lambda (x)
    (if (number? x)
	(ceiling x)
      (dr-error "invalid arg to d!ceiling" x))))

(define d!truncate
  (lambda (x)
    (if (number? x)
	(truncate x)
      (dr-error "invalid arg to d!truncate" x))))

(define d!round
  (lambda (x)
    (if (number? x)
	(round x)
      (dr-error "invalid arg to d!round" x))))

(define d!exact->inexact
  (lambda (x)
    (if (d!inexact? x)
	x
      (if (number? x)
	  (exact->inexact x)
	(make-quantity (exact->inexact (quantity->number x))
		       (quantity-dimension x))))))

(define d!inexact->exact
  (lambda (x)
    (if (d!exact? x)
	x
      (if (number? x)
	  (inexact->exact x)
	(make-quantity (inexact->exact (quantity->number x))
		       (quantity-dimension x))))))

(define-macro (def-mm opr bopr)
  `(define (,opr . args)
     (if (pair? (cdr args))
	 (let loop ((val (car args))
		    (rest (cdr args))
		    (seeni (d!inexact? (car args))))
	      (let* ((x (car rest))
		     (nv (if (,bopr val x)
			     (if (or seeni (d!exact? x))
				 val
			       (d!exact->inexact val))
			   (if (and seeni (d!exact? x))
			       (d!exact->inexact x)
			     x))))
		(if (null? (cdr rest))
		    nv
		  (loop nv (cdr rest) (or seeni (d!inexact? nv))))))
       (car args))))

(def-mm d!min d!b<)
(def-mm d!max d!b>)

(define d!zero?
  (lambda (q)
    (if (number? q)
	(zero? q)
      (if (quantity? q)
	  (zero? (quantity->number q))
	(dr-error "bad argument type for d!zero?" q)))))

(define d!negative?
  (lambda (q)
    (if (number? q)
	(negative? q)
      (if (quantity? q)
	  (negative? (quantity->number q))
	(dr-error "bad argument type for d!negative?" q)))))

(define d!positive?
  (lambda (q)
    (if (number? q)
	(positive? q)
      (if (quantity? q)
	  (positive? (quantity->number q))
	(dr-error "bad argument type for d!positive?" q)))))

(define d!sqrt
  (lambda (q)
    (if (number? q)
	(if (positive? q)
	    (sqrt q)
	  (dr-error "negative arg to d!sqrt" q))
      (if (quantity? q)
	  (let ((n (quantity->number q))
		(d (quantity-dimension q)))
	    (if (positive? n)
		(if (even? d)
		    (make-quantity (sqrt n)(quotient d 2))
		  (dr-error "odd dimension arg to d!sqrt" q))
	      (dr-error "negative arg to d!sqrt" q)))
	(dr-error "bad argument type for d!positive?" q)))))

(define d!number->string
  (lambda args
    (let ((n (car args))
	  (r (if (pair? (cdr args))
		 (cadr args)
	       10)))
      (if (number? n)
	  (if (inexact? n)
	      (if (= r 10)
		  (number->string n r)
		(dr-error
		 "inexact numbers not supported by d!number->string for radix"
		 r))
	    (number->string n r))
	(dr-error "bad argument type for d!number->string" n)))))

(define d!string->number
  (lambda args
    (let ((s (car args))
	  (r (if (pair? (cdr args))
		 (cadr args)
	       10)))
      (if (= r 10)
	  (string->number s 10)
	(let ((slen (string-length s)))
	  (let loop ((i 0))
	       (if (< i slen)
		   (if (eq? (string-ref s i) #\.)
		       (dr-error
			"Decimal point not supported in d!string->number with radix"
			r)
		     (loop (+ i 1)))
		 (string->number s r))))))))

