【问题标题】:Getting rid of outer parentheses on a list摆脱列表中的外括号
【发布时间】:2023-04-05 18:05:01
【问题描述】:

我遇到的特殊问题是为question 4.16b of Structure and Interpretation of Computer Programs 创建解决方案。这里需要创建一个转换过程

(lambda (a b)
  (define u 'u)
  (define v 'v)
   'e1))

进入:

(lambda (a b)
  (let ((u '*unassigned*)
        (v '*unassigned*))
    (set! u 'u)
    (set! v 'v)
    'e1))

我的程序(见下文)没有这样做,而是将其转换为:

(lambda (a b) 
  (let ((u *unassigned*) 
        (v *unassigned*)) 
    ((set! u 'u) 
     (set!  v 'v)) 
    ('e1))) 

这里我们对make-sets(见下文)生成的sets! 列表和cons current-element rest-of-body(见下文)生成的正文的其余部分(上文('e1))存在问题。它们被添加到列表中,而我希望将它们作为单个语句,即 (set! u 'u) (set! v 'v) 而不是 ((set! u 'u) (set! v 'v))'e1 而不是 `('e1)。

程序:

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

我尝试的是像这样展平列表:

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

但是只有 rest-of-body 被去掉了它的外括号,make-sets 仍然是一个列表:例如,

(lambda (a b) 
  (let ((u *unassigned*) 
        (v *unassigned*)) 
    ((set! u 'u) 
     (set! v 'v)) 
    'e1))

去掉外括号的正确方法是什么?

如果有人能帮我解决这个问题,将不胜感激。

【问题讨论】:

    标签: recursion scheme flatten sicp


    【解决方案1】:

    你应该改变:

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

    还有:

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

    最后请注意'u(quote u) 相同。

    【讨论】:

    • 嗨伦佐!非常感谢!!! :D 只更改transform-define-into-let 就足够了。请注意,make-unassigned-vars 在您的答案中没有改变。 ;)
    • 不客气!注意*unassigned*前有两个单引号(''),否则生成(u *unassigned*)而不是(u '*unassigned*)
    • 啊,我现在明白了。下次我用程序而不是我的眼睛来区分,然后再说一些没有改变的东西。显然,引号是一个身份运算符,它对自身进行评估(一次)(source)。我没有看到为什么''a 不评估为a(两次获取身份)。
    • 引用解释得很好here
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-12-23
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多