You are looking at historical revision 32170 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).
- =number?
- accumulate
- add
- add-action!
- add-to-agenda!
- add-vect
- addend
- adjoin-set
- after-delay
- and-gate
- and-gate-delay
- angle
- apply-generic
- attach-tag
- augend
- average
- below
- beside
- call-each
- choose-branch
- contents
- corner-split
- dec
- decode
- default-timeout
- delete-queue!
- deriv
- dispatch-table
- div
- draw-painter-as-svg
- edge1-frame
- edge2-frame
- element-of-set?
- empty-queue?
- encode
- encode-symbol
- end-segment
- enumerate-interval
- epsilon
- fast-prime?
- first-agenda-item
- flatmap
- flip-horiz
- flip-vert
- frame-coord-map
- front-ptr
- front-queue
- full-adder
- get
- get-signal
- half-adder
- huffman-adjoin-set
- image->painter
- image-frame
- image-height
- image-width
- imag-part
- inc
- insert-queue!
- install-complex-package
- install-polar-package
- install-rational-package
- install-rectangular-package
- install-scheme-number-package
- intersection-set
- inverter
- inverter-delay
- good-enough?
- leaf?
- left-branch
- logical-not
- magnitude
- make-agenda
- make-code-tree
- make-complex-from-mag-ang
- make-complex-from-real-imag
- make-from-mag-ang
- make-from-real-imag
- make-frame
- make-leaf
- make-leaf-set
- make-product
- make-queue
- make-rational
- make-scheme-number
- make-sum
- make-segment
- make-vect
- make-wire
- mul
- multiplicand
- multiplier
- nil
- or-gate
- or-gate-delay
- origin-frame
- outline
- prime?
- probe
- product?
- propagate
- put
- real-part
- rear-ptr
- remove-first-agenda-item!
- right-branch
- right-split
- rotate90
- rotate180
- rotate270
- same-variable?
- scale-vect
- segments->painter
- set-front-ptr!
- set-rear-ptr!
- set-signal!
- shrink-to-upper-right
- square
- square-limit
- start-segment
- sub
- sub-vect
- sum?
- symbol-leaf
- symbols
- terminates?
- the-agenda
- timeout-value?
- transform-painter
- type-tag
- up-split
- variable?
- weight
- weight-leaf
- write-painter-to-svg
- write-painter-to-png
- xcor-vect
- xor
- ycor-vect
sicp-constraints
sicp-constraints
[module] sicp-constraints
Constraint satisfaction from section 3.3.5
- adder
- connect
- constant
- for-each-except
- forget-value!
- get-value
- has-value?
- set-value!
- inform-about-no-value
- inform-about-value
- make-connector
- multiplier
- probe
has-value?
[procedure] (has-value? connector) → booleanDoes this connector have a value?
- connector
- The connector to test
(define (has-value? connector) (connector 'has-value?))
get-value
[procedure] (get-value connector) → objectGets this connector's value.
- connector
- The connector to test
(define (get-value connector) (connector 'value))
set-value!
[procedure] (set-value! connector new-value informant) → unspecifiedSets 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) → unspecifiedForgets this connector's value.
- connector
- The connector to forget
(define (forget-value! connector retractor) ((connector 'forget) retractor))
connect
[procedure] (connect connector new-constraint) → unspecifiedConnects 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) → unspecifiedInforms 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) → unspecifiedInforms 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) → constraintA 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) → constraintA 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) → constraintA 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) → constraintProbes 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) → connectorMakes 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) → unspecifiedApplies 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) → threadCreates 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) → thunkExecutes 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) → procedureCreates 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.
(let ((s (make-serializer)) (x 10)) (parallel-execute (s (lambda () (set! x (* x x)))) (s (lambda () (set! x (+ x 1)))))) => #<procedure (f_126)>
sicp-streams
sicp-streams
[module] sicp-streams
Stream procedures from section 3.5
- accelerated-sequence
- cons-stream
- display-line
- display-stream
- euler-transform
- integers
- make-tableau
- scale-stream
- stream-car
- stream-cdr
- stream-enumerate-interval
- stream-filter
- stream-for-each
- stream->list
- stream-map
- stream-null
- stream-null?
- stream-ref
- the-empty-stream
stream-null
[constant] stream-null → (quote ())The empty stream
(define stream-null '())
the-empty-stream
[constant] the-empty-stream → stream-nullA synonym for stream-null
(define the-empty-stream stream-null)
stream-null?
[procedure] (stream-null? stream) → booleanIs this stream null?
- stream
- The stream to test
(define stream-null? null?)
cons-stream
[syntax] (cons-stream a d) → streamConstructs 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) → objectReturns 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) → streamConstructs 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) → unspecifiedApplies 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) → unspecifiedDisplays 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) → objectTakes the first element of the stream.
- stream
- The stream to take
(define (stream-car stream) (car stream))
stream-cdr
[procedure] (stream-cdr stream) → streamForces 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) → streamEnumerates 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) → streamFilters 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[procedure] (stream->list stream n) → stream
Converts a stream to a list, consuming it (or up to n elements).
- stream
- The stream to convert to a list
- n
- Optionally, the maximum number of elements to consume; otherwise: all elements
(define stream->list
(case-lambda
((stream) (stream->list stream +inf.0))
((stream n)
(if (or (stream-null? stream) (zero? n))
'()
(cons (stream-car stream)
(stream->list (stream-cdr stream) (- n 1)))))))
scale-stream
[procedure] (scale-stream stream factor) → streamScales the stream by a constant factor.
- stream
- The stream to scale
- factor
- The factor by which to scale it
(define (scale-stream stream factor)
(stream-map (lambda (x) (* x factor)) stream))
euler-transform
[procedure] (euler-transform s) → streamApplies Euler's transform, i.e. a linear sequence transformation for improved convergence, to a stream.
- s
- The stream to which to apply Euler's transform
(define (euler-transform s)
(let ((s0 (stream-ref s 0)) (s1 (stream-ref s 1)) (s2 (stream-ref s 2)))
(cons-stream
(- s2 (/ (square (- s2 s1)) (+ s0 (* -2 s1) s2)))
(euler-transform (stream-cdr s)))))
make-tableau
[procedure] (make-tableau transform s) → streamMakes a tableau (i.e., a stream of streams) compounded from some transformation.
- transform
- The compounding transformation
- s
- The stream to transformatively compound
(define (make-tableau transform s)
(cons-stream s (make-tableau transform (transform s))))
accelerated-sequence
[procedure] (accelerated-sequence transform s) → streamAccelerates some converging sequence.
- transform
- The transformation to apply
- s
- The sequence to accelerate, e.g. euler-transform
(define (accelerated-sequence transform s)
(stream-map stream-car (make-tableau transform s)))
integers-starting-from
[procedure] (integers-starting-from n) → unspecifiedEnumerates the integers starting from n streamingly.
- n
- The number to start from
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
integers
[constant] integers → (integers-starting-from 1)Enumerates the positive integers streamingly.
(define integers (integers-starting-from 1))
About this egg
Author
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.
- 0.8.1
- Use match instead of match-let.
- 0.8.2
- Add a limit to stream-consumption on stream->list.
- 0.8.3
- Use +inf.0 instead of +inf.
- 0.8.4
- Evaluate examples; update docs.
- 0.8.5
- Add scale-stream.
- 0.8.6
- Add accelerated sequences.
Colophon
Documented by cock.