Add missing files from previous exercises
This commit is contained in:
parent
7b095554f4
commit
e98e2cb924
|
@ -0,0 +1,45 @@
|
|||
#lang sicp
|
||||
|
||||
;;For Section 3.3.4, used by and-gate
|
||||
(define (logical-and x y)
|
||||
(cond ((and (= x 1) (= y 1)) 1)
|
||||
((or
|
||||
(and (= x 0) (= y 1))
|
||||
(and (= x 1) (= y 0)))
|
||||
0)
|
||||
(else
|
||||
(error "Invalid signal"))))
|
||||
|
||||
(define (logical-or x y)
|
||||
(cond ((and (= x 0) (= y 0)) 0)
|
||||
((or
|
||||
(and (= x 0) (= y 1))
|
||||
(and (= x 1) (= y 0))
|
||||
(and (= x 1) (= y 1)))
|
||||
1)
|
||||
(else
|
||||
(error "Invalid signals" x y))))
|
||||
|
||||
(define (or-gate a1 a2 output)
|
||||
(define (or-action-procedure)
|
||||
(let ((new-value
|
||||
(logical-or (get-signal a1) (get-signal a2))))
|
||||
(after-delay or-gate-delay
|
||||
(lambda ()
|
||||
(set-signal! output new-value)))))
|
||||
(add-action! a1 or-action-procedure)
|
||||
(add-action! a2 or-action-procedure)
|
||||
'ok)
|
||||
|
||||
|
||||
(#%require (only racket/base module+))
|
||||
|
||||
(module+ test
|
||||
(#%require rackunit)
|
||||
|
||||
(test-begin
|
||||
(check-equal? (logical-or 0 0) 0)
|
||||
(check-equal? (logical-or 1 0) 1)
|
||||
(check-equal? (logical-or 0 1) 1)
|
||||
(check-equal? (logical-or 1 1) 1)))
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
#lang sicp
|
||||
|
||||
(define (inverter input output)
|
||||
(define (invert-input)
|
||||
(let ((new-value (logical-not (get-signal input))))
|
||||
(after-delay inverter-delay
|
||||
(lambda ()
|
||||
(set-signal! output new-value)))))
|
||||
(add-action! input invert-input)
|
||||
'ok)
|
||||
|
||||
(define (logical-not s)
|
||||
(cond ((= s 0) 1)
|
||||
((= s 1) 0)
|
||||
(else (error "Invalid signal" s))))
|
||||
|
||||
;; *following uses logical-and -- see ch3support.scm
|
||||
|
||||
(define (and-gate a1 a2 output)
|
||||
(define (and-action-procedure)
|
||||
(let ((new-value
|
||||
(logical-and (get-signal a1) (get-signal a2))))
|
||||
(after-delay and-gate-delay
|
||||
(lambda ()
|
||||
(set-signal! output new-value)))))
|
||||
(add-action! a1 and-action-procedure)
|
||||
(add-action! a2 and-action-procedure)
|
||||
'ok)
|
||||
|
||||
;; a or b
|
||||
;; (not (not (a or b)))
|
||||
;; (not ((not a) and (not b)))
|
||||
|
||||
(define (or-gate a1 a2 output)
|
||||
(let ((c (make-wire))
|
||||
(d (make-wire))
|
||||
(e (make-wire)))
|
||||
(inverter a c)
|
||||
(inverter b d)
|
||||
(and-gate c d e)
|
||||
(inverter e output)
|
||||
'ok))
|
||||
|
|
@ -0,0 +1,134 @@
|
|||
#lang sicp
|
||||
|
||||
(define (inverter input output)
|
||||
(define (invert-input)
|
||||
(let ((new-value (logical-not (get-signal input))))
|
||||
(after-delay inverter-delay
|
||||
(lambda ()
|
||||
(set-signal! output new-value)))))
|
||||
(add-action! input invert-input)
|
||||
'ok)
|
||||
|
||||
(define (logical-not s)
|
||||
(cond ((= s 0) 1)
|
||||
((= s 1) 0)
|
||||
(else (error "Invalid signal" s))))
|
||||
|
||||
;; *following uses logical-and -- see ch3support.scm
|
||||
|
||||
(define (logical-and x y)
|
||||
(cond ((and (= x 1) (= y 1)) 1)
|
||||
((or
|
||||
(and (= x 0) (= y 1))
|
||||
(and (= x 1) (= y 0))
|
||||
(and (= x 0) (= y 0)))
|
||||
0)
|
||||
(else
|
||||
(error "Invalid signal"))))
|
||||
|
||||
(define (and-gate a1 a2 output)
|
||||
(define (and-action-procedure)
|
||||
(let ((new-value
|
||||
(logical-and (get-signal a1) (get-signal a2))))
|
||||
(after-delay and-gate-delay
|
||||
(lambda ()
|
||||
(set-signal! output new-value)))))
|
||||
(add-action! a1 and-action-procedure)
|
||||
(add-action! a2 and-action-procedure)
|
||||
'ok)
|
||||
|
||||
(define (logical-or x y)
|
||||
(cond ((and (= x 0) (= y 0)) 0)
|
||||
((or
|
||||
(and (= x 0) (= y 1))
|
||||
(and (= x 1) (= y 0))
|
||||
(and (= x 1) (= y 1)))
|
||||
1)
|
||||
(else
|
||||
(error "Invalid signals" x y))))
|
||||
|
||||
(define (or-gate a1 a2 output)
|
||||
(define (or-action-procedure)
|
||||
(let ((new-value
|
||||
(logical-or (get-signal a1) (get-signal a2))))
|
||||
(after-delay or-gate-delay
|
||||
(lambda ()
|
||||
(set-signal! output new-value)))))
|
||||
(add-action! a1 or-action-procedure)
|
||||
(add-action! a2 or-action-procedure)
|
||||
'ok)
|
||||
|
||||
(define (half-adder 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)
|
||||
'ok))
|
||||
|
||||
(define (full-adder a b c-in sum c-out)
|
||||
(let ((s (make-wire))
|
||||
(c1 (make-wire))
|
||||
(c2 (make-wire)))
|
||||
(half-adder b c-in s c1)
|
||||
(half-adder a s sum c2)
|
||||
(or-gate c1 c2 c-out)
|
||||
'ok))
|
||||
|
||||
(define (ripple-carry-adder a b s c)
|
||||
(define (add-full-adder a b s c)
|
||||
(if (and (pair? a)
|
||||
(pair? b)
|
||||
(pair? s))
|
||||
(let ((ci (make-wire)))
|
||||
(full-adder (car a)
|
||||
(car b)
|
||||
c
|
||||
(car s)
|
||||
ci)
|
||||
(add-full-adder (cdr a)
|
||||
(cdr b)
|
||||
(cdr s)
|
||||
ci))))
|
||||
(if (= (length a)
|
||||
(length b)
|
||||
(length s))
|
||||
(add-full-adder a b s c)))
|
||||
|
||||
;; Support procedures
|
||||
|
||||
|
||||
|
||||
(define (make-wire)
|
||||
(let ((signal-value 0) (action-procedures '()))
|
||||
(define (set-my-signal! new-value)
|
||||
(if (not (= signal-value new-value))
|
||||
(begin (set! signal-value new-value)
|
||||
(call-each action-procedures))
|
||||
'done))
|
||||
(define (accept-action-procedure! proc)
|
||||
(set! action-procedures (cons proc action-procedures))
|
||||
(proc))
|
||||
(define (dispatch m)
|
||||
(cond ((eq? m 'get-signal) signal-value)
|
||||
((eq? m 'set-signal!) set-my-signal!)
|
||||
((eq? m 'add-action!) accept-action-procedure!)
|
||||
(else (error "Unknown operation -- WIRE" m))))
|
||||
dispatch))
|
||||
|
||||
(define (call-each procedures)
|
||||
(if (null? procedures)
|
||||
'done
|
||||
(begin
|
||||
((car procedures))
|
||||
(call-each (cdr procedures)))))
|
||||
|
||||
(define (get-signal wire)
|
||||
(wire 'get-signal))
|
||||
|
||||
(define (set-signal! wire new-value)
|
||||
((wire 'set-signal!) new-value))
|
||||
|
||||
(define (add-action! wire action-procedure)
|
||||
((wire 'add-action!) action-procedure))
|
||||
|
Loading…
Reference in New Issue