From f8ccc1cc1b13a1a7679fde07580b0894e6f428cf Mon Sep 17 00:00:00 2001
From: Oliver Payne <ompayne@sdf.org>
Date: Thu, 7 Jul 2022 22:47:58 +0100
Subject: [PATCH] Updates to circuit simulator (not yet completed)

---
 3_21.rkt              | 30 ++++++++-----
 circuit-simulator.rkt | 99 ++++++++++++++++++++++++++++++++++++-------
 2 files changed, 102 insertions(+), 27 deletions(-)

diff --git a/3_21.rkt b/3_21.rkt
index 4a0c9d6..c2ff4e5 100644
--- a/3_21.rkt
+++ b/3_21.rkt
@@ -1,5 +1,7 @@
 #lang sicp
 
+(#%provide empty-queue? make-queue front-queue insert-queue! delete-queue!)
+
 (define (front-ptr queue) (car queue))
 (define (rear-ptr queue) (cdr queue))
 (define (set-front-ptr! queue item) (set-car! queue item))
@@ -36,15 +38,21 @@
   (display (front-ptr queue))
   (newline))
 
-;; EXERCISE 3.21
-(define q1 (make-queue))
-(print-queue q1)
-(insert-queue! q1 'a)
-(print-queue q1)
-(insert-queue! q1 'b)
-(print-queue q1)
-(delete-queue! q1)
-(print-queue q1)
-(delete-queue! q1)
-(print-queue q1)
+(#%require (only racket/base module+))
+
+(module+ test
+  (#%require rackunit)
+
+  (test-begin
+    ;; EXERCISE 3.21
+    (define q1 (make-queue))
+    (print-queue q1)
+    (insert-queue! q1 'a)
+    (print-queue q1)
+    (insert-queue! q1 'b)
+    (print-queue q1)
+    (delete-queue! q1)
+    (print-queue q1)
+    (delete-queue! q1)
+    (print-queue q1)))
 
diff --git a/circuit-simulator.rkt b/circuit-simulator.rkt
index f504d3d..92ffe75 100644
--- a/circuit-simulator.rkt
+++ b/circuit-simulator.rkt
@@ -1,13 +1,14 @@
 #lang sicp
 
 (#%require "3_21.rkt")  ;; for queue
+(#%require racket/trace)
 
 (define (make-agenda) (list 0))
 
 (define the-agenda (make-agenda))
-(define inverter-delay 2)
-(define and-gate-delay 3)
-(define or-gate-delay 5)
+(define inverter-delay 1)
+(define and-gate-delay 10)
+(define or-gate-delay 100)
 
 
 ;;;SECTION 3.3.4
@@ -134,7 +135,8 @@
                  (display " ")
                  (display (current-time the-agenda))
                  (display "  New-value = ")
-                 (display (get-signal wire)))))
+                 (display (get-signal wire))
+                 (newline))))
 
 
 ;;;Implementing agenda
@@ -226,10 +228,6 @@
 
 (module+ sample-simulation
 
-  (define inverter-delay 2)
-  (define and-gate-delay 3)
-  (define or-gate-delay 5)
-  
   (define input-1 (make-wire))
   (define input-2 (make-wire))
   (define sum (make-wire))
@@ -248,14 +246,19 @@
 (module+ test
   (#%require rackunit)
 
-  (define (or-test or-gate)
+  (define (or-test or-gate probe?)
     (define input-1 (make-wire))
     (define input-2 (make-wire))
     (define output (make-wire))
-    (define or-gate-delay 5)
 
     (or-gate input-1 input-2 output)
 
+    (if probe?
+        (begin
+          (probe 'input-1 input-1)
+          (probe 'input-2 input-2)
+          (probe 'output output)))
+
     (set-signal! input-1 0)
     (set-signal! input-2 0)
     (propagate)
@@ -278,7 +281,7 @@
 
 
   (test-case "Or gate 3.28"
-    (or-test or-gate)))
+    (or-test or-gate #f)))
 
 ;; 3.29 Or gate from and gates
 
@@ -286,6 +289,8 @@
 ;; (not (not (a or b)))
 ;; (not ((not a) and (not b))) 
 
+;; Delay is 2*inverter-delay + and-gate-delay
+
 (define (or-from-and-gates a b output)
   (let ((c (make-wire))
         (d (make-wire))
@@ -299,9 +304,14 @@
 (module+ test
 
   (test-case "Or gate from and gates 3.29"
-    (or-test or-from-and-gates))) 
+     (or-test or-from-and-gates #f))) 
+  ;;)
 
 ;; 3.30 Ripple adder
+;;
+;; Half-adder delay: max ((and + not), or) + and
+;; Full-adder delay: 2 * half-adder + or
+;; Ripple adder delay: n * full-adder = n * (2 * (max((and + not), or) + and) + or)
 (define (ripple-carry-adder a b s c)
   (define (add-full-adder a b s c)
     (if (and (pair? a)
@@ -310,9 +320,9 @@
         (let ((ci (make-wire)))
           (full-adder (car a)
                       (car b)
-                      c
+                      ci
                       (car s)
-                      ci)
+                      c)
           (add-full-adder (cdr a)
                           (cdr b)
                           (cdr s)
@@ -322,8 +332,65 @@
          (length s))
       (add-full-adder a b s c)))
 
-;;(module+ ripple-example
-  ;;(define 
+(module+ test
+
+  (define (make-wire-list values)
+    (cond ((null? values) '())
+          (else
+           (let ((w (make-wire)))
+             (set-signal! w (car values))
+             (cons w (make-wire-list (cdr values)))))))
+
+  (define (make-empty-wire-list length)
+    (define (make-zeroes length)
+      (if (= length 0)
+          '()
+          (cons 0 (make-zeroes (- length 1)))))
+    (make-wire-list (make-zeroes length)))
+
+  (define (get-wire-signals wire-list)
+    (map get-signal wire-list))
+
+  (define (test-ripple-adder a1 a2 sum carry)
+    (let* ((a (make-wire-list a1))
+           (b (make-wire-list a2))
+           (s (make-empty-wire-list (length a1)))
+           (c (make-wire))
+           (adder (ripple-carry-adder a b s c)))
+      (propagate)
+      (check-equal? (get-wire-signals s) sum)
+      (check-equal? (get-signal c) carry)))
+
+              
+   (test-case "Ripple carry adder 3.30 (15+0)"
+     (test-ripple-adder
+      '(1 1 1 1)
+      '(0 0 0 0)
+      '(1 1 1 1)
+      0))
+
+   (test-case "Ripple carry adder 3.30 (1+1)"
+     (test-ripple-adder
+      '(1)
+      '(1)
+      '(0)
+      1))
+
+   (test-case "Ripple carry adder 3.30 (3+1)"
+     (test-ripple-adder
+      '(1 1)
+      '(0 1)
+      '(0 0)
+      1))
+
+   (test-case "Ripple carry adder 3.30 (15+1)"
+     (test-ripple-adder
+      '(1 1 1 1)
+      '(0 0 0 1)
+      '(0 0 0 0)
+      1)))
+
+;;)    
 
 ;; EXERCISE 3.31
 ;: (define (accept-action-procedure! proc)