;;; Konstruktion, Vorlesung vom 07.12.2000
;;; K11 Imperative Programmierung

;;; Bisher: FUNKTIONALE PROGRAMMIERUNG
;;; - Ausdrücke --> Werte
;;; - Auswertung durch Substitutionsmodell
;;; - Werte bleiben erhalten (Referentielle Transparenz)
;;; - Bedeutung eines Programms / einer Prozedur ist Funktion von
;;;   Eingaben -> Ausgaben. 
;;; - Beweise einfach (Induktion)
;;; - Parallele Ausführung einfacher zu übersehen















;;; Jetzt: IMPERATIVE PROGRAMMIERUNG
;;; - Variablen bezeichnen nicht Werte, sondern SPEICHERPLÄTZE, deren
;;;   Inhalt verändert werden kann.
;;; - Zentrales Konzept ist ZUWEISUNG, dh. die Veränderung des
;;;   Inhaltes eines Speicherplatzes.
;;; - Auswertung durch UMGEBUNGSMODELL, das Speicherplätze modelliert.
;;; - Bedeutung eines Programms ist Transformation des Speicherinhaltes.
;;; - Beweise schwieriger (zB mit Hoare-Kalkül)
;;; - Parallele Ausführung bringt Probleme

;;; Motivation:
;;; - Programme modellieren reale Objekte; manche davon ändern sich im 
;;;   Laufe der Zeit









;;; K11.1 Ein Konto
(define balance 280)

(define withdraw
  (lambda (amount)
    (if (<= amount balance)
	(- balance amount)
	'not-enough-money)))

(withdraw 50)
230
(withdraw 250)
30
(withdraw 300)
'not-enough-money
balance			; immer noch == 280







; SIGNATUR
; withdraw! : number -> (symbol + number)
; ERKLÄRUNG
; (withdraw! n) versucht n von balance abzuheben, falls dies möglich
; ist, so ist das Ergebnis der Restbetrag, anderenfalls eine
; Fehlermeldung.
; DEFINITION
(define withdraw!
  (lambda (amount)
    (if (<= amount balance)
	(begin 
	  (set! balance (- balance amount))
	  balance)
	'not-enough-money)))









;;; Die Zuweisungsoperation.
;;; <expression> ::= <assignment>
;;; <assignment> ::= (set! <variable> <expression>)
;;; Kein Wert! Ausführung von (set! x e) wertet zuerst e zum Wert v
;;; aus und überschreibt dann den Inhalt von x mit v.
;;; Konvention: Operationen, bei denen in erster Linie der Effekt
;;; interessant ist, enden mit ! (BANG)

(withdraw! 50)		; 230
balance			; 230
(withdraw! 250)
'not-enough-money
(withdraw! 220)		; 10
balance			; 10

(set! balance 280)	; Zuweisung







; Ein Privatkonto
; SIGNATUR
; make-withdraw : number -> (number -> (number + symbol))
; ERKLÄRUNG
; (make-withdraw bal) erzeugt ein Konto mit Stand bal und liefert als
; Ergebnis eine Abhebefunktion wie withdraw!.
; DEFINITION
(define make-withdraw
  (lambda (balance)
    (lambda (amount)
      (if (<= amount balance)
	  (begin 
	    (set! balance (- balance amount))
	    balance)
	  'not-enough-money))))








;;; BEISPIELE
(define w1 (make-withdraw 100))
(define w2 (make-withdraw 100))

(w1 50)		; 50
(w2 60)		; 40
(w1 100)	; 'not-enough-money
(w2 40)		; 0
(w1 40)		; 10

;; Identität
(define w1 (make-withdraw 100))
(define w2 w1)

(w1 10)			; 90
(w2 10)			; 80







;;; K11.2 Die Fakultätsfunktion, imperativ

(define imp-fac
  (lambda (n)
    (let ((r 1))
      (let while ()
	(if (zero? n)
	    r
	    (begin
	      (set! r (* r n))
	      (set! n (- n 1))
	      (while)))))))











;;; Reihenfolge der Zuweisungen ist wichtig;
;;; not-fac liefert 0, falls n>0, und 1, falls n=0

(define not-fac
  (lambda (n)
    (let ((r 1))
      (let while ()
	(if (zero? n)
	    r
	    (begin
	      (set! n (- n 1))
	      (set! r (* r n))
	      (while)))))))










;;; K11.3 Ein erweitertes Ausführungsmodell

;;; Das Substitutionsmodell ist für die Beschreibung der Auswertung
;;; imperativer Programme nicht mehr adäquat.
;;; Benötigen "Speicherplatz" für die Aufnahme der Werte von
;;; Variablen. Benutze dafür Hilfsdefinitionen, welche im Lauf der
;;; Rechnung ihren Wert ändern.

;;; Die Auswertung von Ausdrücken geschieht also immer im Kontext
;;; von Definitionen, die sich im Laufe der Zeit ändern können.

;;; Auswertungsregel für set!
;;;   (define x v0)
;;;   ...            [weitere Definitionen, die x nicht betreffen]
;;;   (set! x e)
;;; 1. Werte e zu v1 aus.
;;; 2. Ändere die Definition von x zu
;;;   (define x v1)
;;; 3. Alle weiteren Definitionen bleiben unverändert.
;;; 4. Der Wert von (set! x e) ist unspezifiziert.



;;; Erweiterte Auswertungsregel für Funktionsanwendung:

;;; Formale Parameter, auf die set! angewendet wird, dürfen
;;; NICHT mehr direkt durch ihren Wert ersetzt werden, sondern müssen
;;; auf Speicherplätze verweisen. Das heisst:

;;; Falls x in e in der Form (set! x e0) auftaucht, dann
;;; ((lambda (x) e) v) 
;;; ==>
;;; (define <newname> v)
;;; e [ x := <newname> ]

;;; dabei ist <newname> ein neuer Variablenname, der noch nirgends
;;; in der Berechnung auftaucht.









;;; BEISPIEL

(define w0 (make-withdraw 100))

;;; >>> einsetzen der Definition von make-withdraw >>>

(define w0
  ((lambda (balance)
     (lambda (amount)
       (if (<= amount balance)
	   (begin 
	     (set! balance (- balance amount))
	     balance)
	   'not-enough-money))) 100))

;;; >>> neue Regel für Funktionsanwendung >>>

(define balance-000000 100)		; ein neuer Speicherplatz
(define w0
  (lambda (amount)
    (if (<= amount balance-000000)
	(begin 
	  (set! balance-000000 (- balance-000000 amount))
	  balance-000000)
	'not-enough-money)))



;;; mit den obigen Definitionen von balance-000000 und w0:

(define balance-000000 100)
(define w0
  (lambda (amount)
    (if (<= amount balance-000000)
	(begin 
	  (set! balance-000000 (- balance-000000 amount))
	  balance-000000)
	'not-enough-money)))
(w0 30)

;;; >>> Einsetzen der Definition von w0 >>>

(define balance-000000 100)
((lambda (amount)
   (if (<= amount balance-000000)
       (begin 
	 (set! balance-000000 (- balance-000000 amount))
	 balance-000000)
       'not-enough-money)) 30)


;;; >>> gewöhnliche Funktionsanwendung >>> 

(define balance-000000 100)
(if (<= 30 balance-000000)
    (begin 
      (set! balance-000000 (- balance-000000 30))
      balance-000000)
    'not-enough-money)

;;; >>> einsetzen der Definition von balance-000000 >>>

(define balance-000000 100)
(if (<= 30 100)
    (begin 
      (set! balance-000000 (- balance-000000 30))
      balance-000000)
    'not-enough-money)






;;; >>> Regel für if >>>

(define balance-000000 100)
(begin 
  (set! balance-000000 (- balance-000000 30))
  balance-000000)

;;; >>> einsetzen für balance-000000 >>>

(define balance-000000 100)
(begin 
  (set! balance-000000 (- 100 30))
  balance-000000)

;;; >>> auswerten von -; set! Regel >>>

(define balance-000000 70)
(begin 
  balance-000000)




;;; >>> einsetzen für balance-000000 >>>

(define balance-000000 70)
(begin 
  70)

;;; >>> Regel für (begin v) >>>

(define balance-000000 70)
70













;;; erneute Auswertung von make-withdraw erzeugt neuen Speicherplatz!

(define w3 (make-withdraw 100))

;;; >>> einsetzen von make-with-draw, neue Funktionsanwendung >>>

(define balance-000001 100)		; ein neuer Speicherplatz
(define w3
  (lambda (amount)
    (if (<= amount balance-000001)
	(begin 
	  (set! balance-000001 (- balance-000001 amount))
	  balance-000001)
	'not-enough-money)))









;;; K11.4 Mutatoren und veränderliche Datenstrukturen

;;; Operationen für Paare:
;;; Konstruktor		cons
;;; Selektor		car
;;; Selektor		cdr
;;; MUTATOR		set-car!
;;; MUTATOR		set-cdr!

(define floetenspieler (list 'stefan-rab 'markus-mittermaier))
(set-car! floetenspieler 'stefan-raab)
floetenspieler			; (stefan-raab markus-mittermaier)
(set-cdr! floetenspieler (list 'michael-mittermeier))
floetenspieler			; (stefan-raab michael-mittermeier)
(set-cdr! floetenspieler 'highway-to-hell)
floetenspieler			; (stefan-raab . highway-to-hell)







;;; K11.4.1 Destruktive Listenoperationen

;;; SIGNATUR
;;; last-pair : list -> pair
;;; ERKLÄRUNG
;;; (last-pair xs) liefert das letzte Paar der nicht-leeren Liste xs.
;;; BEISPIEL
;;; (last-pair (list stefan-raab michael-mittermeier))
;;;    == '(michael-mittermeier)
;;; (last-pair (list 32 16 8)) == '(8)
;;; DEFINITION
(define last-pair
  (lambda (xs)
    (let ((ys (cdr xs)))
      (if (pair? ys)
	  (last-pair ys)
	  xs))))






;;; SIGNATUR
;;; append! : list list -> VOID
;;; ERKLÄRUNG
;;; Destruktive Listenverkettung: (append! xs ys) hängt ys an xs
;;; an. Der alte Wert von xs steht nachher nicht mehr zur Verfügung.
;;; Vorbedingung: xs darf nicht leer sein.
;;; DEFINITION
(define append!
  (lambda (xs ys)
    (set-cdr! (last-pair xs) ys)))

(define xs (list 3 4 5))
(define ys (list 9 9 9))
(append! xs ys)
xs			; '(3 4 5 9 9 9)
ys		        ; '(9 9 9)







;;; K11.4.2 Zyklische Strukturen

;;; SIGNATUR
;;; make-cycle! : list -> VOID
;;; ERKLÄRUNG
;;; (make-cycle! xs) konstruiert aus einer nicht-leeren Liste xs eine
;;; unendliche Liste von Wiederholungen von xs.
;;; DEFINITION
(define make-cycle!
  (lambda (xs)
    (set-cdr! (last-pair xs) xs)))

(make-cycle! xs)










;;; K11.4.3 Der ADT Queue
;;; auch: Schlange, FIFO (first-in-first-out)

;;; SIGNATUR
;;; make-empty-queue : -> queue(X)
;;; queue-empty? : queue(X) -> boolean
;;; queue-insert! : queue(X) X -> queue(X)
;;; queue-front : queue(X) -> X
;;; queue-rest! : queue(X) -> queue(X)

;;; Intention: Elemente können mit queue-front und queue-rest! in der
;;; Reihenfolge entnommen werden, in der sie mit queue-insert! eingefügt
;;; worden sind.










;;; Implementierung
;;; Repräsentiere Queue als Liste mit extra Kopfelement.
(define make-empty-queue
  (lambda ()
    (list '*queue*)))
(define queue-empty?
  (lambda (q)
    (null? (cdr q))))
(define queue-insert!
  (lambda (q x)
    (set-cdr! (last-pair q) (list x))
    q))
(define queue-front
  (lambda (q)
    (cadr q)))
(define queue-rest!
  (lambda (q)
    (set-cdr! q (cddr q))))





;;; Anwendung: BREADTH-FIRST Durchlauf eines Baums
(define-struct branch (left elem right))
(define btree-bft
  (lambda (t0)
    (let ((q (make-empty-queue)))
      (queue-insert! q t0)
      (let while ()
        (if (queue-empty? q)
            '()
            (let ((t (queue-front q)))
              (queue-rest! q)
              (cond
                ((null? t) 
                 (while))
                ((branch? t)
                 (begin
                   (queue-insert! q (branch-left t))
                   (queue-insert! q (branch-right t))
                   (cons (branch-elem t)
                         (while)))))))))))



;;; K11.4.4 set! ist genug

;;; set-car! und set-cdr! können mit Funktionen und set! simuliert werden.
;;; Message-Passing zur Implementierung der Selektoren und Mutatoren.
(define-struct my-pair (fun))
(define my-cons
  (lambda (x y)
    (make-my-pair
     (lambda (op)
       (case op
         ((car) x)
         ((cdr) y)
         ((set-car!) (lambda (v) (set! x v)))
         ((set-cdr!) (lambda (v) (set! y v))))))))

(define my-car (lambda (p) ((my-pair-fun p) 'car)))
(define my-cdr (lambda (p) ((my-pair-fun p) 'cdr)))
(define my-set-car! (lambda (p v) (((my-pair-fun p) 'set-car!) v)))
(define my-set-cdr! (lambda (p v) (((my-pair-fun p) 'set-cdr!) v)))
      



;;; K11.5 Veränderung der Auswertungsstrategie
;;; K11.5.1 Verzögerte Auswertung

;;; Vordefinierte Operationen:

;;; delay : X -> promise(X)
;;; force : promise(X) -> X

;;; (delay <exp>) verzögert die Auswertung von <exp>
;;; (force <exp>) erzwingt die Auswertung des verzögerten Ausdrucks
;;; <exp>. Garantiert, dass der verzögerte Ausdruck nur einmal
;;; ausgewertet wird.

(define osterei
  (delay (begin
	   (display "Frohe Ostern!")
	   (newline)
	   #t)))
(force osterei)				;Ausgabe "Frohe Ostern!"
(force osterei)				;keine Ausgabe



;;; Eigene Implementierung: promise(X) = ( -> X)
;;; DEF: Ein THUNK ist eine parameterlose Prozedur.

;;; SIGNATUR
;;; my-delay : ( -> Y) -> ( -> Y)
;;; ERKLÄRUNG
;;; (my-delay thunk) verzögert die Berechnung von (thunk) bis zu dem
;;; Zeitpunkt, wo der Wert verlangt wird. Garantiert, dass (thunk)
;;; höchstens einmal ausgewertet wird.
;;; DEFINITION
(define my-delay
  (lambda (thunk)
    (let ((not-evaluated #t)
	  (value #f))
      (lambda ()
	(if not-evaluated
	    (begin
	      (set! value (thunk))
	      (set! not-evaluated #f)))
	value))))



;;; SIGNATUR
;;; my-force : ( -> Y) -> Y
;;; ERKLÄRUNG
;;; (my-force thunk) ruft (thunk) auf.
;;; DEFINITION
(define my-force
  (lambda (thunk)
    (thunk)))















;;; BEISPIEL
(define inhalt 'nikolaus)
(define nachricht
  (my-delay
   (lambda ()
     (display inhalt)
     inhalt)))
(set! inhalt 'nikolaus-ist-vorbei)
(my-force nachricht)			; 'nikolaus-ist-vorbei, Ausgabe
(set! inhalt 'weihnachten)
(my-force nachricht)			; gleiches Ergebnis, keine Ausgabe












;;; K11.5.2 Ströme

;;; Ein Strom (stream) ist eine potentiell unendliche Liste, d.h., der 
;;; Inhalt des Restes der Liste wird erst auf Anforderung ausgewertet.
;;; Ein Strom besitzt folgende Prädikate und Selektoren:

;;; stream-empty? : stream(X) -> boolean
;;; stream-head : stream(X) -> X
;;; stream-tail : stream(X) -> stream(X)














;;; Implementierung

;;; Ein stream(X) ist entweder
;;; 1. leer '()
;;; oder
;;; 2. eine Struktur
(define-struct stream-cons (real-head real-tail))
;;; wobei real-head : X und real-tail : promise(stream(X)) ist.

(define stream-empty? null?)
(define stream-head (lambda (s) (stream-cons-real-head s)))
(define stream-tail (lambda (s) (force (stream-cons-real-tail s))))











;;; SIGNATUR
;;; stream-from : number -> stream(number)
;;; ERKLÄRUNG
;;; (stream-from n) ist der Strom n, n+1, n+2, ...
;;; DEFINITION
(define stream-from
  (lambda (n)
    (make-stream-cons n (delay (stream-from (+ n 1))))))















;;; SIGNATUR
;;; stream-display : stream -> VOID
;;; ERKLÄRUNG
;;; (stream-display s) druckt die Elemente von s.
;;; DEFINITION
(define stream-display
  (lambda (s)
    (cond
     ((stream-empty? s))
     ((stream-cons? s)
      (display (stream-head s))
      (display ", ")
      (stream-display (stream-tail s))))))










;;; SIGNATUR
;;; stream-filter : (X -> boolean) stream(X) -> stream(X)
;;; ERKLÄRUNG
;;; (stream-filter p s) liefert einen Strom, in dem nur die Elemente
;;; von s sind, für die (p s) gilt.
;;; DEFINITION
(define stream-filter
  (lambda (p s)
    (let loop ((s s))
      (cond
       ((stream-empty? s)
	'())
       ((stream-cons? s)
	(let ((x (stream-head s)))
	  (if (p x)
	      (make-stream-cons x (delay (loop (stream-tail s))))
	      (loop (stream-tail s)))))))))






;;; SIGNATUR
;;; sieve : stream(number) -> stream(number)
;;; ERKLÄRUNG
;;; (sieve s) implementiert das Sieb des Eratosthenes.
;;; DEFINITION
(define sieve
  (lambda (s)
    (let ((p (stream-head s)))
      (make-stream-cons
       p
       (delay
	 (sieve
	  (stream-filter (lambda (x) (not (zero? (remainder x p))))
			 (stream-tail s))))))))









;;; SIGNATUR
;;; primes : stream(number)
;;; ERKLÄRUNG
;;; primes ist Strom der Primzahlen.
;;; DEFINITION
(define primes (sieve (stream-from 2)))

















;;; K11.6 Anwendung: Simulation von digitalen Schaltkreisen

;;; Ein digitaler Schaltkreis besteht aus DRÄHTEN, die digitale
;;; Signale übertragen, und FUNKTIONSEINHEITEN, die Eingabesignale in
;;; Ausgabesignale abbilden.

'(
(define a (make-wire))
(define b (make-wire))
(define c (make-wire))
(define d (make-wire))
(define e (make-wire))
(define s (make-wire))
)









;;; Aufgabe:
;;; Konstruiere einen Halbaddierer mit Eingaben a und b und Ausgaben
;;; s (Summe) und c (Übertrag).
'(
(or-gate a b d)
(and-gate a b c)
(inverter c e)
(and-gate d e s)
)














;;; als Prozedur:
(define half-adder
  (lambda (a b s c)
    (let ((d (make-wire))
	  (e (make-wire)))
      (or-gate a b d)
      (and-gate a b c)
      (inverter c e)
      (and-gate d e s))))

;;; ein Volladdierer aus zwei Halbaddierern
(define full-adder
  (lambda (a b c sm cy)
    (let ((s1 (make-wire))
	  (c1 (make-wire))
	  (c2 (make-wire)))
      (half-adder a b s1 c1)
      (half-adder c s1 sm c2)
      (or-gate c1 c2 cy))))




;;; Grundoperationen auf Drähten:
;;; Der ADT wire
;;; get-signal  : wire -> signal
;;;	liest das aktuelle Signal vom Draht
;;; set-signal! : wire signal -> VOID
;;;	setzt den Draht auf einen neuen Wert
;;; add-action! : wire ( -> VOID) -> VOID
;;;	installiert auf dem Draht eine parameterlose Prozedur, die
;;;	aufgerufen werden muss, wann immer das Signal auf dem Draht
;;;	seinen Wert ändert.













;;; SIGNATUR
;;; inverter : wire wire -> VOID
;;; ERKLÄRUNG
;;; (inverter in out) schaltet einen Inverter zwischen die Drähte
;;; in (Eingabe) und out (Ausgabe)
;;; DEFINITION
(define inverter
  (lambda (in out)
    (add-action!
     in
     (lambda ()
       (let ((new-value (not (get-signal in))))
	 (after-delay inverter-delay
		      (lambda ()
			(set-signal! out new-value))))))))








;;; SIGNATUR
;;; and-gate : wire wire wire -> VOID
;;; ERKLÄRUNG
;;; (and-gate in1 in2 out) schaltet ein Und-Gatter zwischen die
;;; Eingabedrähte in1 und in2 und den Ausgabedraht out.
;;; DEFINITION
(define and-gate
  (lambda (in1 in2 out)
    (let ((do-and
	   (lambda ()
	     (let ((new-value (and (get-signal in1)
                                   (get-signal in2))))
	       (after-delay and-gate-delay
			    (lambda ()
			      (set-signal! out new-value)))))))
      (add-action! in1 do-and)
      (add-action! in2 do-and))))






;;; Repräsentation von Drähten
(define make-wire
  (lambda ()
    (let ((signal-value #f)
	  (action-procs '()))
      (lambda (op)
	(case op
	  ((get-signal)
	   signal-value)
	  ((set-signal!)
	   (lambda (new-value)
	     (if (not (equal? signal-value new-value))
		 (begin
		   (set! signal-value new-value)
		   (for-each (lambda (proc) (proc)) action-procs)))))
	  ((add-action!)
	   (lambda (proc)
	     (set! action-procs (cons proc action-procs))
	     (proc)))
	  (else 'ERROR))))))



;;; Generische Operationen des ADT
;;; Implementierung durch message-passing
(define get-signal
  (lambda (wire)
    (wire 'get-signal)))

(define set-signal!
  (lambda (wire signal)
    ((wire 'set-signal!) signal)))

(define add-action!
  (lambda (wire proc)
    ((wire 'add-action!) proc)))










;;; Implementierung von (after-delay ...)

; Werte vom Typ "tasks" sind Strukturen
(define-struct tasks (time queue))
; wobei time : number und queue : list(pair(number,list(->VOID))

; SIGNATUR
; after-delay : number (-> VOID) -> VOID
; ERKLÄRUNG
; (after-delay time proc) trägt proc in eine Struktur ein, die dafür
; sorgt, dass proc nach time Verzögerung gestartet wird.
; DEFINITION
(define after-delay
  (lambda (time proc)
    (let* ((current-time (tasks-time tq))
	   (queue (tasks-queue tq))
	   (new-queue (insert (+ current-time time) proc queue)))
      (set-tasks-queue! tq new-queue))))





;;; Neues von define-struct

; (define-struct tasks (time queue))
; definiert
; (make-tasks <time> <queue>)         KONSTRUKTOR
; (tasks-time <tasks>)                SELEKTOR
; (tasks-queue <tasks>)               SELEKTOR
; (set-tasks-time! <tasks> <time>)    MUTATOR
; (set-tasks-queue! <tasks> <queue>)  MUTATOR














; SIGNATUR
; insert : number X list(pair(number, list(X))) 
;        -> list(pair(number, list(X)))
; ERKLÄRUNG
; (insert key val q) fügt val zum Schlüssel key in q ein. 
; Vorbedingung: q ist Liste von Paaren, aufsteigend sortiert nach
;   der ersten Komponente.
; DEFINITION
(define insert
  (lambda (key val q)
    (if (null? q)
	(list (list key val))
	(let* ((kv (car q))
	       (key1 (car kv)))
	  (cond ((< key key1) 
                 (cons (list key val) q))
		((= key key1)
                 (set-cdr! (last-pair kv) (list val))
                 q)
		(else
                 (cons kv (insert key val (cdr q)))))))))


;;; Die initiale tasks Struktur zur Zeit 0
(define tq
  (make-tasks 0 '()))

; SIGNATUR
; tasks-reset! : tasks -> VOID
; ERKLÄRUNG
; (tasks-reset! tq) setzt tq auf den Anfangszustand zurück
; DEFINITION
(define tasks-reset!
  (lambda (tq)
    (set-tasks-time! tq 0)
    (set-tasks-queue! '())))










; SIGNATUR
; run : -> VOID
; ERKLÄRUNG
; (run) verarbeitet die Aufgaben in tq, bis keine mehr vorhanden sind.
; DEFINITION
(define run
  (lambda ()
    (let loop ()
      (let ((q (tasks-queue tq)))
	(if (null? q)
	    'finished
	    (let* ((kvs (car q))
		   (the-time (car kvs))
		   (procs (cdr kvs)))
	      (set-tasks-time! tq the-time)
	      (set-tasks-queue! tq (cdr q))
	      (for-each (lambda (proc) (proc)) procs)
	      (loop)))))))





; SIGNATUR
; probe : symbol wire -> VOID
; ERKLÄRUNG
; (probe name wire) registriert eine Aktion, die den neuen Wert
; eines Drahts anzeigt.
; DEFINITION
(define probe
  (lambda (name wire)
    (add-action! wire
		 (lambda ()
		   (newline)
		   (display name)
		   (display "@")
		   (display (tasks-time tq))
		   (display " New value = ")
		   (display (get-signal wire))))))







;;; SIGNATUR
;;; or-gate : wire wire wire -> VOID
;;; ERKLÄRUNG
;;; (or-gate in1 in2 out) schaltet ein Oder-Gatter zwischen die
;;; Eingabedrähte in1 und in2 und den Ausgabedraht out.
;;; DEFINITION
(define or-gate
  (lambda (in1 in2 out)
    (let ((do-or
	   (lambda ()
	     (let ((new-value (or (get-signal in1)
                                  (get-signal in2))))
	       (after-delay or-gate-delay
			    (lambda ()
			      (set-signal! out new-value)))))))
      (add-action! in1 do-or)
      (add-action! in2 do-or))))

(define or-gate-delay 20)
(define inverter-delay 10)
(define and-gate-delay 20)


;;; Beispiel
'(
(define in1 (make-wire)) (probe 'in1 in1)
(define in2 (make-wire)) (probe 'in2 in2)
(define cin (make-wire)) (probe 'cin cin)
(define out (make-wire)) (probe 'out out)
(define cout (make-wire))(probe 'cout cout)

(full-adder in1 in2 cin out cout)

(set-signal! in1 #t)
(set-signal! in2 #t)
(set-signal! cin #f)

(run)
)







;;; eine instabile Schaltung
'(
(define x1 (make-wire))
(define y1 (make-wire))
(define z1 (make-wire))
(define x2 (make-wire))
(define y2 (make-wire))
(define z2 (make-wire))

(and-gate x1 y1 z1)
(and-gate x2 y2 z2)
(inverter z1 y2)
(inverter z2 y1)
(set-signal! x1 #t)
(set-signal! x2 #t)
(probe 'multivibrator z1)

(run)
)


'ok