;; Die ersten drei Zeilen dieser Datei wurden von DrScheme eingefügt. Sie enthalten Metadaten
;; über die Sprachebene dieser Datei in einer Form, die DrScheme verarbeiten kann.
#reader(lib "DMdA-advanced-reader.ss" "deinprogramm")((modname kapitel-16) (read-case-sensitive #f) (teachpacks ()) (deinprogramm-settings #(#f write repeating-decimal #t #t none datum #f ())))
; Kapitel 16

; Prädikat für Definitionen
; definition? : form -> boolean
; (define definition?
;   (lambda (form)
;     (and (pair? form)
;         (equal? 'define (first form)))))

; aus einer Definition die Variable extrahieren
(: definition-variable (definition -> symbol))
(define definition-variable
  (lambda (form)
    (first (rest form))))

; aus einer Definition den Ausdruck extrahieren
(: definition-expression (definition -> expression))
(define definition-expression
  (lambda (form)
    (first (rest (rest form)))))

(: variable? (form -> boolean))
(define variable?
  (lambda (form)
    (symbol? form)))

(define variable (contract symbol))

; Ein Ausdruck ist eins der folgenden:
; - eine Variable
; - ein Literal
; - ein Lambda-Ausdruck
; - eine binäre Verzweigung
; - eine Zuweisung
; - ein Block
; - ein Prozeduraufruf
; Name: expression
(define expression
  (contract
   (mixed variable
	  literal
	  lambda-expression
	  conditional
	  assignment
	  block
	  application)))

; Eine Form ist eins der folgenden:
; - ein Ausdruck
; - eine Definition
; Name: form
(define form
  (contract (mixed expression definition)))

; Ein Literal ist eins der folgenden:
; - ein selbstquotierender Wert
; - ein Quote-Ausdruck
; Name: literal
(define literal
  (contract
   (mixed self-quoting
	  quote-expression)))

; Ein selbstquotierender Ausdruck ist eins der folgenden:
; - ein boolescher Wert
; - eine Zeichenkette
; - eine Zahl

; Prädikat für selbstquotierende Literale
(: self-quoting? (%a -> boolean))
(define self-quoting?
  (lambda (form)
    (or (boolean? form)
        (string? form)
        (number? form))))

(define self-quoting (contract (predicate self-quoting?)))

; Ein Quote-Ausdruck ist eine Liste aus
; - dem Symbol quote
; - einem beliebigen repräsentierbaren Wert
; Name: quote

; Prädikat für Quote-Ausdrücke
; quote? : form -> boolean
; (define quote?
;   (lambda (form)
;     (and (pair? form)
;          (equal? 'quote (first form)))))

; Prädikat für zusammengesetzte Formen herstellen,
; die mit einem bestimmten Symbol anfangen
(: make-compound-predicate (symbol -> (%a -> boolean)))
(define make-compound-predicate
  (lambda (name)
    (lambda (form)
      (and (pair? form)
           (eq? name (first form))))))

; Prädikat für Definitionen
(: definition? (%a -> boolean))
(define definition? (make-compound-predicate 'define))

(define definition (contract (predicate definition?)))

; Prädikat für Quote-Ausdrücke
(: quote? (%a -> boolean))
(define quote? (make-compound-predicate 'quote))

(define quote-expression (contract (predicate quote?)))

; aus einem Quote-Ausdruck die Konstante extrahieren
; quote-constant : quote -> datum
(define quote-constant
  (lambda (form)
    (first (rest form))))

; Prädikat für Literale
(: literal? (%a -> boolean))
(define literal?
  (lambda (form)
    (or (quote? form)
        (self-quoting? form))))

; aus einem Literal die Konstante extrahieren
(: literal-constant (literal -> %a))
(define literal-constant
  (lambda (form)
    (if (quote? form)
        (quote-constant form)
        form)))

; Ein Lambda-Ausdruck ist eine Liste aus
; - dem Symbol lambda
; - einer Liste der Parameter
; - dem Rumpf, einem Ausdruck
; Name: lambda

; Prädikat für Lambda-Ausdrücke
(: lambda? (%a -> boolean))
(define lambda? (make-compound-predicate 'lambda))

(define lambda-expression (contract (predicate lambda?)))

; aus einem Lambda-Ausdruck die Parameter-Liste extrahieren
(: lambda-parameters (lambda-expression -> (list variable)))
(define lambda-parameters
  (lambda (form)
    (first (rest form))))

; aus einem Lambda-Ausdruck den Rumpf extrahieren
(: lambda-body (lambda-expression -> expression))
(define lambda-body
  (lambda (form)
    (first (rest (rest form)))))

; Einen binäre Verzweigung ist eine Liste aus
; - dem Symbol if
; - dem Test, einem Ausdruck
; - der Konsequente, einem Ausdruck
; - der Alternative, einem Ausdruck
; Name: conditional

; Prädikat für binäre Verzweigungen
(: conditional? (%a -> boolean))
(define conditional? (make-compound-predicate 'if))

(define conditional (contract (predicate conditional?)))

; aus einer binären Verzweigung den Test extrahieren
; conditional-test : conditional -> expression
(define conditional-test
  (lambda (form)
    (first (rest form))))

; aus einer binären Verzweigung die Konsequente extrahieren
(: conditional-consequent (conditional -> expression))
(define conditional-consequent
  (lambda (form)
    (first (rest (rest form)))))

; aus einer binären Verzweigung die Alternative extrahieren
(: conditional-alternative (conditional -> expression))
(define conditional-alternative
  (lambda (form)
    (first (rest (rest (rest form))))))

; Eine Zuweisung ist eine Liste aus
; - dem Symbol set!
; - einer Variable
; - einem Ausdruck
; Name: assignment

; Prädikat für Zuweisungen
(: assignment? (%a -> boolean))
(define assignment? (make-compound-predicate 'set!))

(define assignment (contract (predicate assignment?)))

; aus einer Zuweisung die Variable extrahieren
(: assignment-variable (assignment -> variable))
(define assignment-variable
  (lambda (form)
    (first (rest form))))

(: assignment-expression (assignment -> expression))
(define assignment-expression
  (lambda (form)
    (first (rest (rest form)))))

; Ein Block ist eine Liste aus
; - dem Symbol begin
; - weiteren Ausdrücken
; Name: block

; Prädikat für Blöcke
; block? : form -> boolean
(define block? (make-compound-predicate 'begin))

(define block (contract (predicate block?)))

; die Ausdrücke eines Blocks extrahieren
; block-expressions : block -> list(expression)
(define block-expressions
  (lambda (form)
    (rest form)))

; Eine Prozeduranwendung ist eine Liste aus
; - dem Operator, einem Ausdruck
; - den Operanden, ihrerseits Ausdrücke
; Name: application
(define application (contract (predicate pair?)))

; aus einer Prozeduranwendung den Operator extrahieren
(: application-operator (application -> expression))
(define application-operator
  (lambda (form)
    (first form)))

; aus einer Prozeduranwendung die Operanden extrahieren
(: application-operands (application -> (list expression)))
(define application-operands
  (lambda (form)
    (rest form)))

; Ein Interpreter-Wert ist eins der folgenden:
; - ein gewöhnlicher Wert
; - eine Closure
; - eine eingebaute Prozedur
; Name: value
(define value
  (contract
   (mixed ordinary-value
	  closure
	  builtin-procedure)))

; Ein gewöhnlicher Wert ist ein Wert
; (make-ordinary-value v)
; wobei v ein Wert ist.
(define-record-procedures ordinary-value
  make-ordinary-value ordinary-value?
  (ordinary-value-ref))

(: make-ordinary-value (%a -> ordinary-value))

; Eine Closure ist ein Wert
; (make-closure p b e)
; wobei p eine Liste von Variablen (die Parameter),
; b ein Ausdruck (der Rumpf) und e eine Umgebung ist.
(define-record-procedures closure
  make-closure closure?
  (closure-parameters closure-body closure-environment))

(: make-closure ((list variable) expression environment -> closure))

; Eine Umgebung ist ein Wert
; (make-environment f e)
; wobei f ein Frame und e eine Umgebung oder #f ist.
(define-record-procedures environment
  make-environment environment?
  (environment-frame environment-enclosing-environment))

(: make-environment (frame (mixed environment false) -> environment))

; Ein Frame ist ein Wert
; (make-frame b)
; wobei b eine Liste von Bindungen ist.
(define-record-procedures-2 frame
  make-frame frame?
  ((frame-bindings set-frame-bindings!)))

(: make-frame ((list binding) -> frame))

; Eine Bindung ist ein Wert
; (make-binding v l)
; wobei v eine Variable und l ein Interpreter-Wert ist.
(define-record-procedures-2 binding
  make-binding binding?
  (binding-variable (binding-value set-binding-value!)))

(: make-binding (variable value -> binding))

; Bindung in Umgebung suchen
(: environment-lookup-binding (environment variable -> (mixed binding false)))
(define environment-lookup-binding
  (lambda (env var)
    (let ((maybe
           (frame-lookup-binding (environment-frame env)
                                 var)))
      (if (binding? maybe)
          maybe
          (let ((enclosing
                 (environment-enclosing-environment env)))
            (if (environment? enclosing)
                (environment-lookup-binding enclosing var)
                #f))))))

; Bindung in Frame suchen
(: frame-lookup-binding (frame variable -> (mixed binding false)))
(define frame-lookup-binding
  (lambda (frame var)
    ;; lookup : list(bindings) -> binding or #f
    (letrec ((lookup
              (lambda (bindings)
                (cond
                  ((empty? bindings)
                   #f)
                  ((pair? bindings)
                   (if (equal? var (binding-variable (first bindings)))
                       (first bindings)
                       (lookup (rest bindings))))))))
      (lookup (frame-bindings frame)))))

; den Wert einer Bindung in einer Umgebung suchen
(: environment-lookup-value (environment variable -> (mixed value false)))
(define environment-lookup-value
  (lambda (env var)
    (let ((maybe (environment-lookup-binding env var)))
      (if (binding? maybe)
          (binding-value maybe)
          #f))))

; Umgebung für Applikation konstruieren
(: application-environment ((list variable) (list value) environment
                                            -> environment))
(define application-environment
  (lambda (params args env)
    (make-environment (application-frame params args)
                      env)))

; Frame für die Bindungen der Parameter einer Applikation konstruieren
(: application-frame ((list variable) (list value) -> frame))
(define application-frame
  (lambda (params args)
    (letrec
        ;; zip-bindings : list(variable) list(value) -> list(binding)
        ((zip-bindings
          (lambda (params args)
            (cond
              ((empty? params)
               '())
              ((pair? params)
               (make-pair (make-binding (first params) (first args))
			  (zip-bindings (rest params) (rest args))))))))
      (make-frame
       (zip-bindings params args)))))

; Umgebung um eine Bindung erweitern
(: extend-environment! (environment variable value -> unspecific))
(define extend-environment!
  (lambda (env var val)
    (let ((f (environment-frame env)))
      (set-frame-bindings! f
                           (make-pair (make-binding var val)
                                      (frame-bindings f))))))

(: unspecified-value value)
(define unspecified-value
  (make-ordinary-value 'unspecified))

; Ausdruck in bezug auf eine Umgebung auswerten
(: evaluate (expression environment -> value))
(define evaluate
  (lambda (exp env)
    (cond
     ((literal? exp)
      (make-ordinary-value (literal-constant exp)))
     ((variable? exp)
      (environment-lookup-value env exp))
     ((lambda? exp)
      (make-closure (lambda-parameters exp)
                    (lambda-body exp)
                    env))
     ((conditional? exp)
      (if (ordinary-value-ref
            (evaluate (conditional-test exp) env))
          (evaluate (conditional-consequent exp) env)
          (evaluate (conditional-alternative exp) env)))
     ((assignment? exp)
      (let ((v (evaluate (assignment-expression exp) env))
            (b (environment-lookup-binding env
                                           (assignment-variable exp))))
        (begin
          (set-binding-value! b v)
          unspecified-value)))
     (else ;; Prozeduranwendung
      (let ((proc (evaluate (application-operator exp) env))
            (args
             (map (lambda (operand)
                    (evaluate operand env))
                  (application-operands exp))))
        (cond
          ((builtin-procedure? proc)
            (make-ordinary-value
              (apply (builtin-procedure-ref proc)
                     (map ordinary-value-ref args))))
	  ((closure? proc)
	   (evaluate (closure-body proc)
		     (application-environment
		      (closure-parameters proc)
		      args
		      (closure-environment proc))))))))))

; Eine eingebaute Prozedur ist ein Wert
; (make-builtin-procedure p)
; wobei p eine Prozedur ist.
(define-record-procedures builtin-procedure
  make-builtin-procedure builtin-procedure?
  (builtin-procedure-ref))

; Liste von Formen auswerten
(: evaluate-forms ((list form) environment -> (list value)))
(define evaluate-forms
  (lambda (forms env)
    (cond
     ((empty? forms) '())
     ((pair? forms)
      (if (definition? (first forms))
          (begin
            (extend-environment!
             env
             (definition-variable (first forms))
             (evaluate (definition-expression (first forms))
                       env))
            (evaluate-forms (rest forms) env))
          (make-pair (evaluate (first forms) env)
		     (evaluate-forms (rest forms) env)))))))

; globale Umgebung konstruieren
(: make-builtin-global-environment (-> environment))
(define make-builtin-global-environment
  (lambda ()
    (make-environment
      (make-frame
       (list
        (make-binding '+ (make-builtin-procedure +))
        (make-binding '* (make-builtin-procedure *))
        (make-binding '= (make-builtin-procedure =))
        (make-binding '- (make-builtin-procedure -))))
      #f)))

; Programm auswerten
(: evaluate-program ((list form) -> (list value)))
(define evaluate-program
  (lambda (forms)
    (evaluate-forms forms
                    (make-builtin-global-environment))))

(define example1
  '(
    (define pi 3.1415926)
    
    (define circumference
      (lambda (radius) (* 2 pi radius)))

    (circumference 13))
   )

(check-expect (evaluate-program example1)
              (list (make-ordinary-value 81.6814076)))

(define example2
  '(
    (define factorial
      (lambda (n)
        (if (= n 0)
            1
            (* n (factorial (- n 1))))))
    
    (factorial 5)))


(check-expect (evaluate-program example2)
              (list (make-ordinary-value 120)))

(define example3
  '(
    (define balance 0)
    (set! balance 12)
    balance))

(check-expect (evaluate-program example3)
              (list unspecified-value (make-ordinary-value 12)))