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

Popular posts from this blog

Hatching array of circles in AutoCAD using c# -

ios - UITEXTFIELD InputView Uipicker not working in swift -

Python Pig Latin Translator -