Implement 5.30; on to last section; let's go!

misc/sicp-eceval-support.scm

@@ -185,10 +185,32 @@
 
 (define apply-in-underlying-scheme apply)
 
+(define (check-apply-primitive proc args)
+  (cond
+    ((eq? proc /) (check-apply-division args))
+    ((eq? proc car) (check-apply-car args))
+    (else 'ok)))
+
+(define (apply-primitive-error? val)
+  (eq? (car val) 'error))
+
+(define (apply-primitive-result val) (cadr val))
+
+(define (apply-primitive-procedure-safe proc args)
+  (let ((code (check-apply-primitive
+                (primitive-implementation proc)
+                args)))
+    (if (eq? code 'ok)
+      (list 'ok
+            (apply-in-underlying-scheme
+              (primitive-implementation proc)
+              args))
+      (list 'error code))))
+
 (define (apply-primitive-procedure proc args)
   (apply-in-underlying-scheme
-   (primitive-implementation proc) args))
-
+    (primitive-implementation proc)
+    args))
 
 (define (prompt-for-input string)
   (newline) (newline) (display string) (newline))
@@ -203,7 +225,7 @@
                      (procedure-body object)
                      '<procedure-env>))
       (display object)))
-
+
 ;;; Simulation of new machine operations needed by
 ;;;  eceval machine (not used by compiled code)
 
@@ -312,5 +334,8 @@
 
    ;;5.30
    (list 'unbound-variable? unbound-variable?)
+   (list 'apply-primitive-procedure-safe apply-primitive-procedure-safe)
+   (list 'apply-primitive-result apply-primitive-result)
+   (list 'apply-primitive-error? apply-primitive-error?)
 
    ))