You are looking at historical revision 31930 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) → objectGet this connector's value.
- connector
- The connector to test
(define (get-value connector) (connector 'value))
set-value!
[procedure] (set-value! connector new-value informant) → unspecifiedSet 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) → unspecifiedForget this connector's value.
- connector
- The connector to forget
(define (forget-value! connector retractor) ((connector 'forget) retractor))
connect
[procedure] (connect connector new-constraint) → unspecifiedConnect 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) → unspecifiedInform 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) → unspecifiedInform 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) → constraintProbe 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) → connectorMake 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) → unspecifiedApply 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) → threadCreate 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) → thunkExecute 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) → objectEvaluate the thunk having locked the mutex, unlocking it thereafter.
- mutex
- The mutex to lock and unlock
- thunk
- The thunk to evaluate
(define (with-mutex-locked mutex thunk)
(dynamic-wind
(lambda () (mutex-lock! mutex))
thunk
(lambda () (mutex-unlock! mutex))))
make-serializer
[procedure] (make-serializer) → procedureCreate 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)))))
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.
Colophon
Documented by cock.