Nondeterministic Evaluation
Jun 7th, 2019 - written by Kimserey with .
We recently looked into a simple metacircular evaluator interpreting a part of Lisp. We saw that it was possible to reimplement some of the functionalities by parsing Lisp expressions. We also saw that by slightly changing the order of application, we were able to turn our language into a lazy language. Today we will look into nondeterministic evaluation, also called ambiguous evaluation, another concept which can be made available to the language by re-modeling our evaluator in the same way as we did to introduce laziness.
Nondeterministic Evaluation
In our previous evaluations, we implemented a deterministic computation logic for procedures. After definition of a procedure, given inputs and provided the same environment is provided, the procedure would result in the same result. More than just input/ouput, the procedure body itself would be constructed in a way dictating the machine how to produce a result.
For the following example:
- Given two lists
aandbof integers from one to five, return pairs composed of where the sum of the pair values is prime.
We would start by generating all the pairs possible and filter them by checking if the sum is prime. We would build some recursive looping to iterate over a and b and cons the results that sum to a prime number.
In constrast, with ambiguous computing, we can implement the problem in the same way the specification is written:
1
2
3
4
5
(define (primes)
(let ([a (amb 1 2 3 4 5)]
[b (amb 1 2 3 4 5)])
(require (prime? (+ a b))))
(list a b))
We assume the existence of prime? a predicate checking for primality, amb a procedure used to represent an ambiguous value, and require a procedure enforcing a requirement on the ambiguous values chosen. The amb operator, although applied to multiple arguments, will return a single value. Therefore on the first run, a and b will both be equal to 1, resulting in 2 and since 2 being prime, the procedure will return '(1 1). Retrying the evaluation, we are able to retrieve different valid results, like '(1 2) or '(1 4). This ambiguity allows us to express the procedure in a way that exactly match the problem statement. We are not interested in the order of the combinations of a and b and we are not interested in a particular value, all we want is to draw a particular pair which sums to a prime number. This example being trivial, we will see later with the dwelling puzzle that amb will provide a nice way of representing and solving a particular puzzle.
To be able to write the primes procedure, we need to update our metacircular evaluator which we have started in our previous post. Amb will need to allow us to draw new values as retries are requested or as requirements fail. In order to perform another draw of values, our evaluator will provide a success and fail callbacks for each action occurring. Those callbacks are called continuations, a success continuation represents the next step to execute if the current operation succeeds. If the operation fails, the failure continuation is used.
For example here, we can decompose the following in four parts:
1
2
3
4
(let ([a (amb 1 2 3 4 5)]
[b (amb 1 2 3 4 5)])
(require (prime? (+ a b)))
(list a b))
Before applying let, we define success by the return of (list a b) and we define failure by exhaustion of pick in a and b.
- Following that, we can describe the drawing of
aas being the first action with a continuation of drawingb, if there are no value to draw froma, the main failure in invoked. - The continuation of drawing
bwill be the execution of the requirement withrequire, whereaandbare drawn successfully and bound in the environment and then checked against the requirement. If the drawing ofbfails, the call is backtracked to the drawing of a new value fora, restarting the drawing ofbfrom the beginning and building new pairs. - The requirement continuation will be the last return of the procedure when successful, else failures will backtrack to the previous action of drawing a value for
b.
The facilities of success and failure with backtracking will be incorporated into the evaluator and therefore made transparent to the user of the language.
If you are interested in continuations, I covered them in a previous blog post with an implementation of exceptions with continuations.
Evaluator
To build an evaluator capable of evaluating our primes procedure, we need to be able to interpret:
defineexpressions,letexpressions,variablesandvalues,- primitive procedures like
listor+, ambexpressions.
As we saw in the metacircular evaluator, a definition is expressed as a lambda, which in turn is expressed as a procedure (which we simply represent by a list composed of a lambda plus the environment enclosed). We also assume that we have a primitive predicate prime? testing for primality.
Require can be defined as followed:
1
2
(define (require predicate)
(if (not predicate) (amb)))
Where if the predicate returns false, we fail straight away by applying amb to empty list, which will trigger the backtracking. As we see here, if will also need to be understood by our evaluator as require will need it.
We can now draft our evaluator:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(require compatibility/mlist)
(define (ambeval exp env succeed fail)
((analyze exp) env succeed fail))
(define (analyze exp)
(cond [(self-evaluating? exp)
(analyze-self-evaluating exp)]
[(variable? exp)
(analyze-variable exp)]
[(definition? exp)
(analyze-definition exp)]
[(if? exp)
(analyze-if exp)]
[(lambda? exp)
(analyze-lambda exp)]
[(let? exp)
(analyze-let exp)]
[(amb? exp)
(analyze-amb exp)]
[(application? exp)
(analyze-application exp)]
[else
(error "Unknown expression type: ANALYZE" exp)]))
We define ambeval, a variation of eval utilizing ambiguous computation. As compared to the previous metacircular evaluator that we created, we have split the evaluation into two distinct phase, the analysis and the evaluation. The difference being that we are able to reuse analysis result (we can memoize them) as they are immutable while the evaluation depends on the environment provided. On top of the split, we provide succeed and fail callbacks which are meant to be called on successful evaluation or failed evaluation.
The succeed callback expects two arguments, the first one being the successfully evaluated value, and the second one being a failure callback used to backtrack to the previous point in time.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(define (analyze-self-evaluating exp)
(lambda (env succeed fail)
(succeed exp fail)))
(define (analyze-variable exp)
(lambda (env succeed fail)
(succeed (lookup-variable-value exp env)
fail)))
(define (analyze-lambda exp)
(let ([vars (lambda-parameters exp)]
[body (lambda-body exp)])
(lambda (env succeed fail)
(succeed (make-procedure vars body env)
fail))))
Analyzing self evaluating expression or variable or lambdas is straight forward, we simply call succeed with the expression for self evaluation or lookup for the variable in the environment for variable or build a procedure out of the expression for lambdas. The fail procedure provided in the lambda could be used, for example, for a failing scenario to backtrack prior the evaluation and try again with another value in the environment.
1
2
3
4
5
6
7
8
9
(define (analyze-definition exp)
(let ([var (definition-variable exp)]
[vproc (analyze (definition-value exp))])
(lambda (env succeed fail)
(vproc env
(lambda (proc fail2)
(define-variable! var proc env)
(succeed 'ok fail2))
fail))))
Analyzing a definition results in analyzing the value of the procedure vproc which is the body of the procedure. Once analyzed, we evaluate it by providing the environment and the continuation to that is to define a variable set as the procedure in the environment (define-variable! var proc env).
1
2
3
4
5
6
7
8
9
10
11
(define (analyze-if exp)
(let ([pproc (analyze (if-predicate exp))]
[cproc (analyze (if-consequent exp))]
[aproc (analyze (if-alternative exp))])
(lambda (env succeed fail)
(pproc env
(lambda (pred-value fail2)
(if (true? pred-value)
(cproc env succeed fail2)
(aproc env succeed fail2)))
fail))))
Similarly to analyze-definition, the analysis of an if starts by the analysis of the predicate pproc where the continuation is the check to evaluate the consequent or the alternative.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(define (analyze-let exp)
(let ([vars (let-variables exp)]
[aprocs (mmap analyze (let-values exp))]
[body (let-body exp)])
(lambda (env succeed fail)
(get-args
aprocs
env
(lambda (args fail2)
(execute-application
(make-procedure vars body env)
args
succeed
fail2))
fail))))
For the analysis of a let, we first start by analyzing all arguments aprocs and continue with an application of a procedure built using the variables and body extracted from let. We will see after how get-args nad execute-application are implemented.
1
2
3
4
5
6
7
8
9
10
11
(define (analyze-application exp)
(let ([fproc (analyze (operator exp))]
[aprocs (mmap analyze (operands exp))])
(lambda (env succeed fail)
(fproc env
(lambda (proc fail2)
(get-args aprocs
env
(lambda (args fail3) (execute-application proc args succeed fail3))
fail2))
fail))))
An application is pretty much the same as let, we start by analyzing the operator, and then evaluate it providing a continuation of getting all arguments, with itself a continuation of executing the application.
1
2
3
4
5
6
7
8
9
10
11
12
13
(define (get-args args env succeed fail)
(if (null? args)
(succeed '() fail)
((mcar args)
env
(lambda (arg fail2)
(get-args
(mcdr args)
env
(lambda (args fail3)
(succeed (mcons arg args) fail3))
fail2))
fail)))
Get-args is very much at the center of the amb trick. The procedure recursively build the list of arguments and provide a backtracking of failures. When get-args is invoked with two amb arguments, all values of the second argument will be tried prior trying an argument from the first value, resulting in all possibility being tried.
1
2
3
4
5
6
7
8
9
10
11
12
(define (analyze-amb exp)
(let ([cprocs (mmap analyze (amb-choices exp))])
(lambda (env succeed fail)
(define (try-next choices)
(if (null? choices)
(fail)
((mcar choices)
env
succeed
(lambda () (try-next (mcdr choices))))))
(try-next cprocs))))
Analyzing amb is done by analyzing all choices, then trying each one of them.
1
2
3
4
((mcar choices)
env
succeed
(lambda () (try-next (mcdr choices))))
Try-next (mcdr choices) is the failure callback allowing a pick of another choice on the current ambiguous value. When there is no value available, the main failure is called which will backtrack prior the definition of the ambiguous value.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
(define (analyze-sequence exp)
(define (sequentially a b)
(lambda (env succeed fail)
(a env
(lambda (a-value fail2)
(b env succeed fail2))
fail)))
(define (loop first-proc rest-procs)
(if (null? rest-procs)
first-proc
(loop (sequentially first-proc (mcar rest-procs))
(mcdr rest-procs))))
(let ([procs (mmap analyze exp)])
(if (null? procs)
(error "Empty sequence: ANALYZE")
(loop (mcar procs) (mcdr procs)))))
(define (execute-application proc args succeed fail)
(cond [(primitive-procedure? proc)
(succeed (apply-primitive-procedure proc args) fail)]
[(compound-procedure? proc)
((analyze-sequence (procedure-body proc))
(extend-environment
(procedure-parameters proc)
args
(procedure-environment proc))
succeed
fail)]
[else (error "Unknown procedure type: EXECUTE-APPLICATION" proc)]))
Lastly analyze-sequence and execute-application are essentially a direct translation from the metacircular evaluator into an analyzer/evaluator passing in succeed and fail.
The rest of the functions part of the evaluator are selectors and constructors used to select pieces of an expression in order to be analyzed. Those are unchanged from the previous post on the metacircular evaluator, with the only addtion of amb? predicate looking for 'amb tag and amb-choices selector, selecting the mcdr of the expression which would select the choices available from the expression.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
(define (self-evaluating? exp)
(cond [(number? exp) true]
[(string? exp) true]
[else false]))
(define (variable? exp)
(symbol? exp))
(define (tagged-list? exp tag)
(if (mpair? exp)
(eq? (mcar exp) tag)
false))
(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (mcar (mcdr exp)))
(mcar (mcdr exp))
(mcar (mcar (mcdr exp)))))
(define (definition-value exp)
(if (symbol? (mcar (mcdr exp)))
(mcar (mcdr (mcdr exp)))
(make-lambda
(mcdr (mcar (mcdr exp)))
(mcdr (mcdr exp)))))
(define (lambda? exp)
(tagged-list? exp 'lambda))
(define (lambda-parameters exp)
(mcar (mcdr exp)))
(define (lambda-body exp)
(mcdr (mcdr exp)))
(define (make-lambda parameters body)
(mcons 'lambda (mcons parameters body)))
(define (let? exp)
(tagged-list? exp 'let))
(define (let-variables exp)
(mmap mcar (mcar (mcdr exp))))
(define (let-values exp)
(mmap (lambda (val) (mcar (mcdr val))) (mcar (mcdr exp))))
(define (let-body exp)
(mcdr (mcdr exp)))
(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (mcar (mcdr exp)))
(define (if-consequent exp) (mcar (mcdr (mcdr exp))))
(define (if-alternative exp)
(if (not (null? (mcdr (mcdr (mcdr exp)))))
(mcar (mcdr (mcdr (mcdr exp))))
'false))
(define (application? exp) (mpair? exp))
(define (operator exp) (mcar exp))
(define (operands exp) (mcdr exp))
(define (true? x)
(not (eq? x false)))
(define (make-procedure parameters body env)
(mlist 'procedure parameters body env))
(define (amb? exp) (tagged-list? exp 'amb))
(define (amb-choices exp) (mcdr exp))
(define (compound-procedure? p)
(tagged-list? p 'procedure))
(define (procedure-parameters p) (mcar (mcdr p)))
(define (procedure-body p) (mcar (mcdr (mcdr p))))
(define (procedure-environment p) (mcar (mcdr (mcdr (mcdr p)))))
(define (enclosing-environment env) (mcdr env))
(define (first-frame env) (mcar env))
(define the-empty-environment 'the-empty-environment)
(define (make-frame variables values)
(mcons variables values))
(define (frame-variables frame) (mcar frame))
(define (frame-values frame) (mcdr frame))
(define (add-binding-to-frame! var val frame)
(set-mcar! frame (mcons var (frame-variables frame)))
(set-mcdr! frame (mcons val (frame-values frame))))
(define (extend-environment vars vals base-env)
(if (= (mlength vars) (mlength vals))
(mcons (make-frame vars vals) base-env)
(if (< (mlength vars) (mlength 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 (mcar vars))(mcar vals)]
[else (scan (mcdr vars) (mcdr 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 (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 (mcar vars)) (set-mcar! vals val)]
[else (scan (mcdr vars) (mcdr vals))]))
(scan (frame-variables frame)
(frame-values frame))))
(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))
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
(define (primitive-implementation proc)
(mcdr proc))
(define primitive-procedures
(mlist
(mcons 'list list)
(mcons 'not not)
(mcons 'prime? prime?)
(mcons '= =)))
(define (primitive-procedure-names)
(mmap mcar primitive-procedures))
(define (primitive-procedure-objects)
(mmap (lambda (proc)
(mcons 'primitive (mcdr proc)))
primitive-procedures))
(define (apply-primitive-procedure proc args)
(apply (primitive-implementation proc) (mlist->list/deep args)))
(define the-global-environment (setup-environment))
The driver-loop has changes allowing retry by typing try-again.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
(define input-prompt ";;; Amb-Eval input:")
(define output-prompt ";;; Amb-Eval value:")
(define (mlist->list/deep input)
(map
(lambda (value)
(if (mpair? value)
(mlist->list/deep value)
value))
(mlist->list input)))
(define (list->mlist/deep input)
(mmap
(lambda (value)
(if (pair? value)
(list->mlist/deep value)
value))
(list->mlist input)))
(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 new problem")
(ambeval
(if (pair? input) (list->mlist/deep input) input)
the-global-environment
(lambda (val next-alternative)
(announce-output output-prompt)
(user-print val)
(internal-loop next-alternative))
(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)))
(driver-loop)
We provide as main failure a lambda outputing that there are no more values for the test provided. Now that we have a full evaluator, we are able to get prime numbers.
1
2
3
4
5
6
7
8
9
10
11
12
;;; Amb-Eval input:
(primes '(1 2 3 4) '(1 2 3))
;;; Starting a new problem
;;; Amb-Eval value:
(1 1)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(1 2)
Puzzle
Primes was a simple example, a more complex puzzle can be found in section 4.3.2 of SICP. Consider the following problem statement:
1
2
3
4
5
6
7
8
Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors.
Baker does not live on the top floor.
Cooper does not live on the bottom floor.
Fletcher does not live on either the top or the bottom floor.
Miller lives on a higher floor than does Cooper.
Smith does not live on a floor adjacent to Fletcher’s.
Fletcher does not live on a floor adjacent to Cooper’s.
Where does everyone live?
We could come up with all the combinations and eliminate those that fail the requirements. But using our amb evaluator, we are able to implement the procedure following exactly the problem statement:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(define (multiple-dwelling)
(let ((baker (amb 1 2 3 4 5))
(cooper (amb 1 2 3 4 5))
(fletcher (amb 1 2 3 4 5))
(miller (amb 1 2 3 4 5))
(smith (amb 1 2 3 4 5)))
(require (distinct? (list baker cooper fletcher miller smith)))
(require (not (= baker 5)))
(require (not (= cooper 1)))
(require (not (= fletcher 5)))
(require (not (= fletcher 1)))
(require (> miller cooper))
(require (not (= (abs (- smith fletcher)) 1)))
(require (not (= (abs (- fletcher cooper)) 1)))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))))
Assuming the existence of distinct? predicate which we can add to the primitive procedures selector:
1
2
3
4
5
6
7
8
9
(define primitive-procedures
(mlist
(mcons 'list list)
(mcons 'not not)
(mcons 'prime? prime?)
(mcons 'distinct? distinct?)
(mcons '= =)
(mcons '> >)
(mcons 'abs abs)))
With backtracking implicitly handled for us, the result is very appealing. Executing (multiple-dwelling) will produce:
1
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
Conclusion
Today we explored the concept of nondeterministic computation. We saw how we could change our evaluator to support ambiguous values where multiple valid result could occur. The whole concept revolves around continuations and backtracking allowing us to go back in time, pick new values, and retry continuations with the newly picked values until a set of values picked succeed all requirements.
Although the changes in this evaluator were more pronounced than our transformation from applicative to normal order, it allowed us to unveal the importance of the evaluator for the language itself. By handling the callbacks and analyzing each expression, transforming them into continuation passing style, we were able to provide an abstract ambiguous language powerful enough to implement procedure solving problems in the same order as the problem statements themselves were defined. As always, I hoped you liked this post and I see you on the next one!