recursion - Getting rid of outer parentheses on a list -
the particular problem have creating solution question 4.16b of structure , interpretation of computer programs. here procedure needs created 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) not this, instead transforms into:
(lambda (a b) (let ((u *unassigned*) (v *unassigned*)) ((set! u 'u) (set! v 'v)) ('e1)))
here have problem list of sets!
produced make-sets
(see below) , rest of body (('e1)
above) produced cons current-element rest-of-body
(see below). added lists, while want have them single statements, i.e., (set! u 'u) (set! v 'v)
instead of ((set! u 'u) (set! v 'v))
, 'e1
instead of `('e1).
procedure:
;; b. write procedure scan-out-defines takes procedure body , returns ;; equivalent 1 has no internal definitions, making transformation ;; described above. (define (scan-out expr) (let ((vars (cadr expr)) (body (cddr expr))) (make-lambda vars ; loop on body, ; store definition names , bodies of defines ; once finished looping transform lets ; rest added 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 transformed into: ; => (lambda (a b) ; (let ((u '*unassigned*) ; (v '*unassigned*)) ; (set! u 'u) ; (set! v 'v) ; 'e1)) ; transformed into: ; => (lambda (a b) ; (let ((u *unassigned*) ; (v *unassigned*)) ; ((set! u (quote u)) ; (set! v (quote v))) ; ((quote e1))))
what tried flattening lists 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 rest-of-body
stripped of outer parentheses, make-sets
still list: e.g.,
(lambda (a b) (let ((u *unassigned*) (v *unassigned*)) ((set! u 'u) (set! v 'v)) 'e1))
what proper way rid of outer parentheses?
if can me out 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 'u
identical (quote u)
.
Comments
Post a Comment