Working on 4.78

misc/sicp-ambeval.scm

@@ -372,6 +372,14 @@
 (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.
+(define (lamb? exp) (tagged-list? exp 'lamb))
+(define (lamb-choices exp) (cdr exp))
+(define (analyze-lamb exp)
+  (analyze-amb (cons (car exp) (cadr exp))))
+
 ;; analyze from 4.1.6, with clause from 4.3.3 added
 ;; and also support for Let
 (define (analyze exp)
@@ -390,6 +398,8 @@
         ((let? exp) (analyze (let->combination exp))) ;**
         ((amb? exp) (analyze-amb exp))                ;**
         ((ramb? exp) (analyze-ramb exp))                ;**
+        ((lamb? exp) (analyze-lamb exp))                ;**
+        ((or? exp) (analyze-or exp))
         ((application? exp) (analyze-application exp))
         (else
          (error "Unknown expression type -- ANALYZE" exp))))
@@ -420,8 +430,14 @@
       (succeed (make-procedure vars bproc env)
                fail))))
 
-;;;Conditionals and sequences
+(define (or? exp) (tagged-list? exp 'or))
+(define (clauses exp) (cdr exp))
+(define (no-clauses? exp) (null? exp))
+(define (first-clause exp) (car exp))
+(define (rest-clauses exp) (cdr exp))
+; TODO: (define (analyze-or exp) ...)
 
+;;;Conditionals and sequences
 (define (analyze-if exp)
   (let ((pproc (analyze (if-predicate exp)))
         (cproc (analyze (if-consequent exp)))
@@ -615,8 +631,6 @@
                                    (let-body exp))
                       (map let-val bindings))))
 
-
-
 ;; A longer list of primitives -- suitable for running everything in 4.3
 ;; Overrides the list in ch4-mceval.scm
 ;; Has Not to support Require; various stuff for code in text (including
@@ -624,30 +638,37 @@
 ;;  eq? for ex. solution
 
 (define primitive-procedures
-  (list (list 'car car)
-        (list 'cdr cdr)
-        (list 'cons cons)
-        (list 'null? null?)
-        (list 'list list)
-        (list 'memq memq)
-        (list 'member member)
-        (list 'not not)
-        (list 'display display)
+  (list (list '* *)
         (list '+ +)
         (list '- -)
-        (list '* *)
+        (list '<= <=)
         (list '= =)
         (list '> >)
         (list '>= >=)
-        (list '<= <=)
         (list 'abs abs)
-        (list 'remainder remainder)
-        (list 'integer? integer?)
-        (list 'sqrt sqrt)
+        (list 'assoc assoc)
+        (list 'car car)
+        (list 'cdr cdr)
+        (list 'cons cons)
+        (list 'display display)
         (list 'eq? eq?)
+        (list 'integer? integer?)
+        (list 'list list)
+        (list 'member member)
+        (list 'memq memq)
         (list 'newline newline)
-;;      more primitives
+        (list 'not not)
+        (list 'null? null?)
+        (list 'pair? pair?)
+        (list 'remainder remainder)
+        (list 'set-car! set-car!)
+        (list 'set-cdr! set-cdr!)
+        (list 'sqrt sqrt)
+        (list 'string=? string=?)
+        (list 'substring substring)
+        (list 'symbol->string symbol->string)
+        (list 'symbol? symbol?)
+        (list 'the-empty-stream the-empty-stream)
         ))
 
-
 'AMB-EVALUATOR-LOADED