From d48c389429470bc438036575c93c7cd61ecb7cdc Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Sat, 16 Jan 2021 05:19:25 -0500
Subject: [PATCH] Implement till 4.4

---
 ex-4_01-xx.scm     | 57 ++++++++++++++++++++++++++++++++++++++++++++--
 misc/evaluator.scm | 24 +++++++++++++++++++
 2 files changed, 79 insertions(+), 2 deletions(-)

diff --git a/ex-4_01-xx.scm b/ex-4_01-xx.scm
index efc9f86..6c8ee02 100644
--- a/ex-4_01-xx.scm
+++ b/ex-4_01-xx.scm
@@ -19,7 +19,60 @@
 
 (display "[done]\n")
 
-(display "\nex-4.2\n")
+(display "\nex-4.2 - explicite-call\n")
 
-(display "\nex-4.3\n")
+; Louis's plan does not work because the implementation would treat assignments
+; and definitions as applications. That means define and set! would no longer be
+; special forms.
+
+(define (application?-call exp) (tagged-list exp 'call))
+(define (operator-call exp) (cadr exp))
+(define (operands-call exp) (cddr exp))
+
+(display "[done]\n")
+
+(display "\nex-4.3 - data-directed-eval\n")
+
+(define *eval-table* (make-hash-table))
+(define (put op proc)
+  (hash-table/put! *eval-table* (list op) proc))
+(define (get op)
+  (hash-table/get *eval-table* (list op) #f))
+
+(define (install-eval-package)
+  (put 'quote (lambda (exp env) (text-of-quotation exp)))
+  (put 'set! eval-assignment)
+  (put 'define eval-definition)
+  (put 'if eval-if)
+  (put 'lambda
+       (lambda (exp env)
+         (make-procedure (lambda-parameters exp)
+                         (lambda-body exp)
+                         env)))
+  (put 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env)))
+  (put 'cond (lambda (exp env) (eval (cond->if exp) env)))
+  (put 'and (lambda (exp env) 'TODO))
+  (put 'or (lambda (exp env) 'TODO))
+  (display "[install-eval-package]\n")
+  'done)
+
+(install-eval-package)
+
+(define (eval exp env)
+  (cond
+    ((self-evaluating? exp) exp)
+    ((variable? exp) (lookup-variable-value exp env))
+    ((and (not (null? exp))
+          (get (car exp)))
+     ((get (car exp)) exp env))
+    ((application? exp)
+     (apply (eval (operator exp) env)
+            (list-of-values (operands exp) env)))
+    (else (error "Unknown expression type -- EVAL" exp))))
+
+(display "[done]\n")
+
+(display "\nex-4.5 - and/or\n")
+
+(display "\nex-4.6\n")
 
diff --git a/misc/evaluator.scm b/misc/evaluator.scm
index 0feb4df..f173049 100644
--- a/misc/evaluator.scm
+++ b/misc/evaluator.scm
@@ -134,3 +134,27 @@
 (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))))))
+
+'evaluator-loaded