Implement 5.44
parent
335d011db8
commit
57b52c35aa
|
@ -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")
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(load "shared/util.scm")
|
||||
|
||||
(display "\nex-5.45\n")
|
|
@ -37,8 +37,10 @@
|
|||
target
|
||||
linkage))
|
||||
((cond? exp) (compile (cond->if exp) ct-env target linkage))
|
||||
((primitive-procedure? exp)
|
||||
(compile-primitive exp target linkage))
|
||||
((primitive-procedure? exp ct-env)
|
||||
;; 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
|
||||
|
|
Loading…
Reference in New Issue