Finish 4.78 and skip 4.79

misc/sicp-ambeval.scm

@@ -363,23 +363,25 @@
 
 
 ;;;Code from SECTION 4.3.3, modified as needed to run it
-
 (define (amb? exp) (tagged-list? exp 'amb))
 (define (amb-choices exp) (cdr exp))
 
 (define (ramb? exp) (tagged-list? exp 'ramb))
 (define (ramb-choices exp) (cdr exp))
 
-; The lamb statement takes a single list and treats each item as a value. So
-; its the equivalent of (apply amb list) in Scheme.  Since our evaluator does
-; not support that expression we use lamb. Analyze-lamb calls analyze-amb.
+;; lamb takes a list and treats each element as a separate amb-value
 (define (lamb? exp) (tagged-list? exp 'lamb))
-(define (lamb-choices exp) (cdr exp))
+(define (lamb-arg exp) (cadr exp))
 (define (analyze-lamb exp)
-  (analyze-amb (cons (car exp) (cadr exp))))
+  (let ((p (analyze (lamb-arg exp))))
+    (lambda (env succeed fail)
+      (define (try-options options fail2)
+        (if (null? options)
+          (fail)
+          (succeed (car options) (lambda () (try-options (cdr options) fail2)))))
+      (p env try-options fail))))
 
-;; analyze from 4.1.6, with clause from 4.3.3 added
-;; and also support for Let
+;; analyze from 4.1.6, with clause from 4.3.3 added and also support for let
 (define (analyze exp)
   (cond ((self-evaluating? exp)
          (analyze-self-evaluating exp))
@@ -666,13 +668,14 @@
   (list (list '* *)
         (list '+ +)
         (list '- -)
+        (list '< <)
         (list '<= <=)
         (list '= =)
         (list '> >)
         (list '>= >=)
         (list 'abs abs)
-        (list 'assoc assoc)
         (list 'append append)
+        (list 'assoc assoc)
         (list 'caddr caddr)
         (list 'cadr cadr)
         (list 'car car)
@@ -680,8 +683,8 @@
         (list 'cdr cdr)
         (list 'cons cons)
         (list 'display display)
-        (list 'equal? equal?)
         (list 'eq? eq?)
+        (list 'equal? equal?)
         (list 'integer? integer?)
         (list 'list list)
         (list 'member member)
@@ -689,12 +692,14 @@
         (list 'newline newline)
         (list 'not not)
         (list 'null? null?)
+        (list 'number? number?)
         (list 'pair? pair?)
         (list 'remainder remainder)
         (list 'set-car! set-car!)
         (list 'set-cdr! set-cdr!)
         (list 'sqrt sqrt)
         (list 'string->symbol string->symbol)
+        (list 'string-append string-append)
         (list 'string-length string-length)
         (list 'string=? string=?)
         (list 'substring substring)