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.
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:
bof 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
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,
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
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))
let, we define success by the return of
(list a b) and we define failure by exhaustion of pick in
aas being the first action with a continuation of drawing
b, if there are no value to draw from
a, the main failure in invoked.
bwill be the execution of the requirement with
bare drawn successfully and bound in the environment and then checked against the requirement. If the drawing of
bfails, the call is backtracked to the drawing of a new value for
a, restarting the drawing of
bfrom the beginning and building new pairs.
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.
To build an evaluator capable of evaluating our
primes procedure, we need to be able to interpret:
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)]))
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
fail callbacks which are meant to be called on successful evaluation or failed evaluation.
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))))
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
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))))
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)]))
execute-application are essentially a direct translation from the metacircular evaluator into an analyzer/evaluator passing in
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))
driver-loop has changes allowing retry by typing
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)
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))
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!