From: Ramakrishnan Muthukrishnan Date: Tue, 26 Mar 2013 12:57:48 +0000 (+0530) Subject: solutions to 4.50..4.54 X-Git-Url: https://git.rkrishnan.org/pf/ref/de/seg/bridge/nav/%3C?a=commitdiff_plain;h=205b4712a8e8c88693b184030143ff513ec26a92;p=sicp.git solutions to 4.50..4.54 --- diff --git a/src/sicp/ex4_50.rkt b/src/sicp/ex4_50.rkt new file mode 100644 index 0000000..69f61b8 --- /dev/null +++ b/src/sicp/ex4_50.rkt @@ -0,0 +1,13 @@ +#lang racket + +#| + +In this original definition of amb-choices, + +(define (amb-choices expr) (rest expr)) + +instead return the shuffled values + +(define (amb-choices expr) (shuffle (rest expr))) + +|# \ No newline at end of file diff --git a/src/sicp/ex4_51.rkt b/src/sicp/ex4_51.rkt new file mode 100644 index 0000000..ccb5caa --- /dev/null +++ b/src/sicp/ex4_51.rkt @@ -0,0 +1,28 @@ +#lang racket + +;;; assignment +(define (analyze-assignment expr) + (let ([var (assignment-var expr)] + [vproc (analyze (assignment-value expr))]) + (lambda (env succeed fail) + (vproc env + (lambda (val fail2) + (let ([old-val (lookup-variable-value var env)]) + (set-variable-value! var val) + (succeed 'ok + (lambda () + (set-variable-value! var old-val env) + (fail2))))) + fail)))) + +;; permenent-set! +;;; assignment +(define (analyze-permanent-assignment expr) + (let ([var (perm-assignment-var expr)] + [vproc (analyze (perm-assignment-value expr))]) + (lambda (env succeed fail) + (vproc env + (lambda (val fail2) + (set-variable-value! var val) + (succeed 'ok fail2)) + fail)))) diff --git a/src/sicp/ex4_52.rkt b/src/sicp/ex4_52.rkt new file mode 100644 index 0000000..3c60f2c --- /dev/null +++ b/src/sicp/ex4_52.rkt @@ -0,0 +1,12 @@ +#lang racket + +;; if-fail + +(define (analyze-if-fail expr) + (let ([sproc (analyze (if-fail-success expr))] + [fproc (analyze (if-fail-failure expr))]) + (lambda (env succeed fail) + (sproc env + succeed + (lambda () + (fexpr env succeed fail)))))) \ No newline at end of file diff --git a/src/sicp/ex4_54.rkt b/src/sicp/ex4_54.rkt new file mode 100644 index 0000000..79dcb0c --- /dev/null +++ b/src/sicp/ex4_54.rkt @@ -0,0 +1,15 @@ +#lang racket + +(define (assert? expr) (tagged-list? expr 'assert)) + +(define (assert-predicate expr) (first (rest expr))) + +(define (analyze-assert exp) + (let ((pproc (analyze (assert-predicate exp)))) + (lambda (env succeed fail) + (pproc env + (lambda (pred-value fail2) + (if (not (true? pred-value)) + (fail) + (succeed 'ok fail2))) + fail)))) \ No newline at end of file