• Wiki
• Download
• Manual
• Eggs
• API
• Tests
• Bugs

Outdated egg!

This is an egg for CHICKEN 4, the unsupported old release. You're almost certainly looking for the CHICKEN 5 version of this egg, if it exists.

If it does not exist, there may be equivalent functionality provided by another egg; have a look at the egg index. Otherwise, please consider porting this egg to the current version of CHICKEN.

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
• time+values
• 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) → 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

• make-serializer
• parallel-execute
• with-mutex-locked

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.

(let ((s (make-serializer)) (x 10))
  (parallel-execute (s (lambda () (set! x (* x x))))
                    (s (lambda () (set! x (+ x 1))))))
 => #<procedure (f_307)>

sicp-streams

sicp-streams

[module] sicp-streams

Stream procedures from section 3.5

• accelerated-sequence
• cons-stream
• display-line
• display-stream
• euler-transform
• integers
• interleave
• list->stream
• make-tableau
• merge
• pairs
• 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-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
[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) → stream

Scales 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) → stream

Applies 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) → stream

Makes 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) → stream

Accelerates 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) → stream

Enumerates 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))

interleave

[procedure] (interleave s1 s2) → stream

Interleaves two streams.

s1

The interleavened stream

s1

The interleaving stream

(define (interleave s1 s2)
  (if (stream-null? s1)
    s2
    (cons-stream (stream-car s1) (interleave s2 (stream-cdr s1)))))

pairs

[procedure] (pairs s t) → stream

Generates the stream of pairs (S_i, T_j), where i <= j.

s

The first stream to pair

t

The second stream to pair

(define (pairs s t)
  (cons-stream
    (list (stream-car s) (stream-car t))
    (interleave
      (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t))
      (pairs (stream-cdr s) (stream-cdr t)))))

merge

[procedure] (merge s1 s2) → stream

Merges two ordered streams into one ordered result stream, eliminating repetitions.

s1

Mergend

s2

Merger

(define (merge s1 s2)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
         (let ((s1car (stream-car s1)) (s2car (stream-car s2)))
           (cond ((< s1car s2car)
                  (cons-stream s1car (merge (stream-cdr s1) s2)))
                 ((> s1car s2car)
                  (cons-stream s2car (merge s1 (stream-cdr s2))))
                 (else
                  (cons-stream
                    s1car
                    (merge (stream-cdr s1) (stream-cdr s2)))))))))

list->stream

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

Takes a list and streamifies it.

list

The list to streamify

(define (list->stream list)
  (if (null? list)
    stream-null
    (cons-stream (car list) (list->stream (cdr list)))))

sicp-eval

sicp-eval

[module] sicp-eval

Evaluation procedures from section 4.1

• add-binding-to-frame!
• announce-output
• application?
• apply*
• apply-primitive-procedure
• assignment?
• assignment-value
• assignment-variable
• begin-actions
• begin?
• compound-procedure?
• cond?
• cond->if
• cond-actions
• cond-clauses
• cond-else-clause?
• cond-predicate
• define-variable!
• definition?
• definition-variable
• definition-value
• driver-loop
• enclosing-environment
• eval*
• eval-assignment
• eval-definition
• eval-if
• eval-sequence
• extend-environment
• false?
• first-exp
• first-frame
• frame-values
• frame-variables
• if?
• if-alternative
• if-consequent
• if-predicate
• first-operand
• lambda?
• lambda-body
• lambda-parameters
• last-exp?
• list-of-values
• lookup-variable-value
• make-if
• make-frame
• make-lambda
• make-procedure
• no-operands?
• operands
• operator
• primitive-procedure?
• primitive-procedures
• procedure-body
• procedure-environment
• procedure-parameters
• prompt-for-input
• quoted?
• rest-exps
• rest-operands
• self-evaluating?
• sequence->exp
• set-variable-value!
• setup-environment
• tagged-list?
• text-of-quotation
• the-empty-environment
• the-global-environment
• true?
• user-print
• variable?
• with-primitive-procedures

apply*

[procedure] (apply* procedure arguments) → object

The SICP definition of apply; had to rename it apply*, because the redefinition of apply wrought havok on the module-system.

procedure

The procedure to apply

arguments

The arguments to which to apply it

(define (apply* procedure arguments)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure procedure arguments))
        ((compound-procedure? procedure)
         (eval-sequence
           (procedure-body procedure)
           (extend-environment
             (procedure-parameters procedure)
             arguments
             (procedure-environment procedure))))
        (else (error "Unknown procedure type: APPLY*" procedure))))

eval*

[procedure] (eval* exp env) → object

The SICP implementation of eval; had to rename it eval*, because the redefinition of eval wrought havok on the module-system.

exp

The expression to evaluate

env

The environment to evaluate it in

(define (eval* exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((if? exp) (eval-if exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp) (lambda-body exp) env))
        ((begin? exp) (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval* (cond->if exp) env))
        ((application? exp)
         (apply*
           (eval* (operator exp) env)
           (list-of-values (operands exp) env)))
        (else (error "Unknown expression type: EVAL" exp))))

with-primitive-procedures

[procedure] (with-primitive-procedures procedures receive-env) → object

Installs procedures, creates a default environment and calls receive-env with the default environment; this is useful for testing new syntax, etc.

procedures

A key-value list of procedure-names and their primitive counter-part

receive-env

A procedure which takes a fresh environment

(define (with-primitive-procedures procedures receive-env)
  (parameterize
    ((primitive-procedures (append procedures (primitive-procedures))))
    (let ((env (setup-environment))) (receive-env env))))

Examples

Applying primitive addition

(with-primitive-procedures `((+ ,+)) (lambda (env) (eval* '(+ 2 3) env)))
 => 5

sicp-eval-anal

sicp-eval-anal

[module] sicp-eval-anal

The analyzing evaluator from section 4.1.7

• anal-eval*
• analyze
• analyze-application
• analyze-assignment
• analyze-definition
• analyze-if
• analyze-lambda
• analyze-quoted
• analyze-self-evaluating
• analyze-sequence
• analyze-variable
• execute-application

anal-eval*

[procedure] (anal-eval* exp env) → object

Anal-eval* analyzes an expression before evaluating it, storing the syntactic analysis in a thunk for re-use.

exp

The expression to analyze and evaluate

env

The environment to analyze and evaluate it in

(define (anal-eval* exp env) ((analyze exp) env))

analyze

[procedure] (analyze exp) → thunk

Analyze analyzes the expression, returning a thunk that represents the work to be done.

exp

The expression to analyze

(define (analyze exp)
  (cond ((self-evaluating? exp) (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((assignment? exp) (analyze-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((application? exp) (analyze-application exp))
        (else (error "Unknown expression type: ANALYZE" exp))))

sicp-eval-lazy

sicp-eval-lazy

[module] sicp-eval-lazy

The lazy evaluator from section 4.2.2

• actual-value
• apply*
• delay-it
• driver-loop
• eval*
• eval-if
• evaluated-thunk?
• force-it
• input-prompt
• list-of-arg-values
• list-of-delayed-args
• output-prompt
• thunk-env
• thunk-exp
• thunk-value
• thunk?
• with-lazy-lists

eval*

[procedure] (eval* exp env) → object

Evaluates an expression lazily, given an environment.

exp

The expression to evaluate

env

The environment to evaluate it in

(define (eval* exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((if? exp) (eval-if exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp) (lambda-body exp) env))
        ((begin? exp) (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval* (cond->if exp) env))
        ((application? exp)
         (apply* (actual-value (operator exp) env) (operands exp) env))
        (else (error "Unknown expression type: EVAL*" exp))))

with-lazy-lists

[procedure] (with-lazy-lists procedures receive-env) → object

Sets up an environment where lazy cons, car and cdr have been defined.

With-lazy-lists is a wrapper around with-primitive-procedures.

procedures

A key-value list of names and their primitive procedures in the underlying Scheme.

receive-env

A lambda of one value that takes the prepared environment

(define (with-lazy-lists procedures receive-env)
  (with-primitive-procedures
    (append procedures `((= ,=) (- ,-)))
    (lambda (env)
      (eval* '(define (cons x y) (lambda (m) (m x y))) env)
      (eval* '(define (car z) (z (lambda (p q) p))) env)
      (eval* '(define (cdr z) (z (lambda (p q) q))) env)
      (eval* '(define (list-ref items n)
                (if (= n 0) (car items) (list-ref (cdr items) (- n 1))))
             env)
      (eval* '(define (map proc items)
                (if (null? items)
                  '()
                  (cons (proc (car items)) (map proc (cdr items)))))
             env)
      (receive-env env))))

sicp-eval-amb

sicp-eval-amb

[module] sicp-eval-amb

The non-deterministic backtracking evaluator from section 4.3.3

• amb-choices
• amb?
• ambeval*
• ambeval-fold
• ambeval-map
• ambeval-n
• analyze
• analyze-amb
• analyze-application
• analyze-assignment
• analyze-definition
• analyze-if
• analyze-lambda
• analyze-let
• analyze-quoted
• analyze-self-evaluating
• analyze-sequence
• analyze-variable
• driver-loop
• execute-application
• failure
• failure?
• get-args
• input-prompt
• let->combination
• let-body
• let-clause-expression
• let-clause-variable
• let-clause?
• let-clauses
• output-prompt
• success?
• with-require

ambeval

[procedure] (ambeval exp env succeed fail) → object

Evaluates the expression using backtracking search.

exp

The expression to evaluate

env

The environment to evaluate it in

succeed

The success-continuation

fail

The failure-continuation

(define (ambeval exp env succeed fail) ((analyze exp) env succeed fail))

ambeval-n

[procedure] (ambeval-n exp env n) → object

Amb-evaluates the expression, invoking the success-continuation n times or until failure.

exp

The expression to evaluate

env

The environment to evaluate it in

n

The maximum number of times to invoke the success continuation

(define (ambeval-n exp env n)
  (ambeval
    exp
    env
    (lambda (val next-alternative)
      (set! n (- n 1))
      (if (zero? n) val (next-alternative)))
    (lambda () failure)))

ambeval-fold

[procedure] (ambeval-fold exp env cons nil) → list
[procedure] (ambeval-fold exp env cons nil n) → list

Folds over the results of up to n successful executions of exp; if n is missing, folds over all successful executions until failure.

exp

The expression to execute

env

The environment to execute it in

cons

The aggregator

nil

The initial value

n

The number of results to gather

(define ambeval-fold
  (case-lambda
    ((exp env cons nil) (ambeval-fold exp env cons nil +inf.0))
    ((exp env cons nil n)
     (let ((result nil))
       (ambeval
         exp
         env
         (lambda (val next-alternative)
           (set! n (- n 1))
           (if (negative? n)
             result
             (begin (set! result (cons val result)) (next-alternative))))
         (lambda () result))))))

ambeval-map

[procedure] (ambeval-map exp env f) → list
[procedure] (ambeval-map exp env f n) → list

Maps over the results of up to n successful executions of exp; if n is missing, maps over all successful executions until failure.

exp

The expression to execute

env

The environment to execute it in

f

The function to apply to the results

n

The number of results to gather

(define ambeval-map
  (case-lambda
    ((exp env f) (ambeval-map exp env f +inf.0))
    ((exp env f n)
     (ambeval
       exp
       env
       (lambda (val next-alternative)
         (set! n (- n 1))
         (if (negative? n) '() (cons val (next-alternative))))
       (lambda () '())))))

ambeval*

[procedure] (ambeval* exp env) → list
[procedure] (ambeval* exp env n) → list

Gathers the results of up to n successful executions of exp; if n is missing, gathers all successful executions until failure.

exp

The expression to execute

env

The environment to execute it in

n

The number of results to gather

(define ambeval*
  (case-lambda
    ((exp env) (ambeval* exp env +inf.0))
    ((exp env n) (ambeval-map exp env values n))))

with-require

[procedure] (with-require procedures receive-env) → object

Installs require, an-element-of, an-integer-starting-from in the environment in addition to the primitive procedures enumerated in procedures; then calls receive-env with the configured environment.

procedures

A key-value list of primitive procedure-names and their definitions

receive-env

A lambda of one value that is called with the prepared environment

(define (with-require procedures receive-env)
  (with-primitive-procedures
    (append procedures `((member ,member) (not ,not)))
    (lambda (env)
      (ambeval* '(define (require p) (if (not p) (amb) 'success)) env)
      (ambeval*
        '(define (an-element-of items)
           (require (not (null? items)))
           (amb (car items) (an-element-of (cdr items))))
        env)
      (ambeval*
        '(define (an-integer-starting-from n)
           (amb n (an-integer-starting-from (+ n 1))))
        env)
      (ambeval*
        '(define (distinct? items)
           (cond ((null? items) true)
                 ((null? (cdr items)) true)
                 ((member (car items) (cdr items)) false)
                 (else (distinct? (cdr items)))))
        env)
      (receive-env env))))

About this egg

Author

Peter Danenberg

Repository

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

License

BSD

Dependencies

• debug
• hahn
• htmlprag
• matchable
• setup-helper
• shell
• token-substitution

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.2.12

Add ambeval-fold, ambeval-map; change ambeval*.

0.2.13

Remove redundant ambeval*.

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.

0.8.7

Add integers.

0.8.8

Add interleave and pairs.

0.8.9

Add merge.

0.8.10

Add list->stream.

0.9

Add the evaluator.

0.9.1

Actually add the eval-files.

0.9.2

Add with-primitive-procedures.

0.9.3

Export some functions.

0.9.4

Export `compound-procedure?'.

0.9.5

Export functions required for analysis.

0.9.6

Also export these for analysis.

0.9.7

Export a few more things.

0.9.8

Export more procedures.

0.9.9

Add time+values.

0.9.10

Export procedures.

0.9.11

Export make-lambda.

0.9.12

Use hahn.

0.10

Add the analyzing evaluator.

0.11

Add the lazy evaluator.

0.12

Add the amb-evaluator.

0.12.1

Export with-lazy-lists.

0.12.4

Add debug to the dependencies.

0.12.5

Add `distinct?' to amb-eval.

0.12.6

Add member to the list of imported functions.

Colophon

Documented by hahn.