---------------------------------------------
---- sourcen 
---------------------------------------------
;;; helper
(define first car)
(define rest cdr)



;;; Blockstruktur
(define (foo a b)
  (define (bar x)
    (+ x a b))
  (bar (+ a b)))


;;; Motivation für Funktionen höherer Ordnung
(define (double-all a-list)
  (if (null? a-list) 
	  '()
	  (cons (* 2 (first a-list)) 
                (double-all (rest a-list)))))

(define (add-two a-list)
  (if (null? a-list)
	  '()
	  (cons (+ 2 (first a-list)) 
                (add-two (rest a-list)))))


;;; Funktionen höherer Ordnung
(define (apply-to-all op a-list)
  ;; Wend op auf jedes element in a-list an
  ;; und gebe das ganze in einer Liste zurück
  (if (null? a-list) 
      '()
      (cons (op (first a-list))
            (apply-to-all op (cdr a-list)))))

;; double-all mit map
(define (double-all-with-map al)
  (map (lambda (n) (* 2 n)) al))


(define (filter pred? a-list)
  ;; herausfiltern aller Element aus a-list die dem 
  ;; Prädikat pred? genügen
  (cond
    ((null? a-list) '())
    ((pred? (first a-list)) (cons (first a-list)
                                      (filter pred? (rest a-list))))
    (else
     (filter pred? (rest a-list)))))



;; Funktionen als Rückgabewert
(define (make-adder n)
  ;; Beispiel für die Rückgabe einer Funktion die
  (lambda (m)
    (+ n m)))

; definiere eine Funktion, die 5 zu ihrem Argument addiert
(define add-5 (make-adder 5))



(define (twice f)
  (lambda (x)
    (f (f x))))
(define (succ n)
  (+ n 1))



;; lexikalische Bindung veranschaulicht
(define counter 50)
(define (inc-counter)
  (set! counter (+ 1 counter))
  counter)

;(let ((counter 100))
;  (display (inc-counter)) (newline)
;  (display (inc-counter)) (newline))

;; fluid-let
;(fluid-let ((counter 100))
;  (display (inc-counter)) (newline)
;  (display (inc-counter)) (newline))
           


;; Datenkapselung in Scheme
;; wie im Text
(define (account name . args)
  (let ((name name)
        (balance (if (not (null? args)) (car args) 1000))
        (interest-rate 
         (if (and
              (not (null? args))
              (not (null? (cdr args)))) 
             (cadr args) 
             0.06)))
    (lambda (message)
      (case message
        ((name) (lambda () name))
        ((balance) (lambda () 
                     balance))
        ((deposit) (lambda (amount) 
                     (set! balance (+ balance amount))
                     balance))
        ((withdraw) (lambda (amount)
                      (set! balance (- balance amount))
                      balance))
        ((interest-rate) (lambda () 
                           interest-rate))
        ((add-interest) (lambda () 
                          (set! balance 
                                (* balance 
                                   (+ 1 interest-rate)))
                          balance))
        (else (lambda () "Method unknown"))))))


;; Das ganze etwas strukturierter.
(define (new-account name balance interest-rate)
   (define (get-name) name)
   (define (get-balance) balance)
   (define (deposit! how-much)
       (set! balance (+ balance how-much))
       balance)
   (define (withdraw! how-much)
       (set! balance (- balance how-much))
       balance)
   (define (get-interest-rate) interest-rate)
   (define (add-interest!)
      (set! balance (* balance (+ 1 interest-rate)))
      balance)
   (define (dispatch message)
       (case message
        ((name) get-name)
        ((balance) get-balance)
        ((deposit) deposit!)
        ((withdraw) withdraw!)
        ((interest-rate) get-interest-rate)
        ((add-interest) add-interest!)
        (else (error "Unknown method"))))
   dispatch)
      
;; Arbeitet falls der Aufbau so wie in 
;; den obigen Beispielen erfolgt 
(define (send obj message . args)
  (apply (obj message) args))
    
    
;; Makros
(define-macro my-when
  (lambda (test . body)
  `(if ,test (begin ,@body))))


(require-library "synrule.ss") ; benötigt um die R5Rs Makros in DrScheme nutzen zu können.

(define-syntax my-when-new
  (syntax-rules ()
    ((my-when-new test body ... ) (if test (begin body ...)))))
                  
;; my-and
(define-syntax my-and
  (syntax-rules ()
    ((my-and) #t)
    ((my-and test) test)
    ((my-and test1 test2 ...) 
        (if test1 (my-and test2 ...) #f))))

;; Strukturen "selbst" gemacht. 
;; 

(define (prepend-string string symbol)
  (string->symbol (string-append string 
                                 (symbol->string symbol))))

(define (make-new-record-name name)
  (prepend-string "make-" name))

(define (create-getter-clauses slots)
  (define (create-getter slot)
    `((,(prepend-string "get-" slot))
      (lambda () ,slot)))
  (map create-getter slots))

(define (create-setter-clauses slots)
  (define (create-setter slot)
    `((,(prepend-string "set-" slot))
      (lambda (value) (set! ,slot value))))
  (map create-setter slots))



(define-macro define-my-record
  (lambda (name slots)
    `(define (,(make-new-record-name name)
              ,@slots)
       (lambda (message)
         (case message
           ,@(create-getter-clauses slots)
           ,@(create-setter-clauses slots)
           (else (error "Method unknown")))))))