You are looking at historical revision 31921 of this page. It may differ significantly from its current revision.

sicp

Support for SICP

SICP

sicp

[module] sicp

SICP is a grab-bag of different procedures from sections 1 through 3.3.4, before we started modularizing them (starting from 3.3.5: Constraints).

has-value?

[procedure] (has-value? connector) → boolean

Does this connector have a value?

connector
The connector to test
(define (has-value? connector) (connector 'has-value?))

get-value

[procedure] (get-value connector) → object

Get this connector's value.

connector
The connector to test
(define (get-value connector) (connector 'value))

set-value!

[procedure] (set-value! connector new-value informant) → unspecified

Set this connector's value.

connector
The connector to set
(define (set-value! connector new-value informant)
  ((connector 'set-value!) new-value informant))

forget-value!

[procedure] (forget-value! connector retractor) → unspecified

Forget this connector's value.

connector
The connector to forget
(define (forget-value! connector retractor) ((connector 'forget) retractor))

connect

[procedure] (connect connector new-constraint) → unspecified

Connect a connector to a new constraint.

connector
The connector to connect
new-constraint
The constraint to add
(define (connect connector new-constraint)
  ((connector 'connect) new-constraint))

inform-about-value

[procedure] (inform-about-value constraint) → unspecified

Inform the constraint about a new value

constraint
The constraint to inform
(define (inform-about-value constraint) (constraint 'I-have-a-value))

inform-about-no-value

[procedure] (inform-about-no-value constraint) → unspecified

Inform the constraint about forgetting

constraint
The consraint to inform
(define (inform-about-no-value constraint) (constraint 'I-lost-my-value))

adder

[procedure] (adder a1 a2 sum) → constraint

A constraint that adds two numbers

a1
Addend
a2
Augend
sum
Sum
(define (adder a1 a2 sum)
  (define (process-new-value)
    (cond ((and (has-value? a1) (has-value? a2))
           (set-value! sum (+ (get-value a1) (get-value a2)) me))
          ((and (has-value? a1) (has-value? sum))
           (set-value! a2 (- (get-value sum) (get-value a1)) me))
          ((and (has-value? a2) (has-value? sum))
           (set-value! a1 (- (get-value sum) (get-value a2)) me))))
  (define (process-forget-value)
    (forget-value! sum me)
    (forget-value! a1 me)
    (forget-value! a2 me)
    (process-new-value))
  (define (me request)
    (case request
      ((I-have-a-value) (process-new-value))
      ((I-lost-my-value) (process-forget-value))
      (else (error "Unknown request: ADDER" request))))
  (connect a1 me)
  (connect a2 me)
  (connect sum me)
  me)

multiplier

[procedure] (multiplier m1 m2 product) → constraint

A constraint that multiplies two numbers

a1
Multiplier
a2
Multiplicand
sum
Product
(define (multiplier m1 m2 product)
  (define (process-new-value)
    (cond ((or (and (has-value? m1) (= (get-value m1) 0))
               (and (has-value? m2) (= (get-value m2) 0)))
           (set-value! product 0 me))
          ((and (has-value? m1) (has-value? m2))
           (set-value! product (* (get-value m1) (get-value m2)) me))
          ((and (has-value? product) (has-value? m1))
           (set-value! m2 (/ (get-value product) (get-value m1)) me))
          ((and (has-value? product) (has-value? m2))
           (set-value! m1 (/ (get-value product) (get-value m2)) me))))
  (define (process-forget-value)
    (forget-value! product me)
    (forget-value! m1 me)
    (forget-value! m2 me)
    (process-new-value))
  (define (me request)
    (case request
      ((I-have-a-value) (process-new-value))
      ((I-lost-my-value) (process-forget-value))
      (else (error "Unknown request: MULTIPLIER" request))))
  (connect m1 me)
  (connect m2 me)
  (connect product me)
  me)

constant

[procedure] (constant value connector) → constraint

A constant constraint

value
The value to constantly be
connector
The relevant connector
(define (constant value connector)
  (define (me request) (error "Unknown request: CONSTANT" request))
  (connect connector me)
  (set-value! connector value me)
  me)

probe

[procedure] (probe name connector) → constraint

Probe a connector and inform upon value-change

name
Name of the connector
connector
The connector to probe
(define (probe name connector)
  (define (print-probe value) (format #t "Probe: ~a = ~a~%" name value))
  (define (process-new-value) (print-probe (get-value connector)))
  (define (process-forget-value) (print-probe "?"))
  (define (me request)
    (case request
      ((I-have-a-value) (process-new-value))
      ((I-lost-my-value) (process-forget-value))
      (else (error "Unknown request: PROBE" request))))
  (connect connector me)
  me)

make-connector

[procedure] (make-connector) → connector

Make a connector.

(define (make-connector)
  (let ((value #f) (informant #f) (constraints '()))
    (define (set-my-value newval setter)
      (cond ((not (has-value? me))
             (set! value newval)
             (set! informant setter)
             (for-each-except setter inform-about-value constraints))
            ((not (= value newval))
             (error "Contradiction" (list value newval)))
            (else 'ignored)))
    (define (forget-my-value retractor)
      (if (eq? retractor informant)
        (begin
          (set! informant #f)
          (for-each-except retractor inform-about-no-value constraints))
        'ignored))
    (define (connect new-constraint)
      (if (not (memq new-constraint constraints))
        (set! constraints (cons new-constraint constraints)))
      (if (has-value? me) (inform-about-value new-constraint))
      'done)
    (define (me request)
      (case request
        ((has-value?) (and informant #t))
        ((value) value)
        ((set-value!) set-my-value)
        ((forget) forget-my-value)
        ((connect) connect)
        (else (error "Unknown operation: CONNECTOR" request))))
    me))

for-each-except

[procedure] (for-each-except exception procedure list) → unspecified

Apply a procedure to every item in list except ones eq? to exception.

exception
An element not to apply procedure to
procedure
The procedure to apply
list
The list to iterate over
(define (for-each-except exception procedure list)
  (define (loop items)
    (cond ((null? items) 'done)
          ((eq? (car items) exception) (loop (cdr items)))
          (else (procedure (car items)) (loop (cdr items)))))
  (loop list))

sicp-constraints

sicp-constraints

[module] sicp-constraints

Constraint satisfaction from section 3.3.5

About this egg

Author

Peter Danenberg

License

BSD

Dependencies

Versions
0.0
Initial commit
0.0.1
Add release-info.
0.0.2
Change the repo and uri.
0.0.3
Remove 0.0.
0.1
Some actual code.
0.1.1
Nil, etc.
0.1.2
Remove SRFI-18.
0.1.3
Add accumulate.
0.1.4
Enumerate interval
0.1.5
Add flatmap.
0.1.6
Add `prime?'.
0.2
Add picture language.
0.3
Add the outline-painter.
0.4
Add differentation.
0.4.1
Add images to picture-language.
0.4.2
Add write-painter-to-png.
0.5
Add sets.
0.5.1
Add Huffman trees.
0.5.2
Add abstract data.
0.5.3
Add arithmetic.
0.5.4
Add queues and circuits.

Colophon

Documented by cock.