The outcome of (try try) depends upon the result of (halts? try try). If (halts? try try) returns true (i.e., try halts on try), then (try try) will run forever. Otherwise it will halt. Thus halts? does not behave correctly in this case.
The map procedure takes another procedure (say foo) and lists as its arguments. If it is implemented as a primitive, the evaluator will eventually call
(apply-in-underlying-scheme map args)
Here args is a list with procedure foo as its first element. Unfortunately the foo procedure is now a tagged list even if the original foo procedure is a primitive. Therefore, this approach will not work. If the map procedure is implemented as a compound procedure, there will be no such issue.
This suggests that any procedure which takes other procedures as arguments has to be implemented as a compound procedure rather than a primitive in the underlying Scheme.
I think make-unbound! should remove only the binding in the first frame. Otherwise we could break another environment which is extended from the enclosing environment.
(define (make-unbound! var env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (error "Unbound variable -- MAKE-UNBOUND!" var)) ((eq? var (car vars)) (set-car! vars '()) (set-car! vals '())) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame))))
(define (env-loop var null-action eq-action env) (define (scan vars vals) (cond ((null? vars) (null-action env)) ((eq? var (car vars)) (eq-action 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))))) ; (define (set-variable-value! var val env) (define (null-action e) (env-loop var null-action eq-action (enclosing-environment e))) (define (eq-action vs) (set-car! vs val)) (env-loop var null-action eq-action env)) ; (define (lookup-variable-value var env) (define (null-action e) (env-loop var null-action eq-action (enclosing-environment e))) (define eq-action car) (env-loop var null-action eq-action env)) ; (define (define-variable! var val env) (define (null-action e) (add-binding-to-frame! var val (first-frame e))) (define (eq-action vs) (set-car! vs val)) (env-loop var null-action eq-action env))
In the following implementation, procedure extend-environment is still the same, and procedures frame-variables and frame-values no longer exist.
(define (make-frame variables values) (if (null? variables) '() (cons (cons (car variables) (car values)) (make-frame (cdr variables) (cdr values))))) (define (add-binding-to-frame! var val frame) (define (add-new-binding! b f) (if (null? (cdr f)) (set-cdr! f b) (add-new-binding! b (cdr f)))) (add-new-binding! (list (cons var val)) frame)) (define (lookup-variable-value var env) (define (env-loop env) (define (scan frame) (cond ((null? frame) (env-loop (enclosing-environment env))) ((eq? var (car (car frame))) (cdr (car frame))) (else (scan (cdr frame))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan frame)))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan frame) (cond ((null? frame) (env-loop (enclosing-environment env))) ((eq? var (car (car frame))) (set-cdr! (car frame) val)) (else (scan (cdr frame))))) (if (eq? env the-empty-environment) (error "Unbound variable -- SET!" var) (let ((frame (first-frame env))) (scan frame)))) (env-loop env)) (define (define-variable! var val env) (define (scan frame) (cond ((null? frame) (add-binding-to-frame! var val (first-frame env))) ((eq? var (car (car frame))) (set-cdr! (car frame) val)) (else (scan (cdr frame))))) (scan (first-frame env)))
I have implemented let in SICP Exercise 4.6. In this exercise, let’s change the syntax of let to
(let ((<exp[1]> <var[1]) ... (<exp[n]> <var[n]>)) <body>)
This can be done easily. We simply need to switch procedures let-var and let-exp.
(define (let-var assignment) (if (null? assignment) '() (cons (cadr (car assignment)) (let-var (cdr assignment))))) (define (let-exp assignment) (if (null? assignment) '() (cons (car (car assignment)) (let-exp (cdr assignment)))))
I have implemented do similar to the version in MIT/GNU Scheme.
(define (eval exp env) ; ...... ((do? exp) (eval (do->combination exp) env)) ; ...... ) (define (do? exp) (tagged-list? exp 'do)) (define (do-var exp) (cadr exp)) (define (do-var-name var) (if (null? var) '() (cons (car (car var)) (do-var-name (cdr var))))) (define (do-var-init var) (if (null? var) '() (cons (cadr (car var)) (do-var-init (cdr var))))) (define (do-var-step var) (if (null? var) '() (cons (cadr (cdr (car var))) (do-var-step (cdr var))))) (define (do-test exp) (car (cadr (cdr exp)))) (define (do-command exp) (cadr (cadr (cdr exp)))) (define (do->combination exp) (transform-do (do-var exp) (do-test exp) (do-command exp))) (define (transform-do var test command) (sequence->exp (list (cons 'define (list (cons 'do-iter (do-var-name var)) (make-if test command (cons 'do-iter (do-var-step var))))) (cons 'do-iter (do-var-init var))))) ; test (define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (do ((count 1 (+ count 1)) (b 0 a) (a 1 (+ a b))) ((= count n) a (* a 10))))))
We note that
(define (fib n) (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))))
is equivalent to
(define (fib n) (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n))
Therefore we can implement “named let” as follows.
(define (named-let? exp) (if (variable? (cadr exp)) true false)) (define (named-let-name exp) (cadr exp)) (define (named-let-assignment exp) (caddr exp)) (define (named-let-body exp) (cdr (cdr (cdr exp)))) (define (let->combination exp) (if (named-let? exp) (transform-named-let (named-let-name exp) (named-let-assignment exp) (named-let-body exp)) (transform-let (let-assignment exp) (let-body exp)))) (define (transform-named-let name assignment body) (sequence->exp (list (cons 'define (cons (cons name (let-var assignment)) body)) (cons name (let-exp assignment)))))
See also SICP Exercise 4.6
(define (eval exp env) ; ...... ((let*? exp) (eval (let*->nested-lets exp) env)) ; ...... ) (define (let*? exp) (tagged-list? exp 'let*)) (define (let*-assignment exp) (cadr exp)) (define (let*-body exp) (cddr exp)) (define (let*->nested-lets exp) (transform-let* (let*-assignment exp) (let*-body exp))) (define (transform-let* assignment body) (if (null? (cdr assignment)) (cons 'let (cons assignment body)) (list 'let (list (car assignment)) (transform-let* (cdr assignment) body))))
(define (eval exp env) ; ...... ((let? exp) (eval (let->combination exp) env)) ; ...... ) (define (let? exp) (tagged-list? exp 'let)) (define (let-assignment exp) (cadr exp)) (define (let-body exp) (cddr exp)) (define (let-exp assignment) (if (null? assignment) '() (cons (cadr (car assignment)) (let-exp (cdr assignment))))) (define (let-var assignment) (if (null? assignment) '() (cons (car (car assignment)) (let-var (cdr assignment))))) (define (let->combination exp) (transform-let (let-assignment exp) (let-body exp))) (define (transform-let assignment body) (cons (make-lambda (let-var assignment) body) (let-exp assignment)))
