The particular problem I have is with creating a solution for question 4.16b of Structure and Interpretation of Computer Programs. Here a procedure needs to be created that transforms
(lambda (a b)
(define u 'u)
(define v 'v)
'e1))
Into:
(lambda (a b)
(let ((u '*unassigned*)
(v '*unassigned*))
(set! u 'u)
(set! v 'v)
'e1))
My procedure (see below) does not do this, but instead transforms it into:
(lambda (a b)
(let ((u *unassigned*)
(v *unassigned*))
((set! u 'u)
(set! v 'v))
('e1)))
Here we have a problem with the list of sets!
produced by make-sets
(see below) and the rest of the body (('e1)
above) produced by cons current-element rest-of-body
(see below). They are added into lists, while I want to have them as single statements, i.e., (set! u 'u) (set! v 'v)
instead of ((set! u 'u) (set! v 'v))
and 'e1
instead of `('e1).
Procedure:
;; b. Write a procedure scan-out-defines that takes a procedure body and returns an
;; equivalent one that has no internal definitions, by making the transformation
;; described above.
(define (scan-out expr)
(let ((vars (cadr expr))
(body (cddr expr)))
(make-lambda vars
; loop over body,
; store all definition names and bodies of the defines
; once finished looping transform those into lets
; where the rest is added to the body
(let body-transform ((body-elements body)
(definition-names '())
(definition-bodies '())
(rest-of-body '()))
(if (null? body-elements)
(transform-define-into-let definition-names
definition-bodies
rest-of-body)
(let ((current-element (car body-elements)))
(if (tagged-list? current-element 'define)
(body-transform (cdr body-elements)
(cons (get-definition-name current-element)
definition-names)
(cons (get-definition-body current-element)
definition-bodies)
rest-of-body)
(body-transform (cdr body-elements)
definition-names
definition-bodies
(cons current-element rest-of-body)))))))))
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
(define (get-definition-name expr)
(cadr expr))
(define (get-definition-body expr)
(caddr expr))
(define (transform-define-into-let vars vals rest-of-body)
(list (list 'let (make-unassigned-vars vars)
(make-sets vars vals)
rest-of-body)))
(define (make-unassigned-vars vars)
(let aux ((var-elements vars)
(unassigned-vars '()))
(if (null? var-elements)
unassigned-vars
(aux (cdr var-elements)
(cons (list (car var-elements) '*unassigned*) unassigned-vars)))))
(define (make-sets vars vals)
(let aux ((var-elements vars)
(val-elements vals)
(sets '()))
(if (null? var-elements)
sets
(aux (cdr var-elements)
(cdr val-elements)
(cons (list 'set! (car var-elements) (car val-elements)) sets)))))
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
; testing
(scan-out '(lambda (a b)
(define u 'u)
(define v 'v)
'e1))
; Should be transformed into:
; => (lambda (a b)
; (let ((u '*unassigned*)
; (v '*unassigned*))
; (set! u 'u)
; (set! v 'v)
; 'e1))
; But is transformed into:
; => (lambda (a b)
; (let ((u *unassigned*)
; (v *unassigned*))
; ((set! u (quote u))
; (set! v (quote v)))
; ((quote e1))))
What I tried is flattening the lists like so:
(define (transform-define-into-let definition-names definition-bodies rest-of-body)
(list (list 'let (make-unassigned-vars definition-names)
(append* (make-sets definition-names definition-bodies))
(append* rest-of-body))))
but then only the rest-of-body
is stripped of its outer parentheses, make-sets
is still a list: e.g.,
(lambda (a b)
(let ((u *unassigned*)
(v *unassigned*))
((set! u 'u)
(set! v 'v))
'e1))
What is the proper way to get rid of the outer parentheses?
If anyone can help me out with this that would be greatly appreciated.
You should change:
(define (transform-define-into-let vars vals rest-of-body)
(list (list 'let (make-unassigned-vars vars)
(make-sets vars vals)
rest-of-body)))
into:
(define (transform-define-into-let vars vals rest-of-body)
(list (append (list 'let (make-unassigned-vars vars))
(append (make-sets vars vals)
rest-of-body))))
and also:
(define (make-unassigned-vars vars)
(let aux ((var-elements vars)
(unassigned-vars '()))
(if (null? var-elements)
unassigned-vars
(aux (cdr var-elements)
(cons (list (car var-elements) '*unassigned*) unassigned-vars)))))
into
(define (make-unassigned-vars vars)
(let aux ((var-elements vars)
(unassigned-vars '()))
(if (null? var-elements)
unassigned-vars
(aux (cdr var-elements)
(cons (list (car var-elements) ''*unassigned*) unassigned-vars)))))
Finally note that 'u
is identical to (quote u)
.