;; Die ersten drei Zeilen dieser Datei wurden von DrRacket eingefügt. Sie enthalten Metadaten
;; über die Sprachebene dieser Datei in einer Form, die DrRacket verarbeiten kann.
#reader(lib "DMdA-assignments-reader.ss" "deinprogramm")((modname circuit) (read-case-sensitive #f) (teachpacks ()) (deinprogramm-settings #(#f write repeating-decimal #t #t none explicit #f ())))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Der Schaltkreissimulator:

; Benutze zur Implementierung Warteschlangen und veränderbare Listen:
(require "queue.rkt")
(require "mlist.rkt")

; Ein Signal ist entweder 0 oder 1
(define signal (signature (one-of 0 1)))

; Um von dem konkreten Format der Aktionen zu abstrahieren (Aktionen sind
; Prozeduren ohne Argumente), führen wir eine Signatur hierfür ein,
; die wir in den folgenden Prozeduresignaturen benutzen:
(define action (signature ( -> unspecific)))

; Globale Werte: Gatterverzögerungen
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay  5)

; Implementierung der Basisgatter:

(: inverter (wire wire -> unspecific))
(define inverter
  (lambda (input output)
    (add-action!
       input
       (lambda ()
         (letrec ((new-value (logical-not (get-signal input))))
           (after-delay
              inverter-delay
              (lambda ()
                (set-signal! output new-value))))))))

(: logical-not (signal -> signal))
(define logical-not
  (lambda (s)
    (cond ((= s 0) 1)
          ((= s 1) 0))))

(: and-gate (wire wire wire -> unspecific))
(define and-gate
 (lambda (a1 a2 output)
   (letrec
      ((and-action-procedure
         (lambda ()
           (letrec ((new-value (logical-and (get-signal a1)
                                            (get-signal a2))))
             (after-delay
                and-gate-delay
                (lambda () (set-signal! output new-value)))))))
     (begin
       (add-action! a1 and-action-procedure)
       (add-action! a2 and-action-procedure)))))

(: logical-and (signal signal -> signal))
(define logical-and
  (lambda (s1 s2)
    (if (and (= s1 1) (= s2 1))
        1
        0)))

(: or-gate (wire wire wire -> unspecific))
(define or-gate
  (lambda (a1 a2 output)
    (letrec
        ((or-action-procedure
           (lambda ()
             (letrec ((new-value (logical-or (get-signal a1)
                                             (get-signal a2))))
               (after-delay
                  or-gate-delay
                  (lambda () (set-signal! output new-value)))))))
      (begin
        (add-action! a1 or-action-procedure)
        (add-action! a2 or-action-procedure)))))

(: logical-or (signal signal -> signal))
(define logical-or
  (lambda (s1 s2)
    (if (or (= s1 1) (= s2 1))
        1
        0)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Ein Draht ist ein Objekt mit einem Signalwert und Aktionen (Prozeduren),
; die bei einer Wertänderung ausgeführt  werden.

; Drahtobjekte reagieren auf die folgenden Nachrichten:
(define wire-message
  (signature (one-of "get-signal" "set-signal!" "add-action!")))

; Um von der konkreten Drahtimplementierung durch Nachrichtenweitergabe
; zu abstrahieren, führen wir eine Signatur für Drahtobjekte ein:
(define wire (signature (wire-message -> any)))

; Der Konstruktor für Drahtobjekte:
(: make-wire ( -> wire))
(define make-wire
  (lambda ()
    (letrec
      ((signal-value 0)
       (action-procedures empty)

       (set-my-signal!
        (lambda (new-value)
          (if (not (= signal-value new-value))
              (begin (set! signal-value new-value)
                     (call-each action-procedures))
              "ok")))

       (add-action-procedure
        (lambda (proc)
          (begin (set! action-procedures (cons proc action-procedures))
                 (proc))))

       (dispatch
        (lambda (m)
          (cond ((equal? m "get-signal") signal-value)
                ((equal? m "set-signal!") set-my-signal!)
                ((equal? m "add-action!") add-action-procedure)))))

      dispatch)))

(: call-each ((list-of action) -> unspecific))
(define call-each
  (lambda (procedures)
    (if (empty? procedures)
        "ok"
        (begin ((first procedures))
               (call-each (rest procedures))))))

(: get-signal (wire -> signal))
(define get-signal
  (lambda (wire)
    (wire "get-signal")))

(: set-signal! (wire signal -> unspecific))
(define set-signal!
  (lambda (wire new-value)
    ((wire "set-signal!") new-value)))

(: add-action! (wire action -> unspecific))
(define add-action!
  (lambda (wire action-procedure)
    ((wire "add-action!") action-procedure)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Realisierung der Verzögerung
(: after-delay (natural action -> unspecific))
(define after-delay
  (lambda (delay action)
     (add-to-agenda! (+ delay (current-time the-agenda))
                     action
                     the-agenda)))


; Oberste Ebene der Simulation:
(: propagate (-> unspecific))
(define propagate
  (lambda ()
    (if (empty-agenda? the-agenda)
        "ok"
        (begin
          ((first-agenda-item the-agenda))
          (remove-first-agenda-item! the-agenda)
          (propagate)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Ein Zeitsegment besteht aus
; - einer Zeit (natural)
; - einer Warteschlange mit Aktionen
(define-record-procedures segment
  make-segment
  segment?
  (segment-time segment-queue))

(: make-segment (natural (queue-of any) -> segment))
(: segment? (any -> boolean))
(: segment-time (segment -> natural))
(: segment-queue (segment -> (queue-of any)))

; Ein (veränderbarer) Zeitplan besteht aus
; - der aktuellen Zeit (natural)
; - einer veränderbaren Liste von Zeitsegmenten
(define-record-procedures-2 agenda
  make-agenda
  agenda?
  ((agenda-time set-agenda-time!)
   (agenda-segments set-agenda-segments!)))

(: make-agenda (natural (mlist-of segment) -> agenda))
(: agenda? (any -> boolean))
(: agenda-time (agenda -> natural))
(: set-agenda-time! (agenda natural -> unspecific))
(: agenda-segments (agenda -> (mlist-of segment)))
(: set-agenda-segments! (agenda (mlist-of segment) -> unspecific))

; Konstruktor für einen leeren Zeitplan:
(: make-empty-agenda ( -> agenda))
(define make-empty-agenda
  (lambda () (make-agenda 0 empty)))

; Die aktuelle Simulationszeit des Zeitplans:
(: current-time (agenda -> natural))
(define current-time
  (lambda (agenda) (agenda-time agenda)))

; Das erste Zeitsegement des Zeitplans:
(: first-segment (agenda -> segment))
(define first-segment
  (lambda (agenda) (mfirst (agenda-segments agenda))))

; Die restlichen Zeitsegmente des Zeitplans:
(: rest-segments (agenda -> (mlist-of segment)))
(define rest-segments
  (lambda (agenda) (mrest (agenda-segments agenda))))

; Ist der Zeitplan abgearbeitet?
(: empty-agenda? (agenda -> boolean))
(define empty-agenda?
  (lambda (agenda) (empty? (agenda-segments agenda))))

; Füge eine Aktion für einen gegebenen Zeitpunkt hinzu:
(: add-to-agenda! (natural action agenda -> unspecific))
(define add-to-agenda!
  (lambda (time action agenda)
   (letrec
       ((belongs-before?
         (lambda (segments)
           (or (empty? segments)
               (< time (segment-time (mfirst segments))))))

        (make-new-time-segment
         (lambda (time action)
           (letrec ((q (make-queue)))
             (begin (insert-queue! q action)
                    (make-segment time q)))))
        
        (add-to-segments!
         (lambda (segments)
           (cond ((= (segment-time (mfirst segments)) time)
                  (insert-queue!
                   (segment-queue (mfirst segments)) action))
                 ((belongs-before? (mrest segments))
                  (set-mrest! segments
                              (mcons (make-new-time-segment time action)
                                     (mrest segments))))
                 (else (add-to-segments! (mrest segments))))))

        (asegments (agenda-segments agenda)))
   
     (if (belongs-before? asegments)
         (set-agenda-segments!
            agenda
            (mcons (make-new-time-segment time action)
                   asegments))
         (add-to-segments! asegments)))))

; Entferne den zeitlich ersten Eintrag vom Zeitplan
(: remove-first-agenda-item! (agenda -> unspecific))
(define remove-first-agenda-item!
  (lambda (agenda)
  (letrec ((q (segment-queue (first-segment agenda))))
    (begin (delete-queue! q)
           (if (empty-queue? q)
               (set-agenda-segments! agenda (rest-segments agenda))
               "ok")))))

; Liefere den zeitlich ersten Eintrag im Zeitplan
(: first-agenda-item (agenda -> action))
(define first-agenda-item
  (lambda (agenda)
    (if (empty-agenda? agenda)
        (violation "first-agenda-item: agenda is empty")
        (letrec ((first-seg (first-segment agenda)))
          (begin (set-agenda-time! agenda (segment-time first-seg))
                 (front-queue (segment-queue first-seg)))))))


; Anbringen von Sonden an einem Draht
(: probe (string wire -> unspecific))
(define probe
  (lambda (name wire)
   (add-action!
      wire
      (lambda ()
         (begin
           (write-string name)
           (write-string ": time = ")
           (write-string (number->string (current-time the-agenda)))
           (write-string "  new-value = ")
           (write-string (number->string (get-signal wire)))
           (write-newline))))))

; Definiere den globalen Zeitplan zur Simlulation:
(define the-agenda (make-empty-agenda))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Beispiel: Ein Halbaddierer
(: half-adder (wire wire wire wire -> unspecific))
(define half-adder
  (lambda (a b s c)
    (letrec ((d (make-wire))
             (e (make-wire)))
    (begin
      (or-gate a b d)
      (and-gate a b c)
      (inverter c e)
      (and-gate d e s)
      "ok"))))


; Ein Beispiellauf der Simulation:

; Definieren Drähte:
(define input1 (make-wire))
(define input2 (make-wire))
(define sum    (make-wire))
(define carry  (make-wire))

; Anbringen von Sonden:
(probe "input1" input1)
(probe "input2" input2)
(probe "sum   " sum)
(probe "carry " carry)

; Definiere Schaltkreis:
(half-adder input1 input2 sum carry)

; Setze Signale und lasse die Simulation ablaufen:
;(set-signal! input1 1)
;(propagate)
;(set-signal! input2 1)
;(propagate)