Implement 5.44

ex-5_39-44.scm

@@ -1,6 +1,9 @@
 (load "shared/util.scm")
 (load "shared/sicp-compiler-lexical-addressing.scm")
 
+;; stub for 5.44
+(define (primitive-procedure? exp ct-env) #f)
+
 (define (compile-to-file code target linkage file-name)
   (set! label-counter 0)
   (define (write-list-to-port xs port)
@@ -164,9 +167,24 @@
 
 (display "[done]\n")
 
-(display "\nex-5.44\n")
 
+(display "\nex-5.44 - improved-primitive-procedure\n")
 
-(display "\nex-5.45\n")
+(define (primitive-procedure? exp ct-env)
+  (define primitive-procedures '(= * - +))
+  ; Only treate the symbol (car exp) as a primitive procedure if it is *not* in
+  ; the compile-time environment.
+  (let ((var-in-ct-env (find-variable (car exp) ct-env)))
+    (and (pair? exp)
+         (eq? var-in-ct-env 'not-found)
+         (= (length exp) 3) ;; only support two args for now
+         (memq (car exp) primitive-procedures)
+         )))
 
+(compile-to-file
+  '(lambda (+ * a b x y)
+     (+ (* a x) (* b y)))
+  'val 'next "f-primitive.scm")
+
+(display "[done]\n")
 

ex-5_45-xx.scm

@@ -0,0 +1,3 @@
+(load "shared/util.scm")
+
+(display "\nex-5.45\n")

shared/sicp-compiler-lexical-addressing.scm

@@ -37,8 +37,10 @@
                            target
                            linkage))
         ((cond? exp) (compile (cond->if exp) ct-env target linkage))
-        ((primitive-procedure? exp)
+        ((primitive-procedure? exp ct-env)
-         (compile-primitive exp target linkage))
+         ;; Implementation is in ex-5_31-38.scm
+         ;; (compile-primitive exp target linkage))
+         (error "compile-primitive currently not supported for lexical-addressing"))
         ((application? exp)
          (compile-application exp ct-env target linkage))
         (else