((section 2 "Outdated egg!" (p "This is an egg for CHICKEN 4, the unsupported old release.  You're almost certainly looking for " (int-link "/eggref/5/sicp" "the CHICKEN 5 version of this egg") ", if it exists.") (p "If it does not exist, there may be equivalent functionality provided by another egg; have a look at the " (link "https://wiki.call-cc.org/chicken-projects/egg-index-5.html" "egg index") ". Otherwise, please consider porting this egg to the current version of CHICKEN.")) (section 2 "sicp" (p "Support for SICP") (toc) (section 3 "SICP" (section 4 (tt "sicp") (p (b "[module]") " " (tt "sicp")) (p "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).") (ul (li (int-link "#=number?" "=number?")) (li (int-link "#accumulate" "accumulate")) (li (int-link "#add" "add")) (li (int-link "#add-action!" "add-action!")) (li (int-link "#add-to-agenda!" "add-to-agenda!")) (li (int-link "#add-vect" "add-vect")) (li (int-link "#addend" "addend")) (li (int-link "#adjoin-set" "adjoin-set")) (li (int-link "#after-delay" "after-delay")) (li (int-link "#and-gate" "and-gate")) (li (int-link "#and-gate-delay" "and-gate-delay")) (li (int-link "#angle" "angle")) (li (int-link "#apply-generic" "apply-generic")) (li (int-link "#attach-tag" "attach-tag")) (li (int-link "#augend" "augend")) (li (int-link "#average" "average")) (li (int-link "#below" "below")) (li (int-link "#beside" "beside")) (li (int-link "#call-each" "call-each")) (li (int-link "#choose-branch" "choose-branch")) (li (int-link "#contents" "contents")) (li (int-link "#corner-split" "corner-split")) (li (int-link "#dec" "dec")) (li (int-link "#decode" "decode")) (li (int-link "#default-timeout" "default-timeout")) (li (int-link "#delete-queue!" "delete-queue!")) (li (int-link "#deriv" "deriv")) (li (int-link "#dispatch-table" "dispatch-table")) (li (int-link "#div" "div")) (li (int-link "#draw-painter-as-svg" "draw-painter-as-svg")) (li (int-link "#edge1-frame" "edge1-frame")) (li (int-link "#edge2-frame" "edge2-frame")) (li (int-link "#element-of-set?" "element-of-set?")) (li (int-link "#empty-queue?" "empty-queue?")) (li (int-link "#encode" "encode")) (li (int-link "#encode-symbol" "encode-symbol")) (li (int-link "#end-segment" "end-segment")) (li (int-link "#enumerate-interval" "enumerate-interval")) (li (int-link "#epsilon" "epsilon")) (li (int-link "#fast-prime?" "fast-prime?")) (li (int-link "#first-agenda-item" "first-agenda-item")) (li (int-link "#flatmap" "flatmap")) (li (int-link "#flip-horiz" "flip-horiz")) (li (int-link "#flip-vert" "flip-vert")) (li (int-link "#frame-coord-map" "frame-coord-map")) (li (int-link "#front-ptr" "front-ptr")) (li (int-link "#front-queue" "front-queue")) (li (int-link "#full-adder" "full-adder")) (li (int-link "#get" "get")) (li (int-link "#get-signal" "get-signal")) (li (int-link "#half-adder" "half-adder")) (li (int-link "#huffman-adjoin-set" "huffman-adjoin-set")) (li (int-link "#image->painter" "image->painter")) (li (int-link "#image-frame" "image-frame")) (li (int-link "#image-height" "image-height")) (li (int-link "#image-width" "image-width")) (li (int-link "#imag-part" "imag-part")) (li (int-link "#inc" "inc")) (li (int-link "#insert-queue!" "insert-queue!")) (li (int-link "#install-complex-package" "install-complex-package")) (li (int-link "#install-polar-package" "install-polar-package")) (li (int-link "#install-rational-package" "install-rational-package")) (li (int-link "#install-rectangular-package" "install-rectangular-package")) (li (int-link "#install-scheme-number-package" "install-scheme-number-package")) (li (int-link "#intersection-set" "intersection-set")) (li (int-link "#inverter" "inverter")) (li (int-link "#inverter-delay" "inverter-delay")) (li (int-link "#good-enough?" "good-enough?")) (li (int-link "#leaf?" "leaf?")) (li (int-link "#left-branch" "left-branch")) (li (int-link "#logical-not" "logical-not")) (li (int-link "#magnitude" "magnitude")) (li (int-link "#make-agenda" "make-agenda")) (li (int-link "#make-code-tree" "make-code-tree")) (li (int-link "#make-complex-from-mag-ang" "make-complex-from-mag-ang")) (li (int-link "#make-complex-from-real-imag" "make-complex-from-real-imag")) (li (int-link "#make-from-mag-ang" "make-from-mag-ang")) (li (int-link "#make-from-real-imag" "make-from-real-imag")) (li (int-link "#make-frame" "make-frame")) (li (int-link "#make-leaf" "make-leaf")) (li (int-link "#make-leaf-set" "make-leaf-set")) (li (int-link "#make-product" "make-product")) (li (int-link "#make-queue" "make-queue")) (li (int-link "#make-rational" "make-rational")) (li (int-link "#make-scheme-number" "make-scheme-number")) (li (int-link "#make-sum" "make-sum")) (li (int-link "#make-segment" "make-segment")) (li (int-link "#make-vect" "make-vect")) (li (int-link "#make-wire" "make-wire")) (li (int-link "#mul" "mul")) (li (int-link "#multiplicand" "multiplicand")) (li (int-link "#multiplier" "multiplier")) (li (int-link "#nil" "nil")) (li (int-link "#or-gate" "or-gate")) (li (int-link "#or-gate-delay" "or-gate-delay")) (li (int-link "#origin-frame" "origin-frame")) (li (int-link "#outline" "outline")) (li (int-link "#prime?" "prime?")) (li (int-link "#probe" "probe")) (li (int-link "#product?" "product?")) (li (int-link "#propagate" "propagate")) (li (int-link "#put" "put")) (li (int-link "#real-part" "real-part")) (li (int-link "#rear-ptr" "rear-ptr")) (li (int-link "#remove-first-agenda-item!" "remove-first-agenda-item!")) (li (int-link "#right-branch" "right-branch")) (li (int-link "#right-split" "right-split")) (li (int-link "#rotate90" "rotate90")) (li (int-link "#rotate180" "rotate180")) (li (int-link "#rotate270" "rotate270")) (li (int-link "#same-variable?" "same-variable?")) (li (int-link "#scale-vect" "scale-vect")) (li (int-link "#segments->painter" "segments->painter")) (li (int-link "#set-front-ptr!" "set-front-ptr!")) (li (int-link "#set-rear-ptr!" "set-rear-ptr!")) (li (int-link "#set-signal!" "set-signal!")) (li (int-link "#shrink-to-upper-right" "shrink-to-upper-right")) (li (int-link "#square" "square")) (li (int-link "#square-limit" "square-limit")) (li (int-link "#start-segment" "start-segment")) (li (int-link "#sub" "sub")) (li (int-link "#sub-vect" "sub-vect")) (li (int-link "#sum?" "sum?")) (li (int-link "#symbol-leaf" "symbol-leaf")) (li (int-link "#symbols" "symbols")) (li (int-link "#terminates?" "terminates?")) (li (int-link "#the-agenda" "the-agenda")) (li (int-link "#time+values" "time+values")) (li (int-link "#timeout-value?" "timeout-value?")) (li (int-link "#transform-painter" "transform-painter")) (li (int-link "#type-tag" "type-tag")) (li (int-link "#up-split" "up-split")) (li (int-link "#variable?" "variable?")) (li (int-link "#weight" "weight")) (li (int-link "#weight-leaf" "weight-leaf")) (li (int-link "#write-painter-to-svg" "write-painter-to-svg")) (li (int-link "#write-painter-to-png" "write-painter-to-png")) (li (int-link "#xcor-vect" "xcor-vect")) (li (int-link "#xor" "xor")) (li (int-link "#ycor-vect" "ycor-vect"))))) (section 3 "sicp-constraints" (section 4 (tt "sicp-constraints") (p (b "[module]") " " (tt "sicp-constraints")) (p "Constraint satisfaction from section 3.3.5") (ul (li (int-link "#adder" "adder")) (li (int-link "#connect" "connect")) (li (int-link "#constant" "constant")) (li (int-link "#for-each-except" "for-each-except")) (li (int-link "#forget-value!" "forget-value!")) (li (int-link "#get-value" "get-value")) (li (int-link "#has-value?" "has-value?")) (li (int-link "#set-value!" "set-value!")) (li (int-link "#inform-about-no-value" "inform-about-no-value")) (li (int-link "#inform-about-value" "inform-about-value")) (li (int-link "#make-connector" "make-connector")) (li (int-link "#multiplier" "multiplier")) (li (int-link "#probe" "probe")))) (section 4 (tt "has-value?") (def (sig (procedure "(has-value? connector) → boolean" (id has-value?))) (p "Does this connector have a value?") (dl (dt (tt "connector")) (dd "The connector to test")) (highlight scheme "(define (has-value? connector) (connector 'has-value?))"))) (section 4 (tt "get-value") (def (sig (procedure "(get-value connector) → object" (id get-value))) (p "Gets this connector's value.") (dl (dt (tt "connector")) (dd "The connector to test")) (highlight scheme "(define (get-value connector) (connector 'value))"))) (section 4 (tt "set-value!") (def (sig (procedure "(set-value! connector new-value informant) → unspecified" (id set-value!))) (p "Sets this connector's value.") (dl (dt (tt "connector")) (dd "The connector to set")) (highlight scheme "(define (set-value! connector new-value informant)\n  ((connector 'set-value!) new-value informant))"))) (section 4 (tt "forget-value!") (def (sig (procedure "(forget-value! connector retractor) → unspecified" (id forget-value!))) (p "Forgets this connector's value.") (dl (dt (tt "connector")) (dd "The connector to forget")) (highlight scheme "(define (forget-value! connector retractor) ((connector 'forget) retractor))"))) (section 4 (tt "connect") (def (sig (procedure "(connect connector new-constraint) → unspecified" (id connect))) (p "Connects a connector to a new constraint.") (dl (dt (tt "connector")) (dd "The connector to connect") (dt (tt "new-constraint")) (dd "The constraint to add")) (highlight scheme "(define (connect connector new-constraint)\n  ((connector 'connect) new-constraint))"))) (section 4 (tt "inform-about-value") (def (sig (procedure "(inform-about-value constraint) → unspecified" (id inform-about-value))) (p "Informs the constraint about a new value") (dl (dt (tt "constraint")) (dd "The constraint to inform")) (highlight scheme "(define (inform-about-value constraint) (constraint 'I-have-a-value))"))) (section 4 (tt "inform-about-no-value") (def (sig (procedure "(inform-about-no-value constraint) → unspecified" (id inform-about-no-value))) (p "Informs the constraint about forgetting.") (dl (dt (tt "constraint")) (dd "The consraint to inform")) (highlight scheme "(define (inform-about-no-value constraint) (constraint 'I-lost-my-value))"))) (section 4 (tt "adder") (def (sig (procedure "(adder a1 a2 sum) → constraint" (id adder))) (p "A constraint that adds two numbers") (dl (dt (tt "a1")) (dd "Addend") (dt (tt "a2")) (dd "Augend") (dt (tt "sum")) (dd "Sum")) (highlight scheme "(define (adder a1 a2 sum)\n  (define (process-new-value)\n    (cond ((and (has-value? a1) (has-value? a2))\n           (set-value! sum (+ (get-value a1) (get-value a2)) me))\n          ((and (has-value? a1) (has-value? sum))\n           (set-value! a2 (- (get-value sum) (get-value a1)) me))\n          ((and (has-value? a2) (has-value? sum))\n           (set-value! a1 (- (get-value sum) (get-value a2)) me))))\n  (define (process-forget-value)\n    (forget-value! sum me)\n    (forget-value! a1 me)\n    (forget-value! a2 me)\n    (process-new-value))\n  (define (me request)\n    (case request\n      ((I-have-a-value) (process-new-value))\n      ((I-lost-my-value) (process-forget-value))\n      (else (error \"Unknown request: ADDER\" request))))\n  (connect a1 me)\n  (connect a2 me)\n  (connect sum me)\n  me)"))) (section 4 (tt "multiplier") (def (sig (procedure "(multiplier m1 m2 product) → constraint" (id multiplier))) (p "A constraint that multiplies two numbers") (dl (dt (tt "a1")) (dd "Multiplier") (dt (tt "a2")) (dd "Multiplicand") (dt (tt "sum")) (dd "Product")) (highlight scheme "(define (multiplier m1 m2 product)\n  (define (process-new-value)\n    (cond ((or (and (has-value? m1) (= (get-value m1) 0))\n               (and (has-value? m2) (= (get-value m2) 0)))\n           (set-value! product 0 me))\n          ((and (has-value? m1) (has-value? m2))\n           (set-value! product (* (get-value m1) (get-value m2)) me))\n          ((and (has-value? product) (has-value? m1))\n           (set-value! m2 (/ (get-value product) (get-value m1)) me))\n          ((and (has-value? product) (has-value? m2))\n           (set-value! m1 (/ (get-value product) (get-value m2)) me))))\n  (define (process-forget-value)\n    (forget-value! product me)\n    (forget-value! m1 me)\n    (forget-value! m2 me)\n    (process-new-value))\n  (define (me request)\n    (case request\n      ((I-have-a-value) (process-new-value))\n      ((I-lost-my-value) (process-forget-value))\n      (else (error \"Unknown request: MULTIPLIER\" request))))\n  (connect m1 me)\n  (connect m2 me)\n  (connect product me)\n  me)"))) (section 4 (tt "constant") (def (sig (procedure "(constant value connector) → constraint" (id constant))) (p "A constant constraint") (dl (dt (tt "value")) (dd "The value to constantly be") (dt (tt "connector")) (dd "The relevant connector")) (highlight scheme "(define (constant value connector)\n  (define (me request) (error \"Unknown request: CONSTANT\" request))\n  (connect connector me)\n  (set-value! connector value me)\n  me)"))) (section 4 (tt "probe") (def (sig (procedure "(probe name connector) → constraint" (id probe))) (p "Probes a connector and informs upon value-change.") (dl (dt (tt "name")) (dd "Name of the connector") (dt (tt "connector")) (dd "The connector to probe")) (highlight scheme "(define (probe name connector)\n  (define (print-probe value) (format #t \"Probe: ~a = ~a~%\" name value))\n  (define (process-new-value) (print-probe (get-value connector)))\n  (define (process-forget-value) (print-probe \"?\"))\n  (define (me request)\n    (case request\n      ((I-have-a-value) (process-new-value))\n      ((I-lost-my-value) (process-forget-value))\n      (else (error \"Unknown request: PROBE\" request))))\n  (connect connector me)\n  me)"))) (section 4 (tt "make-connector") (def (sig (procedure "(make-connector) → connector" (id make-connector))) (p "Makes a connector.") (highlight scheme "(define (make-connector)\n  (let ((value #f) (informant #f) (constraints '()))\n    (define (set-my-value newval setter)\n      (cond ((not (has-value? me))\n             (set! value newval)\n             (set! informant setter)\n             (for-each-except setter inform-about-value constraints))\n            ((not (= value newval))\n             (error \"Contradiction\" (list value newval)))\n            (else 'ignored)))\n    (define (forget-my-value retractor)\n      (if (eq? retractor informant)\n        (begin\n          (set! informant #f)\n          (for-each-except retractor inform-about-no-value constraints))\n        'ignored))\n    (define (connect new-constraint)\n      (if (not (memq new-constraint constraints))\n        (set! constraints (cons new-constraint constraints)))\n      (if (has-value? me) (inform-about-value new-constraint))\n      'done)\n    (define (me request)\n      (case request\n        ((has-value?) (and informant #t))\n        ((value) value)\n        ((set-value!) set-my-value)\n        ((forget) forget-my-value)\n        ((connect) connect)\n        (else (error \"Unknown operation: CONNECTOR\" request))))\n    me))"))) (section 4 (tt "for-each-except") (def (sig (procedure "(for-each-except exception procedure list) → unspecified" (id for-each-except))) (p "Applies a procedure to every item in " (i "list") " except ones " (tt "eq?") " to " (i "exception") ".") (dl (dt (tt "exception")) (dd "An element not to apply " (i "procedure") " to") (dt (tt "procedure")) (dd "The procedure to apply") (dt (tt "list")) (dd "The list to iterate over")) (highlight scheme "(define (for-each-except exception procedure list)\n  (define (loop items)\n    (cond ((null? items) 'done)\n          ((eq? (car items) exception) (loop (cdr items)))\n          (else (procedure (car items)) (loop (cdr items)))))\n  (loop list))")))) (section 3 "sicp-concurrency" (section 4 (tt "sicp-concurrency") (p (b "[module]") " " (tt "sicp-concurrency")) (p "Concurrency procedures from section 3.4") (ul (li (int-link "#make-serializer" "make-serializer")) (li (int-link "#parallel-execute" "parallel-execute")) (li (int-link "#with-mutex-locked" "with-mutex-locked")))) (section 4 (tt "thunk->thread") (def (sig (procedure "(thunk->thread thunk) → thread" (id thunk->thread))) (p "Creates a thread from " (tt "thunk") " and start the thread.") (dl (dt (tt "thunk")) (dd "The thunk to threadify")) (highlight scheme "(define (thunk->thread thunk)\n  (let ((thread (make-thread thunk))) (thread-start! thread) thread))"))) (section 4 (tt "parallel-execute") (def (sig (procedure "(parallel-execute . thunks) → thunk" (id parallel-execute))) (p "Executes thunks in parallel; returns a thunk which can be executed to terminate the threads.") (dl (dt (tt "thunks")) (dd "The thunks to execute in parallel")) (highlight scheme "(define (parallel-execute . thunks)\n  (let ((threads (map thunk->thread thunks)))\n    (lambda () (for-each thread-terminate! threads))))"))) (section 4 (tt "with-mutex-locked") (def (sig (procedure "(with-mutex-locked mutex thunk) → object" (id with-mutex-locked)) (procedure "(with-mutex-locked mutex thunk conditional-variable) → object" (id with-mutex-locked))) (p "Evaluates the thunk having locked the mutex, unlocking it thereafter.") (dl (dt (tt "mutex")) (dd "The mutex to lock and unlock") (dt (tt "thunk")) (dd "The thunk to evaluate") (dt (tt "conditional-variable")) (dd "An optional conditional-variable to block on at unlock")) (highlight scheme "(define with-mutex-locked\n  (case-lambda\n    ((mutex thunk) (with-mutex-locked mutex thunk #f))\n    ((mutex thunk conditional-variable)\n     (dynamic-wind\n       (lambda () (mutex-lock! mutex))\n       thunk\n       (lambda () (mutex-unlock! mutex conditional-variable))))))"))) (section 4 (tt "make-serializer") (def (sig (procedure "(make-serializer) → procedure" (id make-serializer))) (p "Creates a serializer which returns serialized procedures in a common set; returns a procedure taking " (tt "f") ", the procedure to serialize.") (highlight scheme "(define (make-serializer)\n  (let ((mutex (make-mutex)))\n    (lambda (f)\n      (lambda args (with-mutex-locked mutex (lambda () (apply f args)))))))")) (section 5 "Examples" (p "Create a serializer and run some thunks.") (pre "(let ((s (make-serializer)) (x 10))\n  (parallel-execute (s (lambda () (set! x (* x x))))\n                    (s (lambda () (set! x (+ x 1))))))\n => #<procedure (f_307)>\n")))) (section 3 "sicp-streams" (section 4 (tt "sicp-streams") (p (b "[module]") " " (tt "sicp-streams")) (p "Stream procedures from section 3.5") (ul (li (int-link "#accelerated-sequence" "accelerated-sequence")) (li (int-link "#cons-stream" "cons-stream")) (li (int-link "#display-line" "display-line")) (li (int-link "#display-stream" "display-stream")) (li (int-link "#euler-transform" "euler-transform")) (li (int-link "#integers" "integers")) (li (int-link "#interleave" "interleave")) (li (int-link "#list->stream" "list->stream")) (li (int-link "#make-tableau" "make-tableau")) (li (int-link "#merge" "merge")) (li (int-link "#pairs" "pairs")) (li (int-link "#scale-stream" "scale-stream")) (li (int-link "#stream-car" "stream-car")) (li (int-link "#stream-cdr" "stream-cdr")) (li (int-link "#stream-enumerate-interval" "stream-enumerate-interval")) (li (int-link "#stream-filter" "stream-filter")) (li (int-link "#stream-for-each" "stream-for-each")) (li (int-link "#stream->list" "stream->list")) (li (int-link "#stream-map" "stream-map")) (li (int-link "#stream-null" "stream-null")) (li (int-link "#stream-null?" "stream-null?")) (li (int-link "#stream-ref" "stream-ref")) (li (int-link "#the-empty-stream" "the-empty-stream")))) (section 4 (tt "stream-null") (def (sig (constant "stream-null → (quote ())" (id stream-null))) (p "The empty stream") (highlight scheme "(define stream-null '())"))) (section 4 (tt "the-empty-stream") (def (sig (constant "the-empty-stream → stream-null" (id the-empty-stream))) (p "A synonym for " (tt "stream-null")) (highlight scheme "(define the-empty-stream stream-null)"))) (section 4 (tt "stream-null?") (def (sig (procedure "(stream-null? stream) → boolean" (id stream-null?))) (p "Is this stream null?") (dl (dt (tt "stream")) (dd "The stream to test")) (highlight scheme "(define stream-null? null?)"))) (section 4 (tt "cons-stream") (def (sig (syntax "(cons-stream a d) → stream" (id cons-stream))) (p "Constructs a stream; returns a stream whose " (tt "stream-car") " is " (tt "a") " and whose " (tt "stream-cdr") " is a delayed " (tt "d") ".") (dl (dt (tt "a")) (dd "The address part") (dt (tt "d")) (dd "The decrement part")) (highlight scheme "(define-syntax\n  cons-stream\n  (ir-macro-transformer\n    (lambda (expression rename inject)\n      (match expression ((_ a b) `(cons ,a (delay ,b)))))))"))) (section 4 (tt "stream-ref") (def (sig (procedure "(stream-ref s n) → object" (id stream-ref))) (p "Returns the nth element of the stream, consuming any non-memoized elements.") (dl (dt (tt "s")) (dd "The stream to consume") (dt (tt "n")) (dd "The nth element")) (highlight scheme "(define (stream-ref s n)\n  (if (= n 0) (stream-car s) (stream-ref (stream-cdr s) (- n 1))))"))) (section 4 (tt "stream-map") (def (sig (procedure "(stream-map proc s) → stream" (id stream-map))) (p "Constructs a stream which is a " (tt "proc") "-mapped " (tt "s") ".") (dl (dt (tt "proc")) (dd "The procedure to apply") (dt (tt "s")) (dd "The stream to apply to")) (highlight scheme "(define (stream-map proc s)\n  (if (stream-null? s)\n    stream-null\n    (cons-stream (proc (stream-car s)) (stream-map proc (stream-cdr s)))))"))) (section 4 (tt "stream-for-each") (def (sig (procedure "(stream-for-each proc s) → unspecified" (id stream-for-each))) (p "Applies " (tt "proc") " to every element of " (tt "s") ", consuming it.") (dl (dt (tt "proc")) (dd "The procedure to apply") (dt (tt "s")) (dd "The stream to apply to")) (highlight scheme "(define (stream-for-each proc s)\n  (if (stream-null? s)\n    'done\n    (begin (proc (stream-car s)) (stream-for-each proc (stream-cdr s)))))"))) (section 4 (tt "display-stream") (def (sig (procedure "(display-stream s) → unspecified" (id display-stream))) (p "Displays every element of the stream.") (dl (dt (tt "s")) (dd "The stream to display")) (highlight scheme "(define (display-stream s) (stream-for-each display-line s))"))) (section 4 (tt "stream-car") (def (sig (procedure "(stream-car stream) → object" (id stream-car))) (p "Takes the first element of the stream.") (dl (dt (tt "stream")) (dd "The stream to take")) (highlight scheme "(define (stream-car stream) (car stream))"))) (section 4 (tt "stream-cdr") (def (sig (procedure "(stream-cdr stream) → stream" (id stream-cdr))) (p "Forces and returns the cdr of the stream.") (dl (dt (tt "stream")) (dd "The stream whose cdr to force")) (highlight scheme "(define (stream-cdr stream) (force (cdr stream)))"))) (section 4 (tt "stream-enumerate-interval") (def (sig (procedure "(stream-enumerate-interval low high) → stream" (id stream-enumerate-interval))) (p "Enumerates the interval between " (tt "low") " and " (tt "high") " streamingly.") (dl (dt (tt "low")) (dd "The lower bound") (dt (tt "high")) (dd "The upper bound")) (highlight scheme "(define (stream-enumerate-interval low high)\n  (if (> low high)\n    stream-null\n    (cons-stream low (stream-enumerate-interval (+ low 1) high))))"))) (section 4 (tt "stream-filter") (def (sig (procedure "(stream-filter pred stream) → stream" (id stream-filter))) (p "Filters a stream, applying " (tt "pred") ".") (dl (dt (tt "pred")) (dd "The predicate upon which to filter.") (dt (tt "stream")) (dd "The stream to filter")) (highlight scheme "(define (stream-filter pred stream)\n  (cond ((stream-null? stream) stream-null)\n        ((pred (stream-car stream))\n         (cons-stream\n           (stream-car stream)\n           (stream-filter pred (stream-cdr stream))))\n        (else (stream-filter pred (stream-cdr stream)))))"))) (section 4 (tt "stream->list") (def (sig (procedure "(stream->list stream) → stream" (id stream->list)) (procedure "(stream->list stream n) → stream" (id stream->list))) (p "Converts a stream to a list, consuming it (or up to n elements).") (dl (dt (tt "stream")) (dd "The stream to convert to a list") (dt (tt "n")) (dd "Optionally, the maximum number of elements to consume; otherwise: all elements")) (highlight scheme "(define stream->list\n  (case-lambda\n    ((stream) (stream->list stream +inf.0))\n    ((stream n)\n     (if (or (stream-null? stream) (zero? n))\n       '()\n       (cons (stream-car stream)\n             (stream->list (stream-cdr stream) (- n 1)))))))"))) (section 4 (tt "scale-stream") (def (sig (procedure "(scale-stream stream factor) → stream" (id scale-stream))) (p "Scales the stream by a constant factor.") (dl (dt (tt "stream")) (dd "The stream to scale") (dt (tt "factor")) (dd "The factor by which to scale it")) (highlight scheme "(define (scale-stream stream factor)\n  (stream-map (lambda (x) (* x factor)) stream))"))) (section 4 (tt "euler-transform") (def (sig (procedure "(euler-transform s) → stream" (id euler-transform))) (p "Applies " (link "http://en.wikipedia.org/wiki/Series_acceleration#Euler.27s_transform" "Euler's transform") ", i.e. a linear sequence transformation for improved convergence, to a stream.") (dl (dt (tt "s")) (dd "The stream to which to apply Euler's transform")) (highlight scheme "(define (euler-transform s)\n  (let ((s0 (stream-ref s 0)) (s1 (stream-ref s 1)) (s2 (stream-ref s 2)))\n    (cons-stream\n      (- s2 (/ (square (- s2 s1)) (+ s0 (* -2 s1) s2)))\n      (euler-transform (stream-cdr s)))))"))) (section 4 (tt "make-tableau") (def (sig (procedure "(make-tableau transform s) → stream" (id make-tableau))) (p "Makes a tableau (i.e., a stream of streams) compounded from some transformation.") (dl (dt (tt "transform")) (dd "The compounding transformation") (dt (tt "s")) (dd "The stream to transformatively compound")) (highlight scheme "(define (make-tableau transform s)\n  (cons-stream s (make-tableau transform (transform s))))"))) (section 4 (tt "accelerated-sequence") (def (sig (procedure "(accelerated-sequence transform s) → stream" (id accelerated-sequence))) (p "Accelerates some converging sequence.") (dl (dt (tt "transform")) (dd "The transformation to apply") (dt (tt "s")) (dd "The sequence to accelerate, e.g. " (int-link "euler-transform"))) (highlight scheme "(define (accelerated-sequence transform s)\n  (stream-map stream-car (make-tableau transform s)))"))) (section 4 (tt "integers-starting-from") (def (sig (procedure "(integers-starting-from n) → stream" (id integers-starting-from))) (p "Enumerates the integers starting from n streamingly.") (dl (dt (tt "n")) (dd "The number to start from")) (highlight scheme "(define (integers-starting-from n)\n  (cons-stream n (integers-starting-from (+ n 1))))"))) (section 4 (tt "integers") (def (sig (constant "integers → (integers-starting-from 1)" (id integers))) (p "Enumerates the positive integers streamingly.") (highlight scheme "(define integers (integers-starting-from 1))"))) (section 4 (tt "interleave") (def (sig (procedure "(interleave s1 s2) → stream" (id interleave))) (p "Interleaves two streams.") (dl (dt (tt "s1")) (dd "The interleavened stream") (dt (tt "s1")) (dd "The interleaving stream")) (highlight scheme "(define (interleave s1 s2)\n  (if (stream-null? s1)\n    s2\n    (cons-stream (stream-car s1) (interleave s2 (stream-cdr s1)))))"))) (section 4 (tt "pairs") (def (sig (procedure "(pairs s t) → stream" (id pairs))) (p "Generates the stream of pairs (S_i, T_j), where i <= j.") (dl (dt (tt "s")) (dd "The first stream to pair") (dt (tt "t")) (dd "The second stream to pair")) (highlight scheme "(define (pairs s t)\n  (cons-stream\n    (list (stream-car s) (stream-car t))\n    (interleave\n      (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t))\n      (pairs (stream-cdr s) (stream-cdr t)))))"))) (section 4 (tt "merge") (def (sig (procedure "(merge s1 s2) → stream" (id merge))) (p "Merges two ordered streams into one ordered result stream, eliminating repetitions.") (dl (dt (tt "s1")) (dd "Mergend") (dt (tt "s2")) (dd "Merger")) (highlight scheme "(define (merge s1 s2)\n  (cond ((stream-null? s1) s2)\n        ((stream-null? s2) s1)\n        (else\n         (let ((s1car (stream-car s1)) (s2car (stream-car s2)))\n           (cond ((< s1car s2car)\n                  (cons-stream s1car (merge (stream-cdr s1) s2)))\n                 ((> s1car s2car)\n                  (cons-stream s2car (merge s1 (stream-cdr s2))))\n                 (else\n                  (cons-stream\n                    s1car\n                    (merge (stream-cdr s1) (stream-cdr s2)))))))))"))) (section 4 (tt "list->stream") (def (sig (procedure "(list->stream list) → stream" (id list->stream))) (p "Takes a list and streamifies it.") (dl (dt (tt "list")) (dd "The list to streamify")) (highlight scheme "(define (list->stream list)\n  (if (null? list)\n    stream-null\n    (cons-stream (car list) (list->stream (cdr list)))))")))) (section 3 "sicp-eval" (section 4 (tt "sicp-eval") (p (b "[module]") " " (tt "sicp-eval")) (p "Evaluation procedures from section 4.1") (ul (li (int-link "#add-binding-to-frame!" "add-binding-to-frame!")) (li (int-link "#announce-output" "announce-output")) (li (int-link "#application?" "application?")) (li (int-link "#apply*" "apply*")) (li (int-link "#apply-primitive-procedure" "apply-primitive-procedure")) (li (int-link "#assignment?" "assignment?")) (li (int-link "#assignment-value" "assignment-value")) (li (int-link "#assignment-variable" "assignment-variable")) (li (int-link "#begin-actions" "begin-actions")) (li (int-link "#begin?" "begin?")) (li (int-link "#compound-procedure?" "compound-procedure?")) (li (int-link "#cond?" "cond?")) (li (int-link "#cond->if" "cond->if")) (li (int-link "#cond-actions" "cond-actions")) (li (int-link "#cond-clauses" "cond-clauses")) (li (int-link "#cond-else-clause?" "cond-else-clause?")) (li (int-link "#cond-predicate" "cond-predicate")) (li (int-link "#define-variable!" "define-variable!")) (li (int-link "#definition?" "definition?")) (li (int-link "#definition-variable" "definition-variable")) (li (int-link "#definition-value" "definition-value")) (li (int-link "#driver-loop" "driver-loop")) (li (int-link "#enclosing-environment" "enclosing-environment")) (li (int-link "#eval*" "eval*")) (li (int-link "#eval-assignment" "eval-assignment")) (li (int-link "#eval-definition" "eval-definition")) (li (int-link "#eval-if" "eval-if")) (li (int-link "#eval-sequence" "eval-sequence")) (li (int-link "#extend-environment" "extend-environment")) (li (int-link "#false?" "false?")) (li (int-link "#first-exp" "first-exp")) (li (int-link "#first-frame" "first-frame")) (li (int-link "#frame-values" "frame-values")) (li (int-link "#frame-variables" "frame-variables")) (li (int-link "#if?" "if?")) (li (int-link "#if-alternative" "if-alternative")) (li (int-link "#if-consequent" "if-consequent")) (li (int-link "#if-predicate" "if-predicate")) (li (int-link "#first-operand" "first-operand")) (li (int-link "#lambda?" "lambda?")) (li (int-link "#lambda-body" "lambda-body")) (li (int-link "#lambda-parameters" "lambda-parameters")) (li (int-link "#last-exp?" "last-exp?")) (li (int-link "#list-of-values" "list-of-values")) (li (int-link "#lookup-variable-value" "lookup-variable-value")) (li (int-link "#make-if" "make-if")) (li (int-link "#make-frame" "make-frame")) (li (int-link "#make-lambda" "make-lambda")) (li (int-link "#make-procedure" "make-procedure")) (li (int-link "#no-operands?" "no-operands?")) (li (int-link "#operands" "operands")) (li (int-link "#operator" "operator")) (li (int-link "#primitive-procedure?" "primitive-procedure?")) (li (int-link "#primitive-procedures" "primitive-procedures")) (li (int-link "#procedure-body" "procedure-body")) (li (int-link "#procedure-environment" "procedure-environment")) (li (int-link "#procedure-parameters" "procedure-parameters")) (li (int-link "#prompt-for-input" "prompt-for-input")) (li (int-link "#quoted?" "quoted?")) (li (int-link "#rest-exps" "rest-exps")) (li (int-link "#rest-operands" "rest-operands")) (li (int-link "#self-evaluating?" "self-evaluating?")) (li (int-link "#sequence->exp" "sequence->exp")) (li (int-link "#set-variable-value!" "set-variable-value!")) (li (int-link "#setup-environment" "setup-environment")) (li (int-link "#tagged-list?" "tagged-list?")) (li (int-link "#text-of-quotation" "text-of-quotation")) (li (int-link "#the-empty-environment" "the-empty-environment")) (li (int-link "#the-global-environment" "the-global-environment")) (li (int-link "#true?" "true?")) (li (int-link "#user-print" "user-print")) (li (int-link "#variable?" "variable?")) (li (int-link "#with-primitive-procedures" "with-primitive-procedures")))) (section 4 (tt "apply*") (def (sig (procedure "(apply* procedure arguments) → object" (id apply*))) (p "The SICP definition of " (tt "apply") "; had to rename it " (tt "apply*") ", because the redefinition of " (tt "apply") " wrought havok on the module-system.") (dl (dt (tt "procedure")) (dd "The procedure to apply") (dt (tt "arguments")) (dd "The arguments to which to apply it")) (highlight scheme "(define (apply* procedure arguments)\n  (cond ((primitive-procedure? procedure)\n         (apply-primitive-procedure procedure arguments))\n        ((compound-procedure? procedure)\n         (eval-sequence\n           (procedure-body procedure)\n           (extend-environment\n             (procedure-parameters procedure)\n             arguments\n             (procedure-environment procedure))))\n        (else (error \"Unknown procedure type: APPLY*\" procedure))))"))) (section 4 (tt "eval*") (def (sig (procedure "(eval* exp env) → object" (id eval*))) (p "The SICP implementation of " (tt "eval") "; had to rename it " (tt "eval*") ", because the redefinition of " (tt "eval") " wrought havok on the module-system.") (dl (dt (tt "exp")) (dd "The expression to evaluate") (dt (tt "env")) (dd "The environment to evaluate it in")) (highlight scheme "(define (eval* exp env)\n  (cond ((self-evaluating? exp) exp)\n        ((variable? exp) (lookup-variable-value exp env))\n        ((quoted? exp) (text-of-quotation exp))\n        ((assignment? exp) (eval-assignment exp env))\n        ((definition? exp) (eval-definition exp env))\n        ((if? exp) (eval-if exp env))\n        ((lambda? exp)\n         (make-procedure (lambda-parameters exp) (lambda-body exp) env))\n        ((begin? exp) (eval-sequence (begin-actions exp) env))\n        ((cond? exp) (eval* (cond->if exp) env))\n        ((application? exp)\n         (apply*\n           (eval* (operator exp) env)\n           (list-of-values (operands exp) env)))\n        (else (error \"Unknown expression type: EVAL\" exp))))"))) (section 4 (tt "with-primitive-procedures") (def (sig (procedure "(with-primitive-procedures procedures receive-env) → object" (id with-primitive-procedures))) (p "Installs " (tt "procedures") ", creates a default environment and calls " (tt "receive-env") " with the default environment; this is useful for testing new syntax, etc.") (dl (dt (tt "procedures")) (dd "A key-value list of procedure-names and their primitive counter-part") (dt (tt "receive-env")) (dd "A procedure which takes a fresh environment")) (highlight scheme "(define (with-primitive-procedures procedures receive-env)\n  (parameterize\n    ((primitive-procedures (append procedures (primitive-procedures))))\n    (let ((env (setup-environment))) (receive-env env))))")) (section 5 "Examples" (p "Applying primitive addition") (pre "(with-primitive-procedures `((+ ,+)) (lambda (env) (eval* '(+ 2 3) env)))\n => 5\n")))) (section 3 "sicp-eval-anal" (section 4 (tt "sicp-eval-anal") (p (b "[module]") " " (tt "sicp-eval-anal")) (p "The analyzing evaluator from section 4.1.7") (ul (li (int-link "#anal-eval*" "anal-eval*")) (li (int-link "#analyze" "analyze")) (li (int-link "#analyze-application" "analyze-application")) (li (int-link "#analyze-assignment" "analyze-assignment")) (li (int-link "#analyze-definition" "analyze-definition")) (li (int-link "#analyze-if" "analyze-if")) (li (int-link "#analyze-lambda" "analyze-lambda")) (li (int-link "#analyze-quoted" "analyze-quoted")) (li (int-link "#analyze-self-evaluating" "analyze-self-evaluating")) (li (int-link "#analyze-sequence" "analyze-sequence")) (li (int-link "#analyze-variable" "analyze-variable")) (li (int-link "#execute-application" "execute-application")))) (section 4 (tt "anal-eval*") (def (sig (procedure "(anal-eval* exp env) → object" (id anal-eval*))) (p "Anal-eval* analyzes an expression before evaluating it, storing the syntactic analysis in a thunk for re-use.") (dl (dt (tt "exp")) (dd "The expression to analyze and evaluate") (dt (tt "env")) (dd "The environment to analyze and evaluate it in")) (highlight scheme "(define (anal-eval* exp env) ((analyze exp) env))"))) (section 4 (tt "analyze") (def (sig (procedure "(analyze exp) → thunk" (id analyze))) (p "Analyze analyzes the expression, returning a thunk that represents the work to be done.") (dl (dt (tt "exp")) (dd "The expression to analyze")) (highlight scheme "(define (analyze exp)\n  (cond ((self-evaluating? exp) (analyze-self-evaluating exp))\n        ((quoted? exp) (analyze-quoted exp))\n        ((variable? exp) (analyze-variable exp))\n        ((assignment? exp) (analyze-assignment exp))\n        ((definition? exp) (analyze-definition exp))\n        ((if? exp) (analyze-if exp))\n        ((lambda? exp) (analyze-lambda exp))\n        ((begin? exp) (analyze-sequence (begin-actions exp)))\n        ((cond? exp) (analyze (cond->if exp)))\n        ((application? exp) (analyze-application exp))\n        (else (error \"Unknown expression type: ANALYZE\" exp))))")))) (section 3 "sicp-eval-lazy" (section 4 (tt "sicp-eval-lazy") (p (b "[module]") " " (tt "sicp-eval-lazy")) (p "The lazy evaluator from section 4.2.2") (ul (li (int-link "#actual-value" "actual-value")) (li (int-link "#apply*" "apply*")) (li (int-link "#delay-it" "delay-it")) (li (int-link "#driver-loop" "driver-loop")) (li (int-link "#eval*" "eval*")) (li (int-link "#eval-if" "eval-if")) (li (int-link "#evaluated-thunk?" "evaluated-thunk?")) (li (int-link "#force-it" "force-it")) (li (int-link "#input-prompt" "input-prompt")) (li (int-link "#list-of-arg-values" "list-of-arg-values")) (li (int-link "#list-of-delayed-args" "list-of-delayed-args")) (li (int-link "#output-prompt" "output-prompt")) (li (int-link "#thunk-env" "thunk-env")) (li (int-link "#thunk-exp" "thunk-exp")) (li (int-link "#thunk-value" "thunk-value")) (li (int-link "#thunk?" "thunk?")) (li (int-link "#with-lazy-lists" "with-lazy-lists")))) (section 4 (tt "eval*") (def (sig (procedure "(eval* exp env) → object" (id eval*))) (p "Evaluates an expression lazily, given an environment.") (dl (dt (tt "exp")) (dd "The expression to evaluate") (dt (tt "env")) (dd "The environment to evaluate it in")) (highlight scheme "(define (eval* exp env)\n  (cond ((self-evaluating? exp) exp)\n        ((variable? exp) (lookup-variable-value exp env))\n        ((quoted? exp) (text-of-quotation exp))\n        ((assignment? exp) (eval-assignment exp env))\n        ((definition? exp) (eval-definition exp env))\n        ((if? exp) (eval-if exp env))\n        ((lambda? exp)\n         (make-procedure (lambda-parameters exp) (lambda-body exp) env))\n        ((begin? exp) (eval-sequence (begin-actions exp) env))\n        ((cond? exp) (eval* (cond->if exp) env))\n        ((application? exp)\n         (apply* (actual-value (operator exp) env) (operands exp) env))\n        (else (error \"Unknown expression type: EVAL*\" exp))))"))) (section 4 (tt "with-lazy-lists") (def (sig (procedure "(with-lazy-lists procedures receive-env) → object" (id with-lazy-lists))) (p "Sets up an environment where lazy " (tt "cons") ", " (tt "car") " and " (tt "cdr") " have been defined.") (p (tt "With-lazy-lists") " is a wrapper around " (tt "with-primitive-procedures") ".") (dl (dt (tt "procedures")) (dd "A key-value list of names and their primitive procedures in the underlying Scheme.") (dt (tt "receive-env")) (dd "A lambda of one value that takes the prepared environment")) (highlight scheme "(define (with-lazy-lists procedures receive-env)\n  (with-primitive-procedures\n    (append procedures `((= ,=) (- ,-)))\n    (lambda (env)\n      (eval* '(define (cons x y) (lambda (m) (m x y))) env)\n      (eval* '(define (car z) (z (lambda (p q) p))) env)\n      (eval* '(define (cdr z) (z (lambda (p q) q))) env)\n      (eval* '(define (list-ref items n)\n                (if (= n 0) (car items) (list-ref (cdr items) (- n 1))))\n             env)\n      (eval* '(define (map proc items)\n                (if (null? items)\n                  '()\n                  (cons (proc (car items)) (map proc (cdr items)))))\n             env)\n      (receive-env env))))")))) (section 3 "sicp-eval-amb" (section 4 (tt "sicp-eval-amb") (p (b "[module]") " " (tt "sicp-eval-amb")) (p "The non-deterministic backtracking evaluator from section 4.3.3") (ul (li (int-link "#amb-choices" "amb-choices")) (li (int-link "#amb?" "amb?")) (li (int-link "#ambeval*" "ambeval*")) (li (int-link "#ambeval-fold" "ambeval-fold")) (li (int-link "#ambeval-map" "ambeval-map")) (li (int-link "#ambeval-n" "ambeval-n")) (li (int-link "#analyze" "analyze")) (li (int-link "#analyze-amb" "analyze-amb")) (li (int-link "#analyze-application" "analyze-application")) (li (int-link "#analyze-assignment" "analyze-assignment")) (li (int-link "#analyze-definition" "analyze-definition")) (li (int-link "#analyze-if" "analyze-if")) (li (int-link "#analyze-lambda" "analyze-lambda")) (li (int-link "#analyze-let" "analyze-let")) (li (int-link "#analyze-quoted" "analyze-quoted")) (li (int-link "#analyze-self-evaluating" "analyze-self-evaluating")) (li (int-link "#analyze-sequence" "analyze-sequence")) (li (int-link "#analyze-variable" "analyze-variable")) (li (int-link "#driver-loop" "driver-loop")) (li (int-link "#execute-application" "execute-application")) (li (int-link "#failure" "failure")) (li (int-link "#failure?" "failure?")) (li (int-link "#get-args" "get-args")) (li (int-link "#input-prompt" "input-prompt")) (li (int-link "#let->combination" "let->combination")) (li (int-link "#let-body" "let-body")) (li (int-link "#let-clause-expression" "let-clause-expression")) (li (int-link "#let-clause-variable" "let-clause-variable")) (li (int-link "#let-clause?" "let-clause?")) (li (int-link "#let-clauses" "let-clauses")) (li (int-link "#output-prompt" "output-prompt")) (li (int-link "#success?" "success?")) (li (int-link "#with-require" "with-require")))) (section 4 (tt "ambeval") (def (sig (procedure "(ambeval exp env succeed fail) → object" (id ambeval))) (p "Evaluates the expression using backtracking search.") (dl (dt (tt "exp")) (dd "The expression to evaluate") (dt (tt "env")) (dd "The environment to evaluate it in") (dt (tt "succeed")) (dd "The success-continuation") (dt (tt "fail")) (dd "The failure-continuation")) (highlight scheme "(define (ambeval exp env succeed fail) ((analyze exp) env succeed fail))"))) (section 4 (tt "ambeval-n") (def (sig (procedure "(ambeval-n exp env n) → object" (id ambeval-n))) (p "Amb-evaluates the expression, invoking the success-continuation " (tt "n") " times or until failure.") (dl (dt (tt "exp")) (dd "The expression to evaluate") (dt (tt "env")) (dd "The environment to evaluate it in") (dt (tt "n")) (dd "The maximum number of times to invoke the success continuation")) (highlight scheme "(define (ambeval-n exp env n)\n  (ambeval\n    exp\n    env\n    (lambda (val next-alternative)\n      (set! n (- n 1))\n      (if (zero? n) val (next-alternative)))\n    (lambda () failure)))"))) (section 4 (tt "ambeval-fold") (def (sig (procedure "(ambeval-fold exp env cons nil) → list" (id ambeval-fold)) (procedure "(ambeval-fold exp env cons nil n) → list" (id ambeval-fold))) (p "Folds over the results of up to " (tt "n") " successful executions of " (tt "exp") "; if " (tt "n") " is missing, folds over all successful executions until failure.") (dl (dt (tt "exp")) (dd "The expression to execute") (dt (tt "env")) (dd "The environment to execute it in") (dt (tt "cons")) (dd "The aggregator") (dt (tt "nil")) (dd "The initial value") (dt (tt "n")) (dd "The number of results to gather")) (highlight scheme "(define ambeval-fold\n  (case-lambda\n    ((exp env cons nil) (ambeval-fold exp env cons nil +inf.0))\n    ((exp env cons nil n)\n     (let ((result nil))\n       (ambeval\n         exp\n         env\n         (lambda (val next-alternative)\n           (set! n (- n 1))\n           (if (negative? n)\n             result\n             (begin (set! result (cons val result)) (next-alternative))))\n         (lambda () result))))))"))) (section 4 (tt "ambeval-map") (def (sig (procedure "(ambeval-map exp env f) → list" (id ambeval-map)) (procedure "(ambeval-map exp env f n) → list" (id ambeval-map))) (p "Maps over the results of up to " (tt "n") " successful executions of " (tt "exp") "; if " (tt "n") " is missing, maps over all successful executions until failure.") (dl (dt (tt "exp")) (dd "The expression to execute") (dt (tt "env")) (dd "The environment to execute it in") (dt (tt "f")) (dd "The function to apply to the results") (dt (tt "n")) (dd "The number of results to gather")) (highlight scheme "(define ambeval-map\n  (case-lambda\n    ((exp env f) (ambeval-map exp env f +inf.0))\n    ((exp env f n)\n     (ambeval\n       exp\n       env\n       (lambda (val next-alternative)\n         (set! n (- n 1))\n         (if (negative? n) '() (cons val (next-alternative))))\n       (lambda () '())))))"))) (section 4 (tt "ambeval*") (def (sig (procedure "(ambeval* exp env) → list" (id ambeval*)) (procedure "(ambeval* exp env n) → list" (id ambeval*))) (p "Gathers the results of up to " (tt "n") " successful executions of " (tt "exp") "; if " (tt "n") " is missing, gathers all successful executions until failure.") (dl (dt (tt "exp")) (dd "The expression to execute") (dt (tt "env")) (dd "The environment to execute it in") (dt (tt "n")) (dd "The number of results to gather")) (highlight scheme "(define ambeval*\n  (case-lambda\n    ((exp env) (ambeval* exp env +inf.0))\n    ((exp env n) (ambeval-map exp env values n))))"))) (section 4 (tt "with-require") (def (sig (procedure "(with-require procedures receive-env) → object" (id with-require))) (p "Installs " (tt "require") ", " (tt "an-element-of") ", " (tt "an-integer-starting-from") " in the environment in addition to the primitive procedures enumerated in " (tt "procedures") "; then calls " (tt "receive-env") " with the configured environment.") (dl (dt (tt "procedures")) (dd "A key-value list of primitive procedure-names and their definitions") (dt (tt "receive-env")) (dd "A lambda of one value that is called with the prepared environment")) (highlight scheme "(define (with-require procedures receive-env)\n  (with-primitive-procedures\n    (append procedures `((member ,member) (not ,not)))\n    (lambda (env)\n      (ambeval* '(define (require p) (if (not p) (amb) 'success)) env)\n      (ambeval*\n        '(define (an-element-of items)\n           (require (not (null? items)))\n           (amb (car items) (an-element-of (cdr items))))\n        env)\n      (ambeval*\n        '(define (an-integer-starting-from n)\n           (amb n (an-integer-starting-from (+ n 1))))\n        env)\n      (ambeval*\n        '(define (distinct? items)\n           (cond ((null? items) true)\n                 ((null? (cdr items)) true)\n                 ((member (car items) (cdr items)) false)\n                 (else (distinct? (cdr items)))))\n        env)\n      (receive-env env))))")))) (section 3 "About this egg" (section 4 "Author" (p (int-link "/users/klutometis" "Peter Danenberg"))) (section 4 "Repository" (p (link "https://github.com/klutometis/sicp-chicken"))) (section 4 "License" (p "BSD")) (section 4 "Dependencies" (ul (li (int-link "debug")) (li (int-link "hahn")) (li (int-link "htmlprag")) (li (int-link "matchable")) (li (int-link "setup-helper")) (li (int-link "shell")) (li (int-link "token-substitution")))) (section 4 "Versions" (dl (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.0" "0.0")) (dd "Initial commit") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.0.1" "0.0.1")) (dd "Add release-info.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.0.2" "0.0.2")) (dd "Change the repo and uri.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.0.3" "0.0.3")) (dd "Remove 0.0.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.1" "0.1")) (dd "Some actual code.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.1.1" "0.1.1")) (dd "Nil, etc.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.1.2" "0.1.2")) (dd "Remove SRFI-18.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.1.3" "0.1.3")) (dd "Add accumulate.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.1.4" "0.1.4")) (dd "Enumerate interval") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.1.5" "0.1.5")) (dd "Add flatmap.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.1.6" "0.1.6")) (dd "Add `prime?'.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.2" "0.2")) (dd "Add picture language.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.2.12" "0.2.12")) (dd "Add ambeval-fold, ambeval-map; change ambeval*.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.2.13" "0.2.13")) (dd "Remove redundant ambeval*.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.3" "0.3")) (dd "Add the outline-painter.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.4" "0.4")) (dd "Add differentation.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.4.1" "0.4.1")) (dd "Add images to picture-language.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.4.2" "0.4.2")) (dd "Add write-painter-to-png.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.5" "0.5")) (dd "Add sets.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.5.1" "0.5.1")) (dd "Add Huffman trees.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.5.2" "0.5.2")) (dd "Add abstract data.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.5.3" "0.5.3")) (dd "Add arithmetic.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.5.4" "0.5.4")) (dd "Add queues and circuits.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.6" "0.6")) (dd "Add constraints, documentation.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.7" "0.7")) (dd "Add concurrency.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.7.1" "0.7.1")) (dd "Remove the dependency on setup-helper-cock.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.7.2" "0.7.2")) (dd "Update sxml to work with `at'.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.7.3" "0.7.3")) (dd "Drop setup-helper-cock.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8" "0.8")) (dd "Add streams.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.1" "0.8.1")) (dd "Use match instead of match-let.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.2" "0.8.2")) (dd "Add a limit to stream-consumption on stream->list.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.3" "0.8.3")) (dd "Use +inf.0 instead of +inf.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.4" "0.8.4")) (dd "Evaluate examples; update docs.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.5" "0.8.5")) (dd "Add scale-stream.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.6" "0.8.6")) (dd "Add accelerated sequences.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.7" "0.8.7")) (dd "Add integers.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.8" "0.8.8")) (dd "Add interleave and pairs.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.9" "0.8.9")) (dd "Add merge.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.8.10" "0.8.10")) (dd "Add list->stream.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9" "0.9")) (dd "Add the evaluator.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.1" "0.9.1")) (dd "Actually add the eval-files.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.2" "0.9.2")) (dd "Add with-primitive-procedures.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.3" "0.9.3")) (dd "Export some functions.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.4" "0.9.4")) (dd "Export `compound-procedure?'.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.5" "0.9.5")) (dd "Export functions required for analysis.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.6" "0.9.6")) (dd "Also export these for analysis.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.7" "0.9.7")) (dd "Export a few more things.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.8" "0.9.8")) (dd "Export more procedures.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.9" "0.9.9")) (dd "Add time+values.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.10" "0.9.10")) (dd "Export procedures.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.11" "0.9.11")) (dd "Export make-lambda.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.9.12" "0.9.12")) (dd "Use hahn.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.10" "0.10")) (dd "Add the analyzing evaluator.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.11" "0.11")) (dd "Add the lazy evaluator.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.12" "0.12")) (dd "Add the amb-evaluator.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.12.1" "0.12.1")) (dd "Export with-lazy-lists.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.12.4" "0.12.4")) (dd "Add debug to the dependencies.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.12.5" "0.12.5")) (dd "Add `distinct?' to amb-eval.") (dt (link "https://github.com/klutometis/sicp-chicken/releases/tag/0.12.6" "0.12.6")) (dd "Add member to the list of imported functions."))) (section 4 "Colophon" (p "Documented by " (int-link "/egg/hahn" "hahn") ".")))))