0

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.

user2609980
  • 10,264
  • 15
  • 74
  • 143

1 Answers1

1

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).

Renzo
  • 26,848
  • 5
  • 49
  • 61
  • Hi Renzo! Thanks a lot!!! :D Only changing the `transform-define-into-let` was enough. Note that `make-unassigned-vars` has not changed in your answer. ;) – user2609980 Jan 28 '16 at 17:22
  • You are welcome! Note that there are two single quotes ('') before `*unassigned*`, otherwise you generate `(u *unassigned*)` instead of `(u '*unassigned*)`. – Renzo Jan 28 '16 at 17:23
  • Ah I see now. Next time I diff with a program instead of my eyes before saying something has not changed. Apparently the quote is an identity operator that evaluates to itself (once) ([source](http://www.phyast.pitt.edu/~micheles/scheme/scheme8.html)). What I don't see there is why `''a` doe not evaluate to `a` (taking the identity twice). – user2609980 Jan 28 '16 at 17:40
  • 1
    Quote is very well explained [here](http://stackoverflow.com/a/34984553/2382734). – Renzo Jan 28 '16 at 17:46