Added SICP amb evaluator to answer 4.45

ex-4_45-xx.scm

@@ -1,27 +1,38 @@
 (load "util.scm")
-(load "misc/amb.scm")
+(load "misc/sicp-ambeval.scm")
+
+(define the-global-environment (setup-environment))
+(define result '())
+
+(define (amball exp)
+  (set! result '()) ; reset result
+  (ambeval exp
+           the-global-environment
+           (lambda (value next)
+             (set! result (cons value result))
+             (next))
+           (lambda () result))
+  (set! result (reverse result))
+  result)
+
+(amball '(begin
+
+(define (require p)
+  (if (not p) (amb)))
 
 (define nouns '(noun student professor cat class))
 (define verbs '(verb studies lectures eats sleeps))
 (define articles '(article the a))
 
-(define *unparsed* '())
-
-; By default mit-scheme evaluates the list elements from last to first element.
-; That means with the parse-implementation in the book the later part of a
-; phrase is evaluated first which does not yield any results. To force the
-; correct order we use a let expression and then built the return list from the
-; let variables.
-
 (define (parse-sentence)
-  (let* ((noun-phrase (parse-noun-phrase))
-         (verb-phrase (parse-word verbs)))
-    (list 'sentence noun-phrase verb-phrase)))
+  (list 'sentence
+         (parse-noun-phrase)
+         (parse-word verbs)))
 
 (define (parse-noun-phrase)
-  (let* ((article-phrase (parse-word articles))
-         (noun-phrase (parse-word nouns)))
-  (list 'noun-phrase article-phrase noun-phrase)))
+  (list 'noun-phrase
+        (parse-word articles)
+        (parse-word nouns)))
 
 (define (parse-word word-list)
   (require (not (null? *unparsed*)))
@@ -30,19 +41,156 @@
     (set! *unparsed* (cdr *unparsed*))
     (list (car word-list) found-word)))
 
+(define *unparsed* '())
 (define (parse input)
   (set! *unparsed* input)
   (let ((sent (parse-sentence)))
     (require (null? *unparsed*))
     sent))
 
-(display "\nex-4.45 - parse-sentence\n")
+(define prepositions '(prep for to in by with))
 
-(my-assert (parse '(the cat eats))
-        '(sentence (noun-phrase (article the) (noun cat)) (verb eats)))
+(define (parse-prepositional-phrase)
+  (list 'prep-phrase
+        (parse-word prepositions)
+        (parse-noun-phrase)))
 
-;'(The professor lectures to the student in the class with the cat)
+(define (parse-sentence)
+  (list 'sentence
+         (parse-noun-phrase)
+         (parse-verb-phrase)))
 
-(display "\nex-4.46\n")
+(define (parse-verb-phrase)
+  (define (maybe-extend verb-phrase)
+    (amb verb-phrase
+         (maybe-extend (list 'verb-phrase
+                             verb-phrase
+                             (parse-prepositional-phrase)))))
+  (maybe-extend (parse-word verbs)))
 
+(define (parse-simple-noun-phrase)
+  (list 'simple-noun-phrase
+        (parse-word articles)
+        (parse-word nouns)))
 
+(define (parse-noun-phrase)
+  (define (maybe-extend noun-phrase)
+    (amb noun-phrase
+         (maybe-extend (list 'noun-phrase
+                             noun-phrase
+                             (parse-prepositional-phrase)))))
+  (maybe-extend (parse-simple-noun-phrase)))
+
+(parse '(the professor lectures to the student with the cat))
+))
+
+;'The professor lectures to the student in the class with the cat.'
+(assert
+  (first result)
+  '(sentence
+   (simple-noun-phrase (article the) (noun professor))
+   (verb-phrase
+    (verb-phrase
+     (verb lectures)
+     (prep-phrase (prep to)
+                  (simple-noun-phrase
+                   (article the) (noun student))))
+    (prep-phrase (prep with)
+                 (simple-noun-phrase
+                  (article the) (noun cat))))))
+(assert
+  (second result)
+  '(sentence
+   (simple-noun-phrase (article the) (noun professor))
+   (verb-phrase
+    (verb lectures)
+    (prep-phrase (prep to)
+                 (noun-phrase
+                  (simple-noun-phrase
+                   (article the) (noun student))
+                  (prep-phrase (prep with)
+                               (simple-noun-phrase
+                                (article the) (noun cat))))))))
+
+(display "\nex-4.45 - sentence-meanings\n")
+
+(amball '(parse '(The professor lectures to the student in the class with the cat)))
+(assert (length result) 5)
+
+'(sentence
+   (simple-noun-phrase (article the) (noun professor))
+   (verb-phrase
+     (verb-phrase
+       (verb-phrase
+         (verb lectures)
+         (prep-phrase
+           (prep to) (simple-noun-phrase (article the) (noun student))))
+       (prep-phrase
+         (prep in) (simple-noun-phrase (article the) (noun class))))
+     (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
+
+; The professor lectures (to the student) in the class with the cat.
+
+'(sentence
+   (simple-noun-phrase (article the) (noun professor))
+   (verb-phrase
+     (verb-phrase
+       (verb lectures)
+       (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student))))
+     (prep-phrase
+       (prep in)
+       (noun-phrase
+         (simple-noun-phrase (article the) (noun class))
+         (prep-phrase (prep with)
+                      (simple-noun-phrase (article the) (noun cat)))))))
+
+; The professor lectures to the student (in the class with the cat).
+
+'(sentence
+   (simple-noun-phrase (article the) (noun professor))
+   (verb-phrase
+     (verb-phrase
+       (verb lectures)
+       (prep-phrase
+         (prep to)
+         (noun-phrase
+           (simple-noun-phrase (article the) (noun student))
+           (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class))))))
+     (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
+
+; The professor lectures (to the student in the class) with the cat.
+
+'(sentence
+   (simple-noun-phrase (article the) (noun professor))
+   (verb-phrase
+     (verb lectures)
+     (prep-phrase
+       (prep to)
+       (noun-phrase
+         (noun-phrase
+           (simple-noun-phrase (article the) (noun student))
+           (prep-phrase (prep in)
+                        (simple-noun-phrase (article the) (noun class))))
+         (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))
+
+; The professor lectures ((to the student in the class) with the cat).
+
+'(sentence
+   (simple-noun-phrase (article the) (noun professor))
+   (verb-phrase
+     (verb lectures)
+     (prep-phrase
+       (prep to)
+       (noun-phrase
+         (simple-noun-phrase (article the) (noun student))
+         (prep-phrase
+           (prep in)
+           (noun-phrase
+             (simple-noun-phrase (article the) (noun class))
+             (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))))
+
+; The professor lectures (to the student (in the class with the cat)).
+
+(display "[answered]\n")
+
+(display "\nex-4.46 - evaluation-order\n")

misc/sicp-ambeval.scm

@@ -0,0 +1,628 @@
+; COPIED FROM: https://mitpress.mit.edu/sites/default/files/sicp/code/index.html
+
+;;;;METACIRCULAR EVALUATOR FROM CHAPTER 4 (SECTIONS 4.1.1-4.1.4) of
+;;;; STRUCTURE AND INTERPRETATION OF COMPUTER PROGRAMS
+
+;;;;Matches code in ch4.scm
+
+;;;;This file can be loaded into Scheme as a whole.
+;;;;Then you can initialize and start the evaluator by evaluating
+;;;; the two commented-out lines at the end of the file (setting up the
+;;;; global environment and starting the driver loop).
+
+;;;;**WARNING: Don't load this file twice (or you'll lose the primitives
+;;;;  interface, due to renamings of apply).
+
+;;;from section 4.1.4 -- must precede def of metacircular apply
+(define apply-in-underlying-scheme apply)
+
+;;;SECTION 4.1.1
+
+(define (eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        ((quoted? exp) (text-of-quotation exp))
+        ((assignment? exp) (eval-assignment exp env))
+        ((definition? exp) (eval-definition exp env))
+        ((if? exp) (eval-if exp env))
+        ((lambda? exp)
+         (make-procedure (lambda-parameters exp)
+                         (lambda-body exp)
+                         env))
+        ((begin? exp)
+         (eval-sequence (begin-actions exp) env))
+        ((cond? exp) (eval (cond->if exp) env))
+        ((application? exp)
+         (apply (eval (operator exp) env)
+                (list-of-values (operands exp) env)))
+        (else
+         (error "Unknown expression type -- EVAL" exp))))
+
+(define (apply procedure arguments)
+  (cond ((primitive-procedure? procedure)
+         (apply-primitive-procedure procedure arguments))
+        ((compound-procedure? procedure)
+         (eval-sequence
+           (procedure-body procedure)
+           (extend-environment
+             (procedure-parameters procedure)
+             arguments
+             (procedure-environment procedure))))
+        (else
+         (error
+          "Unknown procedure type -- APPLY" procedure))))
+
+
+(define (list-of-values exps env)
+  (if (no-operands? exps)
+      '()
+      (cons (eval (first-operand exps) env)
+            (list-of-values (rest-operands exps) env))))
+
+(define (eval-if exp env)
+  (if (true? (eval (if-predicate exp) env))
+      (eval (if-consequent exp) env)
+      (eval (if-alternative exp) env)))
+
+(define (eval-sequence exps env)
+  (cond ((last-exp? exps) (eval (first-exp exps) env))
+        (else (eval (first-exp exps) env)
+              (eval-sequence (rest-exps exps) env))))
+
+(define (eval-assignment exp env)
+  (set-variable-value! (assignment-variable exp)
+                       (eval (assignment-value exp) env)
+                       env)
+  'ok)
+
+(define (eval-definition exp env)
+  (define-variable! (definition-variable exp)
+                    (eval (definition-value exp) env)
+                    env)
+  'ok)
+
+;;;SECTION 4.1.2
+
+(define (self-evaluating? exp)
+  (cond ((number? exp) true)
+        ((string? exp) true)
+        ((eq? exp #t) true)
+        ((eq? exp #f) true)
+        (else false)))
+
+(define (quoted? exp)
+  (tagged-list? exp 'quote))
+
+(define (text-of-quotation exp) (cadr exp))
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+      (eq? (car exp) tag)
+      false))
+
+(define (variable? exp) (symbol? exp))
+
+(define (assignment? exp)
+  (tagged-list? exp 'set!))
+
+(define (assignment-variable exp) (cadr exp))
+
+(define (assignment-value exp) (caddr exp))
+
+
+(define (definition? exp)
+  (tagged-list? exp 'define))
+
+(define (definition-variable exp)
+  (if (symbol? (cadr exp))
+      (cadr exp)
+      (caadr exp)))
+
+(define (definition-value exp)
+  (if (symbol? (cadr exp))
+      (caddr exp)
+      (make-lambda (cdadr exp)
+                   (cddr exp))))
+
+(define (lambda? exp) (tagged-list? exp 'lambda))
+
+(define (lambda-parameters exp) (cadr exp))
+(define (lambda-body exp) (cddr exp))
+
+(define (make-lambda parameters body)
+  (cons 'lambda (cons parameters body)))
+
+
+(define (if? exp) (tagged-list? exp 'if))
+
+(define (if-predicate exp) (cadr exp))
+
+(define (if-consequent exp) (caddr exp))
+
+(define (if-alternative exp)
+  (if (not (null? (cdddr exp)))
+      (cadddr exp)
+      'false))
+
+(define (make-if predicate consequent alternative)
+  (list 'if predicate consequent alternative))
+
+
+(define (begin? exp) (tagged-list? exp 'begin))
+
+(define (begin-actions exp) (cdr exp))
+
+(define (last-exp? seq) (null? (cdr seq)))
+(define (first-exp seq) (car seq))
+(define (rest-exps seq) (cdr seq))
+
+(define (sequence->exp seq)
+  (cond ((null? seq) seq)
+        ((last-exp? seq) (first-exp seq))
+        (else (make-begin seq))))
+
+(define (make-begin seq) (cons 'begin seq))
+
+
+(define (application? exp) (pair? exp))
+(define (operator exp) (car exp))
+(define (operands exp) (cdr exp))
+
+(define (no-operands? ops) (null? ops))
+(define (first-operand ops) (car ops))
+(define (rest-operands ops) (cdr ops))
+
+
+(define (cond? exp) (tagged-list? exp 'cond))
+
+(define (cond-clauses exp) (cdr exp))
+
+(define (cond-else-clause? clause)
+  (eq? (cond-predicate clause) 'else))
+
+(define (cond-predicate clause) (car clause))
+
+(define (cond-actions clause) (cdr clause))
+
+(define (cond->if exp)
+  (expand-clauses (cond-clauses exp)))
+
+(define (expand-clauses clauses)
+  (if (null? clauses)
+      'false                          ; no else clause
+      (let ((first (car clauses))
+            (rest (cdr clauses)))
+        (if (cond-else-clause? first)
+            (if (null? rest)
+                (sequence->exp (cond-actions first))
+                (error "ELSE clause isn't last -- COND->IF"
+                       clauses))
+            (make-if (cond-predicate first)
+                     (sequence->exp (cond-actions first))
+                     (expand-clauses rest))))))
+
+;;;SECTION 4.1.3
+
+(define (true? x)
+  (not (eq? x false)))
+
+(define (false? x)
+  (eq? x false))
+
+
+(define (make-procedure parameters body env)
+  (list 'procedure parameters body env))
+
+(define (compound-procedure? p)
+  (tagged-list? p 'procedure))
+
+
+(define (procedure-parameters p) (cadr p))
+(define (procedure-body p) (caddr p))
+(define (procedure-environment p) (cadddr p))
+
+
+(define (enclosing-environment env) (cdr env))
+
+(define (first-frame env) (car env))
+
+(define the-empty-environment '())
+
+(define (make-frame variables values)
+  (cons variables values))
+
+(define (frame-variables frame) (car frame))
+(define (frame-values frame) (cdr frame))
+
+(define (add-binding-to-frame! var val frame)
+  (set-car! frame (cons var (car frame)))
+  (set-cdr! frame (cons val (cdr frame))))
+
+(define (extend-environment vars vals base-env)
+  (if (= (length vars) (length vals))
+      (cons (make-frame vars vals) base-env)
+      (if (< (length vars) (length 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 (car vars))
+             (car vals))
+            (else (scan (cdr vars) (cdr 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 (set-variable-value! var val env)
+  (define (env-loop env)
+    (define (scan vars vals)
+      (cond ((null? vars)
+             (env-loop (enclosing-environment env)))
+            ((eq? var (car vars))
+             (set-car! vals val))
+            (else (scan (cdr vars) (cdr vals)))))
+    (if (eq? env the-empty-environment)
+        (error "Unbound variable -- SET!" 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 (car vars))
+             (set-car! vals val))
+            (else (scan (cdr vars) (cdr vals)))))
+    (scan (frame-variables frame)
+          (frame-values frame))))
+
+;;;SECTION 4.1.4
+
+(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))
+
+;[do later] (define the-global-environment (setup-environment))
+
+(define (primitive-procedure? proc)
+  (tagged-list? proc 'primitive))
+
+(define (primitive-implementation proc) (cadr proc))
+
+(define primitive-procedures
+  (list (list 'car car)
+        (list 'cdr cdr)
+        (list 'cons cons)
+        (list 'null? null?)
+;;      more primitives
+        ))
+
+(define (primitive-procedure-names)
+  (map car
+       primitive-procedures))
+
+(define (primitive-procedure-objects)
+  (map (lambda (proc) (list 'primitive (cadr proc)))
+       primitive-procedures))
+
+;[moved to start of file] (define apply-in-underlying-scheme apply)
+
+(define (apply-primitive-procedure proc args)
+  (apply-in-underlying-scheme
+   (primitive-implementation proc) args))
+
+
+
+(define input-prompt ";;; M-Eval input:")
+(define output-prompt ";;; M-Eval value:")
+
+(define (driver-loop)
+  (prompt-for-input input-prompt)
+  (let ((input (read)))
+    (let ((output (eval input the-global-environment)))
+      (announce-output output-prompt)
+      (user-print output)))
+  (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)))
+
+;;;Following are commented out so as not to be evaluated when
+;;; the file is loaded.
+;;(define the-global-environment (setup-environment))
+;;(driver-loop)
+
+'METACIRCULAR-EVALUATOR-LOADED
+
+
+;;;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))
+
+;; 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))
+        ((quoted? exp) (analyze-quoted exp))
+        ((variable? exp) (analyze-variable exp))
+        ((assignment? exp) (analyze-assignment exp))
+        ((definition? exp) (analyze-definition exp))
+        ((if? exp) (analyze-if exp))
+        ((lambda? exp) (analyze-lambda exp))
+        ((begin? exp) (analyze-sequence (begin-actions exp)))
+        ((cond? exp) (analyze (cond->if exp)))
+        ((let? exp) (analyze (let->combination exp))) ;**
+        ((amb? exp) (analyze-amb exp))                ;**
+        ((application? exp) (analyze-application exp))
+        (else
+         (error "Unknown expression type -- ANALYZE" exp))))
+
+(define (ambeval exp env succeed fail)
+  ((analyze exp) env succeed fail))
+
+;;;Simple expressions
+
+(define (analyze-self-evaluating exp)
+  (lambda (env succeed fail)
+    (succeed exp fail)))
+
+(define (analyze-quoted exp)
+  (let ((qval (text-of-quotation exp)))
+    (lambda (env succeed fail)
+      (succeed qval 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))
+        (bproc (analyze-sequence (lambda-body exp))))
+    (lambda (env succeed fail)
+      (succeed (make-procedure vars bproc env)
+               fail))))
+
+;;;Conditionals and sequences
+
+(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
+             ;; success continuation for evaluating the predicate
+             ;; to obtain pred-value
+             (lambda (pred-value fail2)
+               (if (true? pred-value)
+                   (cproc env succeed fail2)
+                   (aproc env succeed fail2)))
+             ;; failure continuation for evaluating the predicate
+             fail))))
+
+(define (analyze-sequence exps)
+  (define (sequentially a b)
+    (lambda (env succeed fail)
+      (a env
+         ;; success continuation for calling a
+         (lambda (a-value fail2)
+           (b env succeed fail2))
+         ;; failure continuation for calling a
+         fail)))
+  (define (loop first-proc rest-procs)
+    (if (null? rest-procs)
+        first-proc
+        (loop (sequentially first-proc (car rest-procs))
+              (cdr rest-procs))))
+  (let ((procs (map analyze exps)))
+    (if (null? procs)
+        (error "Empty sequence -- ANALYZE"))
+    (loop (car procs) (cdr procs))))
+
+;;;Definitions and assignments
+
+(define (analyze-definition exp)
+  (let ((var (definition-variable exp))
+        (vproc (analyze (definition-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+             (lambda (val fail2)
+               (define-variable! var val env)
+               (succeed 'ok fail2))
+             fail))))
+
+(define (analyze-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+             (lambda (val fail2)        ; *1*
+               (let ((old-value
+                      (lookup-variable-value var env)))
+                 (set-variable-value! var val env)
+                 (succeed 'ok
+                          (lambda ()    ; *2*
+                            (set-variable-value! var
+                                                 old-value
+                                                 env)
+                            (fail2)))))
+             fail))))
+
+;;;Procedure applications
+
+(define (analyze-application exp)
+  (let ((fproc (analyze (operator exp)))
+        (aprocs (map 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))))
+
+(define (get-args aprocs env succeed fail)
+  (if (null? aprocs)
+      (succeed '() fail)
+      ((car aprocs) env
+                    ;; success continuation for this aproc
+                    (lambda (arg fail2)
+                      (get-args (cdr aprocs)
+                                env
+                                ;; success continuation for recursive
+                                ;; call to get-args
+                                (lambda (args fail3)
+                                  (succeed (cons arg args)
+                                           fail3))
+                                fail2))
+                    fail)))
+
+(define (execute-application proc args succeed fail)
+  (cond ((primitive-procedure? proc)
+         (succeed (apply-primitive-procedure proc args)
+                  fail))
+        ((compound-procedure? proc)
+         ((procedure-body proc)
+          (extend-environment (procedure-parameters proc)
+                              args
+                              (procedure-environment proc))
+          succeed
+          fail))
+        (else
+         (error
+          "Unknown procedure type -- EXECUTE-APPLICATION"
+          proc))))
+
+;;;amb expressions
+
+(define (analyze-amb exp)
+  (let ((cprocs (map analyze (amb-choices exp))))
+    (lambda (env succeed fail)
+      (define (try-next choices)
+        (if (null? choices)
+            (fail)
+            ((car choices) env
+                           succeed
+                           (lambda ()
+                             (try-next (cdr choices))))))
+      (try-next cprocs))))
+
+;;;Driver loop
+
+(define input-prompt ";;; Amb-Eval input:")
+(define output-prompt ";;; Amb-Eval value:")
+
+(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 a new problem ")
+            (ambeval input
+                     the-global-environment
+                     ;; ambeval success
+                     (lambda (val next-alternative)
+                       (announce-output output-prompt)
+                       (user-print val)
+                       (internal-loop next-alternative))
+                     ;; ambeval failure
+                     (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))))
+
+
+
+;;; Support for Let (as noted in footnote 56, p.428)
+
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-bindings exp) (cadr exp))
+(define (let-body exp) (cddr exp))
+
+(define (let-var binding) (car binding))
+(define (let-val binding) (cadr binding))
+
+(define (make-combination operator operands) (cons operator operands))
+
+(define (let->combination exp)
+  ;;make-combination defined in earlier exercise
+  (let ((bindings (let-bindings exp)))
+    (make-combination (make-lambda (map let-var bindings)
+                                   (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
+;;  support for Prime?); integer? and sqrt for exercise code;
+;;  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 'abs abs)
+        (list 'remainder remainder)
+        (list 'integer? integer?)
+        (list 'sqrt sqrt)
+        (list 'eq? eq?)
+;;      more primitives
+        ))
+
+
+'AMB-EVALUATOR-LOADED