src/sicp/ex4_8.rkt

   1 #lang racket
   2
   3 (provide let->combination)
   4
   5 (define (tagged-list? exp tag)
   6   (if (pair? exp)
   7       (eq? (car exp) tag)
   8       #f))
   9
  10 (define (variable? expr)
  11   (symbol? expr))
  12
  13 (define (make-lambda params body)
  14   (cons 'lambda (cons params body)))
  15
  16 (define (let? expr)
  17   (tagged-list? expr 'let))
  18
  19 (define (named-let? expr)
  20   (if (variable? (cadr expr))
  21       #t
  22       #f))
  23
  24 (define (let-name expr)
  25   (if (named-let? expr)
  26       (cadr expr)
  27       #f))
  28
  29 (define (let-bindings expr)
  30   (if (let-name expr)
  31       (caddr expr)
  32       (cadr expr)))
  33
  34 (define (let-bindings-variables bindings) (map car bindings))
  35 (define (let-bindings-values bindings) (map cadr bindings))
  36 (define (let-body expr)
  37   (if (let-name expr)
  38       (cdddr expr)
  39       (cddr expr)))
  40
  41 (define (let->combination expr)
  42   (let ([bindings (let-bindings expr)])
  43     (let ([vars (let-bindings-variables bindings)]
  44           [vals (let-bindings-values bindings)]
  45           [body (let-body expr)])
  46       (if (not (let-name expr))
  47           (cons (make-lambda vars body) vals)
  48           (list (list 'define (let-name expr) (make-lambda vars body))
  49                 (list (let-name expr) vals))))))
  50
  51 (define ns (make-base-namespace))
  52 (eval (let->combination '(let ((x 2) (y 3)) (+ x y))) ns)
  53 (eval (let->combination '(let ((x 2) (y 3)) (+ x y))) ns)
  54 (let->combination '(let fib-iter ((a 1)
  55                                        (b 0)
  56                                        (count n))
  57                           (if (= count 0)
  58                               b
  59                               (fib-iter (+ a b) a (- count 1)))))