You are looking at historical revision 32014 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).

sicp-constraints

sicp-constraints

[module] sicp-constraints

Constraint satisfaction from section 3.3.5

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

Gets 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

Sets 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

Forgets this connector's value.

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

connect

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

Connects 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

Informs 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

Informs 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

Probes a connector and informs 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

Makes 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

Applies 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-concurrency

sicp-concurrency

[module] sicp-concurrency

Concurrency procedures from section 3.4

thunk->thread

[procedure] (thunk->thread thunk) → thread

Creates a thread from thunk and start the thread.

thunk
The thunk to threadify
(define (thunk->thread thunk)
  (let ((thread (make-thread thunk))) (thread-start! thread) thread))

parallel-execute

[procedure] (parallel-execute . thunks) → thunk

Executes thunks in parallel; returns a thunk which can be executed to terminate the threads.

thunks
The thunks to execute in parallel
(define (parallel-execute . thunks)
  (let ((threads (map thunk->thread thunks)))
    (lambda () (for-each thread-terminate! threads))))

with-mutex-locked

[procedure] (with-mutex-locked mutex thunk) → object
[procedure] (with-mutex-locked mutex thunk conditional-variable) → object

Evaluates the thunk having locked the mutex, unlocking it thereafter.

mutex
The mutex to lock and unlock
thunk
The thunk to evaluate
conditional-variable
An optional conditional-variable to block on at unlock
(define with-mutex-locked
  (case-lambda
    ((mutex thunk) (with-mutex-locked mutex thunk #f))
    ((mutex thunk conditional-variable)
     (dynamic-wind
       (lambda () (mutex-lock! mutex))
       thunk
       (lambda () (mutex-unlock! mutex conditional-variable))))))

make-serializer

[procedure] (make-serializer) → procedure

Creates a serializer which returns serialized procedures in a common set; returns a procedure taking f, the procedure to serialize.

(define (make-serializer)
  (let ((mutex (make-mutex)))
    (lambda (f)
      (lambda args (with-mutex-locked mutex (lambda () (apply f args)))))))
Examples

Create a serializer and run some thunks.

(define s (make-serializer))
(parallel-execute (s (lambda () (set! x (* x x))))
                  (s (lambda () (set! x (+ x 1)))))

sicp-streams

sicp-streams

[module] sicp-streams

Stream procedures from section 3.5

stream-null

[constant] stream-null → (quote ())

The empty stream

(define stream-null '())

the-empty-stream

[constant] the-empty-stream → stream-null

A synonym for stream-null

(define the-empty-stream stream-null)

stream-null?

[procedure] (stream-null? stream) → boolean

Is this stream null?

stream
The stream to test
(define stream-null? null?)

cons-stream

[syntax] (cons-stream a d) → stream

Constructs a stream; returns a stream whose stream-car is a and whose stream-cdr is a delayed d.

a
The address part
d
The decrement part
(define-syntax
  cons-stream
  (ir-macro-transformer
    (lambda (expression rename inject)
      (match expression ((_ a b) `(cons ,a (delay ,b)))))))

stream-ref

[procedure] (stream-ref s n) → object

Returns the nth element of the stream, consuming any non-memoized elements.

s
The stream to consume
n
The nth element
(define (stream-ref s n)
  (if (= n 0) (stream-car s) (stream-ref (stream-cdr s) (- n 1))))

stream-map

[procedure] (stream-map proc s) → stream

Constructs a stream which is a proc-mapped s.

proc
The procedure to apply
s
The stream to apply to
(define (stream-map proc s)
  (if (stream-null? s)
    stream-null
    (cons-stream (proc (stream-car s)) (stream-map proc (stream-cdr s)))))

stream-for-each

[procedure] (stream-for-each proc s) → unspecified

Applies proc to every element of s, consuming it.

proc
The procedure to apply
s
The stream to apply to
(define (stream-for-each proc s)
  (if (stream-null? s)
    'done
    (begin (proc (stream-car s)) (stream-for-each proc (stream-cdr s)))))

display-stream

[procedure] (display-stream s) → unspecified

Displays every element of the stream.

s
The stream to display
(define (display-stream s) (stream-for-each display-line s))

stream-car

[procedure] (stream-car stream) → object

Takes the first element of the stream.

stream
The stream to take
(define (stream-car stream) (car stream))

stream-cdr

[procedure] (stream-cdr stream) → stream

Forces and returns the cdr of the stream.

stream
The stream whose cdr to force
(define (stream-cdr stream) (force (cdr stream)))

stream-enumerate-interval

[procedure] (stream-enumerate-interval low high) → stream

Enumerates the interval between low and high streamingly.

low
The lower bound
high
The upper bound
(define (stream-enumerate-interval low high)
  (if (> low high)
    stream-null
    (cons-stream low (stream-enumerate-interval (+ low 1) high))))

stream-filter

[procedure] (stream-filter pred stream) → stream

Filters a stream, applying pred.

pred
The predicate upon which to filter.
stream
The stream to filter
(define (stream-filter pred stream)
  (cond ((stream-null? stream) stream-null)
        ((pred (stream-car stream))
         (cons-stream
           (stream-car stream)
           (stream-filter pred (stream-cdr stream))))
        (else (stream-filter pred (stream-cdr stream)))))

stream->list

[procedure] (stream->list stream) → stream

Converts a stream to a list, consuming it.

stream
The stream to convert to a list
(define (stream->list stream)
  (if (stream-null? stream)
    '()
    (cons (stream-car stream) (stream->list (stream-cdr stream)))))

About this egg

Author

Peter Danenberg

Repository

https://github.com/klutometis/sicp-chicken

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.
0.6
Add constraints, documentation.
0.7
Add concurrency.
0.7.1
Remove the dependency on setup-helper-cock.
0.7.2
Update sxml to work with `at'.
0.7.3
Drop setup-helper-cock.
0.8
Add streams.

Colophon

Documented by cock.