Scheme - [SICP]Why is idea of the amb evaluator hard? :)

Author

[SICP]Why is idea of the amb evaluator hard? :)

Aleksei Smirnoff

2005-08-23, 7:01 pm

Hi.

Could you show me the place in the internet, where are some explanations
of the amb evaluator implementation?

Up to the charter 4.3.3 of the SICP I understood everything (mostly :),
but looks like this charter was wrote by another writers (or red by
another reader).

google couldn't help me.

Thank in advance,
Alek

Tim Wilson

2005-08-23, 7:01 pm

On Tue, 23 Aug 2005 19:17:11 +0400, Aleksei Smirnoff wrote:

> Could you show me the place in the internet, where are some explanations
> of the amb evaluator implementation?
>
> Up to the charter 4.3.3 of the SICP I understood everything (mostly :),
> but looks like this charter was wrote by another writers (or red by
> another reader).
>
> google couldn't help me.

You just have to ask it right, and sometimes beg and plead for it to
return something of relevance.

Here are a few resources that might help:
http://community.schemewiki.org/?amb

http://docs.mandragor.org/files/Pro....htm#%_sec_14.1

Tim

Emilio Lopes

2005-08-23, 7:01 pm

Aleksei Smirnoff writes:

> Could you show me the place in the internet, where are some
> explanations of the amb evaluator implementation?

don't know if it will help you, but "teach yourself scheme in fixnum
days" has a chapter on amb (sorry, I don't have an URL handy; just
google for it). Note that it's implemented differently there, using
`call-with-current-continuation' IIRC.

2005-08-24, 6:59 pm

I like the explanations in On Lisp by Paul Graham
(http://www.paulgraham.com/onlisp.html), Chapter 22, the amb operator
is called choose IIRC, first version implemented in Scheme using
continuations.

Funny by the way, SICP implements amb using a halfdone cps conversion.
it would have been much better to implement continuations and implement
amb using continuations IMHO. I still wonder why the authors of the
otherwise excellent book chose to do it that way.

Greetings HB

Emilio Lopes schrieb:

> Aleksei Smirnoff writes:
>
>
> don't know if it will help you, but "teach yourself scheme in fixnum
> days" has a chapter on amb (sorry, I don't have an URL handy; just
> google for it). Note that it's implemented differently there, using
> `call-with-current-continuation' IIRC.

Brian Harvey

2005-08-25, 6:59 pm

One thing that I think makes it harder than necessary (I argued with them
about this but lost...) is that they base the code on the analyzing evaluator,
so that's two levels of hard ideas combined. I'm adding to this message two
things: my lecture notes on ambeval, and the code rewritten to be based on the
vanilla metacircular evaluator.

----------8<----------8<----------8<----------8<----------8<----------

SOLUTION SPACES, STREAMS, AND BACKTRACKING

Many problems are of the form "Find all A such that B" or
"find an A such that B." For example: Find an even integer
that is not the sum of two primes; find a set of integers
a, b, c, and n such that a^n+b^n=c^n and n>2. (These
problems might not be about numbers: Find all the states in
the United States whose first and last letters are the same.)

In each case, the set A (even integers, sets of four integers,
or states) is called the SOLUTION SPACE. The condition B
is a predicate function of a potential solution that's true for
actual solutions.

One approach to solving problems of this sort is to represent
the solution space as a stream, and use STREAM-FILTER to select
the elements that satisfy the predicate:

(STREAM-FILTER SUM-OF-TWO-PRIMES? EVEN-INTEGERS)

(STREAM-FILTER FERMAT? (PAIRS (PAIRS INTEGERS INTEGERS)
(PAIRS INTEGERS INTEGERS)))

(STREAM-FILTER (LAMBDA (X) (EQUAL? (FIRST X) (LAST X))) STATES)

The stream technique is particularly elegant for infinite problem
spaces, because the program seems to be generating the entire
solution space A before checking the predicate B. (Of course
we know that really the steps of the computation are reordered
so that the elements are tested as they are generated.)

This w

we consider a different way to express the same sort
of computation, a way that makes the sequence of events in time
more visible. In effect we'll say:

* Pick a possible solution.

* See if it's really a solution.

* If so, return it; if not, try another.

Here's an example of the notation:

> (LET ((A (AMB 2 3 4))
(B (AMB 6 7 8)))
(REQUIRE (= (REMAINDER B A) 0))
(LIST A B))
(2 6)
> TRY-AGAIN
(2 8)
> TRY-AGAIN
(3 6)
> TRY-AGAIN
(4 8)
> TRY-AGAIN
THERE ARE NO MORE SOLUTIONS.

The main new thing here is the special form AMB. This is not
part of ordinary Scheme! We are adding it as a new feature in the
metacircular evaluator. AMB takes any number of argument
expressions and returns the value of one of them. You can think
about this using either of two metaphors:

* The computer clones itself into as many copies as there
are arguments; each clone gets a different value.

* The computer magically knows which argument will give rise
to a solution to your problem and chooses that one.

What really happens is that the evaluator chooses the first argument
and returns its value, but if the computation later FAILS then
it tries again with the second argument, and so on until there are no
more to try. This introduces another new idea: the possibility of
the failure of a computation. That's not the same thing as an error!
Errors (such as taking the CAR of an empty list) are handled
the same in this evaluator as in ordinary Scheme; they result in an
error message and the computation stops. A failure is different; it's
what happens when you call AMB with no arguments, or when all
the arguments you gave have been tried and there are no more left.

In the example above I used REQUIRE to cause a failure of the
computation if the condition is not met. REQUIRE is a simple
procedure in the metacircular Scheme-with-AMB:

(DEFINE (REQUIRE CONDITION)
(IF (NOT CONDITION) (AMB)))

So here's the sequence of events in the computation above:

A=2
B=6; 6 IS A MULTIPLE OF 2, SO RETURN (2 6)

[TRY-AGAIN]
B=7; 7 ISN'T A MULTIPLE OF 2, SO FAIL.
B=8; 8 IS A MULTIPLE OF 2, SO RETURN (2 8)

[TRY-AGAIN]
NO MORE VALUES FOR B, SO FAIL.
A=3
B=6; 6 IS A MULTIPLE OF 3, SO RETURN (3 6)

[TRY-AGAIN]
B=7; 7 ISN'T A MULTIPLE OF 3, SO FAIL.
B=8; 8 ISN'T A MULTIPLE OF 3, SO FAIL.
NO MORE VALUES FOR B, SO FAIL.
A=4
B=6; 6 ISN'T A MULTIPLE OF 4, SO FAIL.
B=7; 7 ISN'T A MULTIPLE OF 4, SO FAIL.
B=8; 8 IS A MULTIPLE OF 4, SO RETURN (4 8)

[TRY-AGAIN]
NO MORE VALUES FOR B, SO FAIL.
NO MORE VALUES FOR A, SO FAIL.
(NO MORE PENDING AMBS, SO REPORT FAILURE TO USER.)

RECURSIVE AMB

Since AMB accepts any argument expressions, not just literal
values as in the example above, it can be used recursively:

(DEFINE (AN-INTEGER-BETWEEN FROM TO)
(IF (> FROM TO)
(AMB)
(AMB FROM (AN-INTEGER-BETWEEN (+ FROM 1) TO))))

or if you prefer:

(DEFINE (AN-INTEGER-BETWEEN FROM TO)
(REQUIRE (>= TO FROM))
(AMB FROM (AN-INTEGER-BETWEEN (+ FROM 1) TO)))

Further, since AMB is a special form and only evaluates one
argument at a time, it has the same delaying effect as CONS-STREAM
and can be used to make infinite solution spaces:

(DEFINE (INTEGERS-FROM FROM)
(AMB FROM (INTEGERS-FROM (+ FROM 1))))

This INTEGERS-FROM computation never fails--there is always
another integer--and so it won't work to say

(LET ((A (INTEGERS-FROM 1))
(B (INTEGERS-FROM 1)))
...)

because A will never have any value other than 1, because the
second AMB never fails. This is analogous to the problem of
trying to append infinite streams; in that case we could solve the
problem with INTERLEAVE but it's harder here.

FOOTNOTE ON ORDER OF EVALUATION

In describing the sequence of events in these examples, I'm assuming
that Scheme will evaluate the arguments of the unnamed procedure
created by a LET from left to right. If I wanted to be sure
of that, I should use LET* instead of LET. But it matters
only in my description of the sequence of events; considered
abstractly, the program will behave correctly regardless of the
order of evaluation, because all possible solutions will eventually
be tried--although maybe not in the order shown here.

SUCCESS OR FAILURE

In the implementation of AMB, the most difficult change to the
evaluator is that any computation may either succeed or fail. The
most obvious way to try to represent this situation is to have EVAL
return some special value, let's say the symbol =FAILED=, if a
computation fails. (This is analogous to the use of =NO-VALUE= in
the Logo interpreter project.) The trouble is that if an AMB fails,
we don't want to continue the computation; we want to "back up" to an
earlier stage in the computation. Suppose we are trying
to evaluate an expression such as

(A (B (C (D 4))))

and suppose that procedures B and C use AMB. Procedure
D is actually invoked first; then C is invoked with the value
D returned as argument. The AMB inside procedure C
returns its first argument, and C uses that to compute a return
value that becomes the argument to B. Now suppose that the AMB
inside B fails. We don't want to invoke A with the value
=FAILED= as its argument! In fact we don't want to invoke A
at all; we want to re-evaluate the body of C but using the second
argument to its AMB.

A&S take a different approach. If an AMB fails, they want to
be able to jump right back to the previous AMB, without having to
propagate the failure explicitly through several intervening calls to
EVAL. To make this work, intuitively, we have to give EVAL
two different places to return to when it's finished, one for a success
and the other for a failure.

CONTINUATIONS

Ordinarily a procedure doesn't think explicitly about where to return;
it returns to its caller, but Scheme takes care of that automatically.
For example, when we compute

(* 3 (SQUARE 5))

the procedure SQUARE computes the value 25 and Scheme automatically
returns that value to the EVAL invocation that's waiting to use
it as an argument to the multiplication. But we could tell SQUARE
explicitly, "when you've figured out the answer, pass it on to be
multiplied by 3" this way:

(DEFINE (SQUARE X CONTINUATION)
(CONTINUATION (* X X)))

> (SQUARE 5 (LAMBDA (Y) (* Y 3)))
75

A *continuation* is a procedure that takes your result as argument and says
what's left to be done in the computation.

CONTINUATIONS FOR SUCCESS AND FAILURE

In the case of the nondeterministic evaluator, we give EVAL *two*
continuations, one for success and one for failure. Note that these
continuations are part of the implementation of the evaluator; the user of
AMB doesn't deal explicitly with continuations.

Here's a handwavy example. In the case of

(A (B (C (D 4))))

procedure B's success continuation is something like

(LAMBDA (VALUE) (A VALUE))

but its failure continuation is

(LAMBDA () (A (B (REDO-AMB-IN-C))))

This example is handwavy because these "continuations" are from the
point of view of the user of the metacircular Scheme, who doesn't
know anything about continuations, really. The true continuations
are written in underlying Scheme, as part of the evaluator itself.

If a computation fails, the most recent AMB wants to try another
value. So a continuation failure will redo the AMB with one
fewer argument. There's no information that the failing computation
needs to send back to that AMB except for the fact of failure
itself, so the failure continuation procedure needs no arguments.

On the other hand, if the computation succeeds, we have to carry out
the success continuation, and that continuation needs to know the
value that we computed. It also needs to know what to do if the
continuation itself fails; most of the time, this will be the same
as the failure continuation we were given, but it might not be.
So a success continuation must be a procedure that takes two
arguments: a value and a failure continuation.

The book bases the nondeterministic evaluator on the analyzing one, but
I'll use a simplified version based on plain old eval (it's in
~cs61a/lib/vambeval.scm).

Most kinds of evaluation always succeed, so they invoke their success
continuation and pass on the failure one. I'll start with a too-simplified
version of EVAL-IF in this form:

(DEFINE (EVAL-IF EXP ENV SUCCEED FAIL) ; WRONG!
(IF (EVAL (IF-PREDICATE EXP) ENV SUCCEED FAIL)
(EVAL (IF-CONSEQUENT EXP) ENV SUCCEED FAIL)
(EVAL (IF-ALTERNATIVE EXP) ENV SUCCEED FAIL)))

The trouble is, what if the evaluation of the predicate fails?
We don't then want to evaluate the consequent or the alternative.
So instead, we just evaluate the predicate, giving it a success
continuation that will evaluate the consequent or the alternative,
supposing that evaluating the predicate succeeds.

In general, wherever the ordinary metacircular evaluator would say

(DEFINE (EVAL-FOO EXP ENV)
(EVAL STEP-1 ENV)
(EVAL STEP-2 ENV))

using EVAL twice for part of its work, this version has to
EVAL the first part with a continuation that EVALs
the second part:

(DEFINE (EVAL-FOO EXP ENV SUCCEED FAIL)
(EVAL STEP-1
ENV
(LAMBDA (VALUE-1 FAIL-1)
(EVAL STEP-2 ENV SUCCEED FAIL-1))
FAIL))

(In either case, STEP-2 presumably uses the result of
evaluating STEP-1 somehow.)

Here's how that works out for IF:

(DEFINE (EVAL-IF EXP ENV SUCCEED FAIL)
(EVAL (IF-PREDICATE EXP) ; TEST THE PREDICATE
ENV
(LAMBDA (PRED-VALUE FAIL2) ; WITH THIS SUCCESS CONTINUATION
(IF (TRUE? PRED-VALUE)
(EVAL (IF-CONSEQUENT EXP) ENV SUCCEED FAIL2)
(EVAL (IF-ALTERNATIVE EXP) ENV SUCCEED FAIL2)))
FAIL)) ; AND THE SAME FAILURE CONTINUATION

What's FAIL2? It's the failure continuation that the evaluation
of the predicate will supply. Most of the time, that'll be the same
as our own failure continuation, just as EVAL-IF uses FAIL
as the failure continuation to pass on to the evaluation of the predicate.
But if the predicate involves an AMB expression, it will generate
a new failure continuation. Think about an example like this one:

> (IF (AMB #T #F)
(AMB 1)
(AMB 2))
1

> TRY-AGAIN
2

(A more realistic example would have the predicate expression be some
more complicated procedure call that had an AMB in its body.)
The first thing that happens is that the first AMB returns #T,
and so IF evaluates its second argument, and that second AMB
returns 1. When the user says to try again, there are no more values
for that AMB to return, so it fails. What we must do is re-evaluate
the first AMB, but this time returning its second argument, #F.
By now you've forgotten that we're trying to work out what FAIL2 is
for in EVAL-IF, but this example shows why the failure continuation
when we evaluate IF-CONSEQUENT (namely the (AMB 1) expression)
has to be different from the failure continuation for the entire IF
expression. If the entire IF fails (which will happen if we say
TRY-AGAIN again) then its failure continuation will tell us that
there are no more values. That continuation is bound to the name FAIL
in EVAL-IF. What ends up bound to the name FAIL2 is the
continuation that re-evaluates the predicate AMB.

How does FAIL2 get that binding? When EVAL-IF evaluates the
predicate, which turns out to be an AMB expression, EVAL-AMB
will evaluate whatever argument it's up to, but with a new failure
continuation:

(DEFINE (EVAL-AMB EXP ENV SUCCEED FAIL)
(IF (NULL? (CDR EXP)) ; (CAR EXP) IS THE WORD AMB
(FAIL) ; NO MORE ARGS, CALL FAILURE CONT.
(EVAL (CADR EXP) ; OTHERWISE EVALUATE THE FIRST ARG
ENV
SUCCEED ; WITH MY SAME SUCCESS CONTINUATION
(LAMBDA () ; BUT WITH A NEW FAILURE CONTINUATION:
(EVAL-AMB (CONS 'AMB (CDDR EXP)) ; TRY THE NEXT ARGUMENT
ENV
SUCCEED
FAIL)))))

Notice that EVAL-IF, like most other cases, provides a new
success continuation but passes on the same failure continuation
that it was given as an argument. But EVAL-AMB does the
opposite: It passes on the same success continuation it was given,
but provides a new failure continuation.

Of course there are a gazillion more details, but the book
explains them, once you understand what a continuation is.
The most important of these complications is that anything involving
mutation is problematic. If we say

(DEFINE X 5)
(SET! X (+ X (AMB 2 3)))

it's clear that the first time around X should end up with
the value 7 (5+2). But if we try again, we'd like X to get
the value 8 (5+3), not 10 (7+3). So SET! must set up
a failure continuation that undoes the change in the binding of X,
restoring its original value of 5, before letting the AMB
prits second argument.

----------8<----------8<----------8<----------8<----------8<----------
;;;;Nondeterministic evaluator
;;;;Different from the one in chapter 4 of SICP, in that it's based on the
;;;; vanilla metacircular evaluator, rather than on the analyzing one.

;;;;This file can be loaded into Scheme as a whole.
;;;;Then you can initialize and start the evaluator by evaluating
;;;; the expression (mce).

;;;from section 4.1.4 -- must precede def of metacircular apply
(define apply-in-underlying-scheme apply)

;;;SECTION 4.1.1

(define (ambeval exp env succeed fail)
(cond ((self-evaluating? exp) (succeed exp fail))
((variable? exp)
(succeed (lookup-variable-value exp env)
fail))
((quoted? exp) (succeed (text-of-quotation exp) fail))
((assignment? exp) (eval-assignment exp env succeed fail))
((definition? exp) (eval-definition exp env succeed fail))
((if? exp) (eval-if exp env succeed fail))
((lambda? exp)
(succeed (make-procedure (lambda-parameters exp)
(lambda-body exp)
env)
fail))
((begin? exp)
(eval-sequence (begin-actions exp) env succeed fail))
((cond? exp) (ambeval (cond->if exp) env succeed fail))
((let? exp) (ambeval (let->combination exp) env succeed fail)) ;**
((amb? exp) (eval-amb exp env succeed fail)) ;**
((application? exp)
(eval-application exp env succeed fail))
(else
(error "Unknown expression type -- EVAL" exp))))

(define (eval-application exp env succeed fail)
(ambeval (operator exp)
env
(lambda (proc fail2)
(get-args (operands exp)
env
(lambda (args fail3)
(execute-application proc args succeed fail3))
fail2))
fail))

(define (get-args exps env succeed fail)
(if (null? exps)
(succeed '() fail)
(ambeval (car exps)
env
(lambda (arg fail2)
(get-args (cdr exps)
env
(lambda (args fail3)
(succeed (cons arg args)
fail3))
fail2))
fail)))

(define (execute-application procedure arguments succeed fail)
(cond ((primitive-procedure? procedure)
(succeed (apply-primitive-procedure procedure arguments) fail))
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure))
succeed
fail))
(else
(error
"Unknown procedure type -- APPLY" procedure))))

(define (eval-if exp env succeed fail)
(ambeval (if-predicate exp)
env
(lambda (pred-value fail2)
(if (true? pred-value)
(ambeval (if-consequent exp)
env
succeed
fail2)
(ambeval (if-alternative exp)
env
succeed
fail2)))
fail))

(define (eval-sequence exps env succeed fail)
(define (loop first-exp rest-exps succeed fail)
(if (null? rest-exps)
(ambeval first-exp env succeed fail)
(ambeval first-exp
env
(lambda (first-value fail2)
(loop (car rest-exps) (cdr rest-exps) succeed fail2))
fail)))
(if (null? exps)
(error "Empty sequence")
(loop (car exps) (cdr exps) succeed fail)))

(define (eval-definition exp env succeed fail)
(ambeval (definition-value exp)
env
(lambda (val fail2)
(define-variable! (definition-variable exp) val env)
(succeed 'ok fail2))
fail))

(define (eval-assignment exp env succeed fail)
(ambeval (assignment-value exp)
env
(lambda (val fail2)
(let* ((var (assignment-variable exp))
(old-value
(lookup-variable-value var env)))
(set-variable-value! var val env)
(succeed 'ok
(lambda ()
(set-variable-value! var old-value env)
(fail2)))))
fail))

(define (eval-amb exp env succeed fail)
(define (try-next choices)
(if (null? choices)
(fail)
(ambeval (car choices)
env
succeed
(lambda ()
(try-next (cdr choices))))))
(try-next (amb-choices exp)))

;;;SECTION 4.1.2

(define (self-evaluating? exp)
(cond ((number? exp) true)
((string? exp) true)
((boolean? exp) true)
(else false)))

(define (quoted? exp)
(tagged-list? exp 'quote))

(define (text-of-quotation exp) (cadr exp))

(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))

(define (variable? exp) (symbol? exp))

(define (assignment? exp)
(tagged-list? exp 'set!))

(define (assignment-variable exp) (cadr exp))

(define (assignment-value exp) (caddr exp))

(define (definition? exp)
(tagged-list? exp 'define))

(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))

(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda (cdadr exp)
(cddr exp))))

(define (lambda? exp) (tagged-list? exp 'lambda))

(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))

(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))

(define (if? exp) (tagged-list? exp 'if))

(define (if-predicate exp) (cadr exp))

(define (if-consequent exp) (caddr exp))

(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'false))

(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))

(define (begin? exp) (tagged-list? exp 'begin))

(define (begin-actions exp) (cdr exp))

(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))

(define (sequence->exp seq)
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))

(define (make-begin seq) (cons 'begin seq))

(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))

(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))

(define (cond? exp) (tagged-list? exp 'cond))

(define (cond-clauses exp) (cdr exp))

(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))

(define (cond-predicate clause) (car clause))

(define (cond-actions clause) (cdr clause))

(define (cond->if exp)
(expand-clauses (cond-clauses exp)))

(define (expand-clauses clauses)
(if (null? clauses)
'false ; no else clause
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF"
clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))

(define (amb? exp) (tagged-list? exp 'amb))
(define (amb-choices exp) (cdr exp))

;;;SECTION 4.1.3

(define (true? x)
(not (eq? x false)))

(define (false? x)
(eq? x false))

(define (make-procedure parameters body env)
(list 'procedure parameters body env))

(define (compound-procedure? p)
(tagged-list? p 'procedure))

(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))

(define (enclosing-environment env) (cdr env))

(define (first-frame env) (car env))

(define the-empty-environment '())

(define (make-frame variables values)
(cons variables values))

(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))

(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))

(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(if (< (length vars) (length vals))
(error "Too many arguments supplied" vars vals)
(error "Too few arguments supplied" vars vals))))

(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars)
(env-loop (enclosing-environment env)))
((eq? var (car vars))
(car vals))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))

(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars)
(env-loop (enclosing-environment env)))
((eq? var (car vars))
(set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable -- SET!" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))

(define (define-variable! var val env)
(let ((frame (first-frame env)))
(define (scan vars vals)
(cond ((null? vars)
(add-binding-to-frame! var val frame))
((eq? var (car vars))
(set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(scan (frame-variables frame)
(frame-values frame))))

;;;SECTION 4.1.4

(define (setup-environment)
(let ((initial-env
(extend-environment (primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)))
(define-variable! 'true true initial-env)
(define-variable! 'false false initial-env)
initial-env))

;[do later] (define the-global-environment (setup-environment))

(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))

(define (primitive-implementation proc) (cadr proc))

(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
(list '+ +)
(list '- -)
(list '* *)
(list '/ /)
(list '= =)
(list 'list list)
(list 'append append)
(list 'equal? equal?)
;; more primitives
))

(define (primitive-procedure-names)
(map car
primitive-procedures))

(define (primitive-procedure-objects)
(map (lambda (proc) (list 'primitive (cadr proc)))
primitive-procedures))

;[moved to start of file] (define apply-in-underlying-scheme apply)

(define (apply-primitive-procedure proc args)
(apply-in-underlying-scheme
(primitive-implementation proc) args))

(define input-prompt ";;; Amb-Eval input:")
(define output-prompt ";;; Amb-Eval value:")

(define (driver-loop)
(define (internal-loop try-again)
(prompt-for-input input-prompt)
(let ((input (read)))
(if (eq? input 'try-again)
(try-again)
(begin
(newline)
(display ";;; Starting a new problem ")
(ambeval input
the-global-environment
;; ambeval success
(lambda (val next-alternative)
(announce-output output-prompt)
(user-print val)
(internal-loop next-alternative))
;; ambeval failure
(lambda ()
(announce-output
";;; There are no more values of")
(user-print input)
(driver-loop)))))))
(internal-loop
(lambda ()
(newline)
(display ";;; There is no current problem")
(driver-loop))))

(define (prompt-for-input string)
(newline) (newline) (display string) (newline))

(define (announce-output string)
(newline) (display string) (newline))

(define (user-print object)
(if (compound-procedure? object)
(display (list 'compound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env> ))
(display object)))

;;; Support for Let (as noted in footnote 56, p.428)

(define (let? exp) (tagged-list? exp 'let))
(define (let-bindings exp) (cadr exp))
(define (let-body exp) (cddr exp))

(define (let-var binding) (car binding))
(define (let-val binding) (cadr binding))

(define (make-combination operator operands) (cons operator operands))

(define (let->combination exp)
;;make-combination defined in earlier exercise
(let ((bindings (let-bindings exp)))
(make-combination (make-lambda (map let-var bindings)
(let-body exp))
(map let-val bindings))))

;; A longer list of primitives -- suitable for running everything in 4.3
;; Overrides the list in ch4-mceval.scm
;; Has Not to support Require; various stuff for code in text (including
;; support for Prime?); integer? and sqrt for exercise code;
;; eq? for ex. solution

(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
(list 'list list)
(list 'append append)
(list 'memq memq)
(list 'member member)
(list 'not not)
(list '+ +)
(list '- -)
(list '* *)
(list '= =)
(list '> > )
(list '>= >=)
(list 'abs abs)
(list 'remainder remainder)
(list 'integer? integer?)
(list 'sqrt sqrt)
(list 'eq? eq?)
(list 'equal? equal?)
(list 'pair? pair?)
;; more primitives
))

;;;Following are commented out so as not to be evaluated when
;;; the file is loaded.
;;(define the-global-environment (setup-environment))
;;(driver-loop)

;; Added at Berkeley:
(define the-global-environment '())

(define (mce)
(set! the-global-environment (setup-environment))
(ambeval '(define (require p) (if (not p) (amb)))
the-global-environment
(lambda (a b) #t)
(lambda () #t))
(driver-loop))

Sponsored Links