SICP 4.16

为什么80%的码农都做不了架构师？>>>   

代码如下：

(define (scan-out-defines exp)
  (define (iter exp defines nodefines)
    (if (null? exp)
        (list defines nodefines)
        (let ((x (car exp)))
          (if (definition? x)
              (iter (cdr exp) (cons x defines) nodefines)
              (iter (cdr exp) defines (cons x nodefines))))))
  (define (make-bindings defines)
    (if (null? defines)
        '()
        (let ((x (car defines)))
          (cons (list (definition-variable x) '*unassigned*) (make-bindings (cdr defines))))))
  (define (make-sets defines)
    (if (null? defines)
        '()
        (let ((x (car defines)))
          (cons (list 'set!  (definition-variable x) (definition-value x))
                (make-sets (cdr defines))))))
  (let ((t (iter exp '() '())))
    (cons 'let (cons (make-bindings (car t)) (append (make-sets (car t)) (cadr t))))))

自测结果：

> (scan-out-defines '((define (iter exp defines nodefines)
    (if (null? exp)
        (list defines nodefines)
        (let ((x (car exp)))
          (if (definition? x)
              (iter (cdr exp) (cons x defines) nodefines)
              (iter (cdr exp) defines (cons x nodefines))))))
  (define (make-bindings defines)
    (if (null? defines)
        '()
        (let ((x (car defines)))
          (cons (list (definition-variable x) '*unassigned*) (make-bindings (cdr defines))))))
  (define (make-sets defines)
    (if (null? defines)
        '()
        (let ((x (car defines)))
          (cons (list 'set!  (definition-variable x) (definition-value x))
                (make-sets (cdr defines))))))
  (let ((t (iter exp '() '())))
    (cons 'let (cons (make-bindings (car t)) (append (make-sets (car t)) (cadr t)))))))
(let ((make-sets *unassigned*)
      (make-bindings *unassigned*)
      (iter *unassigned*))
  (set! make-sets
    (lambda (defines)
      (if (null? defines)
        '()
        (let ((x (car defines)))
          (cons
           (list 'set! (definition-variable x) (definition-value x))
           (make-sets (cdr defines)))))))
  (set! make-bindings
    (lambda (defines)
      (if (null? defines)
        '()
        (let ((x (car defines)))
          (cons
           (list (definition-variable x) '*unassigned*)
           (make-bindings (cdr defines)))))))
  (set! iter
    (lambda (exp defines nodefines)
      (if (null? exp)
        (list defines nodefines)
        (let ((x (car exp)))
          (if (definition? x)
            (iter (cdr exp) (cons x defines) nodefines)
            (iter (cdr exp) defines (cons x nodefines)))))))
  (let ((t (iter exp '() '())))
    (cons
     'let
     (cons (make-bindings (car t)) (append (make-sets (car t)) (cadr t))))))
> 

 

放make-procedure里好：transform代码只执行一次，eval效率高

转载于:https://my.oschina.net/guzhou/blog/1593862