Funktionen höherer Ordnung und Closures

(use-modules (srfi srfi-1))
(define (zeige x) (display x) (newline))
(define (zweimal f) (lambda (x) (f (f x))))
(define (kompose f g) (lambda (x) (f (g x))))
(define (addierer n) (lambda (x) (+ x n)))
(define (curry2 f) (lambda (a) (lambda (b) (f a b))))

(zeige ((zweimal 1+) 5))
(zeige ((kompose 1+ (lambda (x) (* x 10))) 4))
(zeige (map (addierer 100) '(1 2 3)))
(zeige (((curry2 +) 3) 4))
(zeige (apply map list '((1 2 3) (4 5 6))))
(zeige (map (lambda (f) (f 10)) (list 1+ 1- (lambda (x) (* x x)))))
(zeige (fold-right cons '() '(1 2 3)))
(zeige (fold cons '() '(1 2 3)))
(zeige (reduce + 0 '(1 2 3 4)))
(zeige (delete 2 '(1 2 3 2)))
(zeige (partition even? '(1 2 3 4 5)))
(zeige (any even? '(1 3 4)))
(zeige (every even? '(2 4)))
(zeige (find (lambda (x) (> x 3)) '(1 5 2 7)))
(zeige (append-map (lambda (x) (list x x)) '(1 2)))
(zeige (delete-duplicates '(1 2 2 3 3 3)))
(zeige (list-index even? '(1 3 4)))
(zeige (take '(1 2 3 4) 2))
(zeige (drop '(1 2 3 4) 2))
(zeige (last '(1 2 3)))

7
41
(101 102 103)
7
((1 4) (2 5) (3 6))
(11 9 100)
(1 2 3)
(3 2 1)
10
(1 3)
(2 4)
#t
#t
5
(1 1 2 2)
(1 2 3)
2
(1 2)
(3 4)
3

(define (zeige x) (display x) (newline))

(define (make-zaehler)
  (let ((n 0))
    (lambda () (set! n (+ n 1)) n)))

(define a (make-zaehler))
(define b (make-zaehler))
(a) (a)
(zeige (list (a) (b)))

(define (make-konto stand)
  (lambda (nachricht . args)
    (case nachricht
      ((einzahlen) (set! stand (+ stand (car args))) stand)
      ((abheben)
       (if (> (car args) stand)
           "Nicht genug Guthaben"
           (begin (set! stand (- stand (car args))) stand)))
      ((stand) stand)
      (else "unbekannte Nachricht"))))

(define k (make-konto 100))
(zeige (k 'einzahlen 50))
(zeige (k 'abheben 30))
(zeige (k 'abheben 500))
(zeige (k 'stand))

(define (memoize f)
  (let ((cache (make-hash-table)))
    (lambda (n)
      (or (hash-ref cache n #f)
          (let ((wert (f n)))
            (hash-set! cache n wert)
            wert)))))

(define fib
  (memoize (lambda (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))))
(zeige (fib 80))

(3 1)
150
120
Nicht genug Guthaben
120
23416728348467685

(define (zeige x) (display x) (newline))

(define-syntax mein-unless
  (syntax-rules ()
    ((_ bedingung rumpf ...) (if bedingung #f (begin rumpf ...)))))

(define-syntax tausche!
  (syntax-rules ()
    ((_ a b) (let ((tmp a)) (set! a b) (set! b tmp)))))

(define-syntax wiederhole
  (syntax-rules ()
    ((_ n rumpf ...) (let schleife ((i 0)) (when (< i n) rumpf ... (schleife (+ i 1)))))))

(define-syntax mein-or
  (syntax-rules ()
    ((_) #f)
    ((_ e) e)
    ((_ e rest ...) (let ((t e)) (if t t (mein-or rest ...))))))

(zeige (mein-unless #f "läuft"))
(define p 1)
(define q 2)
(tausche! p q)
(zeige (list p q))
(wiederhole 3 (display "x "))
(newline)
(define tmp 99)
(define r 1)
(tausche! tmp r)
(zeige (list tmp r))
(zeige (mein-or #f #f 7))

l?uft
(2 1)
x x x
(1 99)
7

(define (zeige x) (display x) (newline))

(zeige (+ 1 (call/cc (lambda (k) (+ 10 (k 5))))))

(define (finde-erste-negative liste)
  (call/cc
   (lambda (zurueck)
     (for-each (lambda (x) (when (< x 0) (zurueck x))) liste)
     #f)))
(zeige (finde-erste-negative '(3 5 -2 7 -9)))
(zeige (finde-erste-negative '(1 2 3)))

(define (produkt liste)
  (call/cc
   (lambda (abbruch)
     (let schleife ((l liste))
       (cond ((null? l) 1)
             ((zero? (car l)) (abbruch 0))
             (else (* (car l) (schleife (cdr l)))))))))
(zeige (produkt '(2 3 4)))
(zeige (produkt '(2 0 4 1000000)))

6
-2
#f
24
0