Implement till 4.52
parent
88859171ba
commit
36f9f625ea
|
@ -319,9 +319,71 @@
|
|||
; because we used list-amb to get amb behavior. We would need list-ramb which would
|
||||
; require shuffling the items inside the evalutor or use something like apply.
|
||||
|
||||
(display "\nex-4.51\n")
|
||||
(display "\nex-4.51 - permanent-set!\n")
|
||||
|
||||
(display "\nex-4.52\n")
|
||||
; (display "\nex-4.53\n")
|
||||
; (display "\nex-4.54\n")
|
||||
(amball '(begin
|
||||
(define count 0)
|
||||
(let ((x (amb 'a 'b 'c))
|
||||
(y (amb 'a 'b 'c)))
|
||||
(permanent-set! count (+ count 1))
|
||||
(require (not (eq? x y)))
|
||||
(list x y count))
|
||||
))
|
||||
|
||||
; With set! all counts would be 1. With permanent-set! every tried combination
|
||||
; increments the counts. Hence, all counts are unique and count increments up
|
||||
; to 9. (c c) would be nine and (b c) is eight.
|
||||
|
||||
(define (last xs)
|
||||
(if (null? (cdr xs))
|
||||
(car xs)
|
||||
(last (cdr xs))))
|
||||
|
||||
(assert (first result) '(a b 2))
|
||||
(assert (last result) '(c b 8))
|
||||
|
||||
(display "\nex-4.52 - if-fail\n")
|
||||
|
||||
; Exercise 4.52. Implement a new construct called if-fail that permits the
|
||||
; user to catch the failure of an expression. If-fail takes two expressions. It
|
||||
; evaluates the first expression as usual and returns as usual if the
|
||||
; evaluation succeeds. If the evaluation fails, however, the value of the
|
||||
; second expression is returned, as in the following example:
|
||||
|
||||
(define (analyze-if-fail exp)
|
||||
(let ((a (analyze (if-fail-first exp)))
|
||||
(b (analyze (if-fail-second exp))))
|
||||
(lambda (env succeed fail)
|
||||
(a env
|
||||
(lambda (a-value fail2) (succeed a-value fail))
|
||||
(lambda () (b env succeed fail))))))
|
||||
|
||||
;;; Amb-Eval input:
|
||||
(amball '(begin
|
||||
|
||||
(define (even? n)
|
||||
(= (remainder n 2) 0))
|
||||
|
||||
(if-fail (let ((x (amb 1 3 5)))
|
||||
(require (even? x))
|
||||
x)
|
||||
'all-odd)
|
||||
))
|
||||
|
||||
(assert (first result) 'all-odd)
|
||||
|
||||
(amball '(begin
|
||||
(if-fail (let ((x (amb 1 3 5 8)))
|
||||
(require (even? x))
|
||||
x)
|
||||
'all-odd)
|
||||
))
|
||||
|
||||
(assert (first result) 8)
|
||||
|
||||
|
||||
(display "\nex-4.53\n")
|
||||
|
||||
|
||||
(display "\nex-4.54\n")
|
||||
|
||||
|
|
|
@ -105,6 +105,9 @@
|
|||
(define (assignment? exp)
|
||||
(tagged-list? exp 'set!))
|
||||
|
||||
(define (permanent-assignment? exp)
|
||||
(tagged-list? exp 'permanent-set!))
|
||||
|
||||
(define (assignment-variable exp) (cadr exp))
|
||||
|
||||
(define (assignment-value exp) (caddr exp))
|
||||
|
@ -377,8 +380,10 @@
|
|||
((quoted? exp) (analyze-quoted exp))
|
||||
((variable? exp) (analyze-variable exp))
|
||||
((assignment? exp) (analyze-assignment exp))
|
||||
((permanent-assignment? exp) (analyze-permanent-assignment exp))
|
||||
((definition? exp) (analyze-definition exp))
|
||||
((if? exp) (analyze-if exp))
|
||||
((if-fail? exp) (analyze-if-fail exp))
|
||||
((lambda? exp) (analyze-lambda exp))
|
||||
((begin? exp) (analyze-sequence (begin-actions exp)))
|
||||
((cond? exp) (analyze (cond->if exp)))
|
||||
|
@ -432,6 +437,10 @@
|
|||
;; failure continuation for evaluating the predicate
|
||||
fail))))
|
||||
|
||||
(define (if-fail? exp) (tagged-list? exp 'if-fail))
|
||||
(define (if-fail-first exp) (cadr exp))
|
||||
(define (if-fail-second exp) (caddr exp))
|
||||
|
||||
(define (analyze-sequence exps)
|
||||
(define (sequentially a b)
|
||||
(lambda (env succeed fail)
|
||||
|
@ -480,6 +489,17 @@
|
|||
(fail2)))))
|
||||
fail))))
|
||||
|
||||
(define (analyze-permanent-assignment exp)
|
||||
(let ((var (assignment-variable exp))
|
||||
(vproc (analyze (assignment-value exp))))
|
||||
(lambda (env succeed fail)
|
||||
(vproc env
|
||||
(lambda (val fail2)
|
||||
(set-variable-value! var val env)
|
||||
(succeed 'ok
|
||||
(lambda () (fail2))))
|
||||
fail))))
|
||||
|
||||
;;;Procedure applications
|
||||
|
||||
(define (analyze-application exp)
|
||||
|
|
Loading…
Reference in New Issue