; 

; Die entscheidente Erkenntnis ist, dass sich
; Gleitkommazahlen als Paare ganzer Zahlen darstellen lassen. Wir
; wickeln um dieses Paar ganzer Zahlen rudimentäre Konstruktoren und
; Selektoren:
; 


(define make-fp
  (lambda (m e)
    (cons m e)))

(define fp-mantissa
  (lambda (f)
    (car f)))

(define fp-exponent
  (lambda (f)
    (cdr f)))

; Die volle Länge der fp-Mantisse würde sinnvoll ein Bit länger
; definiert als die Länge der Fractionfield des IEEE-Formats.
; 


(define fp-mantissa-len 53) ; mit Vorkommastelle

; Ein Paar ganze Zahlen $(m,e)$ stellt die reelle Zahl 
; $r=m2^e$ dar. Dabei ist sind $m$ und $e$ vorzeichenbehaftete
; ganze Zahlen.
; 


(define fp->number
  (lambda (f)
    (exact->inexact 
     (* (fp-mantissa f)
        (expt 2.0 (fp-exponent f))))))

; Sie $x$ nun die Zahl, die in ein Gleitkommazahl umgewandelt werden
; soll.  Der in der Vorlesung besprochene Algorithmus zur Umwandlung von
; {\em poitiven} Schemezahlen in Gleitkommazahlen besteht aus folgenden
; Schritten:
; \begin{enumerate}
; \item Setze die gebrochene Mantisse $r=x$. Setze den Exponenten $e=0$.
;       Die ganzzahligen Mantisse $m=0$, die wir erst aufbauen wollen,
;       soll ebenfalls $m=0$ gesetzt werden, auch wenn wir sie erst sehr viel
;       später brauchen.
; \item Normalisiere nun $r$, indem solange $r$ mit zwei multipliziert oder 
;       durch zwei geteilt wird,
;       bis $1\leq{}r<2$ und der Exponent entsprechend jeweils um 1 verringert
;       oder vergrössert wird. Also entweder
;       \[
;         (m,e) \longrightarrow (m/2,e+1)
;       \]
;       oder
;       \[
;         (m,e) \longrightarrow (2m,e-1).
;       \]
; 

(define number->fp-1 
  (lambda (s r m e)      ; r<>0
    (cond ((< r 1.0)
           (number->fp-1 s (* r 2.0) m (- e 1)))
          ((>= r 2.0)
           (number->fp-1 s (* r 0.5) m (+ e 1)))
          (else
           (number->fp-2 s r m e)))))
; 
; \item Nun wird die ganzzahlige Mantisse aufgebaut. Dies geschieht, indem
;   die einzelnen Bits von $r$ nacheinander über den Dezimalpunkt geschoben
;   werden, und jeweils in die ganzzahlige Mantisse eingebaut werden.
;   Es werden also die folgenden Schritte durchgeführt, solange, bis
;   $r=0$ ist.
;   \begin{description}
;   \item[Wenn $r\geq1$:] $(r,m,e)\longrightarrow(2(r-1),2m+1,e-1)$
;   \item[Wenn $r<1$:]    $(r,m,e)\longrightarrow(2r    ,2m  ,e-1)$
;   \end{description}
; 

(define number->fp-2
  (lambda (s r m e)      ; 1<r<=2
    (cond ((= 0.0 r)
           (make-fp (* s m) (+ e 1)))
          ((< r 1)
           (number->fp-2 s (* 2.0 r) (* m 2) (- e 1)))
          ((>= r 1)
           (number->fp-2 s (* 2.0 (- r 1.0)) 
                         (+ 1 (* m 2)) (- e 1))))))
; Mit Hilfe eine Wrapperfunktion lässt nun sich der allgemeine Fall auf den
; der positiven Schemezahlen zurückführen:
; 

(define number->fp
  (lambda (r)
    (if (= r 0.0)
        (make-fp 0 0)
        (let ((s (if (< r 0) -1 1 )))
          (number->fp-1 s (* r s) 0 0)))))
; Für das Produkt zweier durch Mantisse und Exponent dargestellter Zahlen gilt,
;   dass 
;   \begin{equation}
;       {r_1}{r_2}={m_1}{m_2}2^{e_1+e_2}.
;   \end{equation}
;   Wir erhalten also eine Darstellung des Produktes, wenn wir
;   $m={m_1}{m_2}$ und $e={e_1}+{e_2}$ setzen. Die Funktion
;   ; fp-multiply;  implementiert dieses Verfahren.
; 


(define fp-multiply
  (lambda (f1 f2)
    (make-fp
     (* (fp-mantissa f1) (fp-mantissa f2))
     (+ (fp-exponent f1) (fp-exponent f2)))))

; Analog wird bei der Addition die Addition auf den reellen Zahlen
;   auf Rechenoperationen mit der Darstellung zurückgeführt. Wir nehmen
;   dabei o.~B.~d.~A. an, dass $e_1>=e_2$, und erhalten:
;   \[
;        {r_1}+{r_2}={m_1}2^{e_1}+{m_2}2^{e_2}=
;                    ({m_1}2^{e_1-e_2}+{m_2})2^{e_2}  
;   \]
; 
;    Der Wert des Ausdrucks in der Klammer ist dabei eine ganze Zahl
;    (und genau deswegen wurde diese Klammerung so gewaehlt),
;    so dass wir eine Darstellung des Ergebnisses erhalten, wenn wir
;    $m={m_1}2^{e_1-e_2}+{m_2}$ und $e=e_2$ setzen. ; fp-add; 
;    implementiert dieses Verfahren.
; 
; 

(define fp-add
 (lambda (f1 f2)
   (let* ((result-mantissa
           (lambda (m1 m2 diff-e)
             (+ m2
                (* m1
                   (expt 2 diff-e)))))
          (m1 (fp-mantissa f1))
          (m2 (fp-mantissa f2))
          (e1 (fp-exponent f1))
          (e2 (fp-exponent f2)))
     (if (> e1 e2)
         (make-fp 
          (result-mantissa m1 m2 (- e1 e2))
          e2)
         (make-fp
          (result-mantissa m2 m1 (- e2 e1))
          e1)))))