<< Previous exercise (4.7) | Index | Next exercise (4.9) >>
While the above should work, the problem with doing it with define is that it raises the possibility of nameclash issues, as define directly installs the name of the lambda in the named let into the current frame of the environment. The other possibility, which allows greater control of scope is to do it with the usual let, adding an arbitrary binding for var which is then reassigned in the body of the let expression (with a set! command) to the needed lambda before anything else is evaluated...
One approach where name of procedure is only available inside the body:
(define (let? exp) (tagged-list? exp 'let)) (define (let-has-name? exp) (symbol? (cadr exp))) (define (let-name exp) (cadr exp)) (define (let-vardefs exp) (if (let-has-name? exp) (caddr exp) (cadr exp))) (define (let-body exp) (if (let-has-name? exp) (cdddr exp) (cddr exp))) (define (let->combination exp) (let ((res (fold-right (lambda (new rem) (cons (cons (car new) (car rem)) (cons (cadr new) (cdr rem)))) (cons '() '()) (let-vardefs exp)))) (let ((vars (car res)) (vexps (cdr res))) (define proc (make-lambda vars (let-body exp))) (if (let-has-name? exp) ;;create a lambda with no args containing: ;;(i) definition of the actual lambda(proc) ;;(ii) invocation of proc with supplied expressions. ;;finally create application for this no argument lambda. (cons (make-lambda '() (list (list 'define (let-name exp) proc) (cons (let-name exp) vexps) )) '()) (cons proc vexps) ))))
I'm with this approach, that the effect of scoping can be achieved by defining a lambda with no args and calling it immediately.
(define (let->combination exp)
(if (variable? (cadr exp))
(cons (make-lambda '()
(sequence->exp (list 'define (cadr exp) (make-lambda (map car (caddr exp)
(sequence->exp (cdddr exp)))))
(list (cadr exp) (map cdr (caddr exp)))))
'())
(cons (make-lambda (let-parameter exp)
(cddr exp))
(let-arguments exp))))
; =====================expression===================== ; n >= 0 (define (expression-data exp- n) (if (and (number? n) (>= n 0)) (list-ref exp- n) (error "Error parameter of n -- EXPRESSION-DATA!"))) (define (expression-tag exp-) (expression-data exp- 0)) (define (exp-data-after-n exp- n) (if (= n 0) exp- (exp-data-after-n (cdr exp-) (- n 1)))) (define (tagged-expression? exp- tag) (if (pair? exp-) (eq? (expression-tag exp-) tag) false)) ; =====================let===================== (define (let-name exp-) (let ((name (expression-data exp- 1))) (if (variable? name) name #f))) (define (let-body exp-) (exp-data-after-n exp- (if (let-name exp-) 3 2))) (define (let-variables exp-) (expression-data exp- (if (let-name exp-) 2 1))) (define (consortium-variable consortium) (expression-data consortium 0)) (define (consortium-value consortium) (expression-data consortium 1)) (define (separate variables) (define (iter variables variable value) (if (null? variables) (cons (reverse variable) (reverse value)) (let ((first (car variables))) (iter (cdr variables) (cons (consortium-variable first) variable) (cons (consortium-value first) value))))) (iter variables '() '())) (define (is-let? exp-) (tagged-expression? exp- 'let-)) (define (make-let bindings body) (cons 'let- (cons bindings (if (is-let? body) (list body) body)))) (define (let->combination exp-) (let* ((name (let-name exp-)) (var (separate (let-variables exp-))) (lambda-exp (make-lambda (car var) (let-body exp-)))) (if name (make-let (list (list name lambda-exp)) (list (cons 'call (cons name (cdr var))))) (cons 'call (cons lambda-exp (cdr var)))))) (put 'eval 'let- (lambda (exp- env) (eval- (let->combination exp-) env)))
Could define named let selectors if need be.
(define (let->combination exp) (if (symbol? (cadr exp)) (list (make-lambda (list (cadr exp)) (list (cadddr exp))) (caddr exp)) (cons (make-lambda (let-vars exp) (let-body exp)) (let-exps exp)))) ;; test (eval (let->combination '(let a 0 (+ 1 a))) test-env) ;; 1
;; selectors (define (let-bindings exp) (if (named-let? exp) (caddr exp) (cadr exp))) (define (let-body exp) (if (named-let? exp) (cadddr exp) (caddr exp))) (define (bindings->params bindings) (if (null? bindings) bindings (cons (caar bindings) (bindings->params (cdr bindings))))) (define (bindings->args bindings) (if (null? bindings) bindings (cons (cadar bindings) (bindings->args (cdr bindings))))) (define (named-let? exp) (not (pair? (cadr exp)))) (define (let-var exp) (cadr exp)) (define (let->combination exp) (if (named-let? exp) (named-let->combination exp) (cons (make-lambda (bindings->params (let-bindings exp)) (list (let-body exp))) (bindings->args (let-bindings exp))))) ;; binding let var and bindings with lambdas (define (named-let->combination exp) (cons (list (make-lambda '(f) '((f f))) (make-lambda (list (let-var exp)) (list (make-lambda (bindings->params (let-bindings exp)) (list (list (make-lambda (list (let-var exp)) (list (let-body exp))) (list (let-var exp) (let-var exp)))))))) (bindings->args (let-bindings exp)))) ; (let->combination '(let ! ((x 5)) (if (< x 2) 1 (* (! (- x 1)) x)))) ; ; -> (((lambda (f) (f f)) ; (lambda (!) ; (lambda (x) ; ((lambda (!) ; (if (< x 2) 1 ; (* (! (- x 1)) x))) ; (! !))))) ; 5) ; ; -> 120
I'm bad at naming variables, but this code should work fine.
(define (let->combination exp) (if (named-let? exp) ;; named let (let ((proc-name (let-name exp)) (body (let-body exp)) (bindings (let-bindings exp))) (let ((params (let-parameters bindings)) (vals (let-init-vals bindings))) (make-begin (list (list 'define (cons proc-name params) body) (cons proc-name vals))))) ;; ordinary let (let ((binds (bindings exp)) (exp-body (body exp))) (let ((params (parameters binds)) (exps (expresions binds))) (cons (make-lambda params exp-body) exps))))) (define (named-let? exp) (not (pair? (cadr exp)))) (define (let-name exp) (cadr exp)) (define (let-bindings exp) (caddr exp)) (define (let-body exp) (cadddr exp)) (define (let-parameters binds) (map (lambda (x) (car x)) binds)) (define (let-init-vals binds) (map (lambda (x) (cadr x)) binds)) (define (make-begin seq) (cons 'begin seq))
;;; test (define exp '(let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) (let->combination exp) ;;; output '(begin (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n))
meteorgan