問題4.11

(define (make-frame variables values)
  (if (= (length variables) (length values))
      (reverse
       (let make-frame-iter ((vars variables) (vals values))
         (cons (cons (car vars) (cdr vals)) (make-frame-iter (cdr vars) (cdr vals)))))
      (error "variables length and values length are different.")))
(define (frame-variables frame) (map car frame))
(define (frame-values frame) (map cdr frame))
(define (add-binding-to-frame! var val frame)
  (set! frame (cons (cons var val) frame)))

(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan pairs)
      (cond ((null? pairs)
             (env-loop (enclosing-envrionment env)))
            ((eq? var (caar pairs))
             (cdar pairs))
            (else (scan (cdr pairs)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan frame))))
  (env-loop env))

(define (set-variable-value! var val env)
  (define (env-loop env)
    (define (scan pairs)
      (cond ((null? pairs)
             (env-loop (enclosing-environment env)))
            ((eq? var (caar pairs))
             (set-cdr! (car pairs) val))
            (else (scan (cdr pairs)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable -- SET!" var)
        (let ((frame (first-frame env)))
          (scan frame))))
  (env-loop env))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan pairs)
      (cond ((null? pairs)
             (add-binding-to-frame! var val frame))
            ((eq? var (caar pairs))
             (set-cdr! (car pairs) val))
            (else (scan (cdr pairs)))))
    (scan frame)))

問題4.10

;; しょうもない変更だが、let式を変更する。
(let ((a b)
      (c d)
      (e f)))

;; ->
(let (a b
      c d
      e f))

;; とかけるようにしよう。

(define (let->combination exp)
  (let ((second (cadr exp)))
    (let ((named? (symbol? second)))
      (let ((bindings (if named? (caddr exp) second))
            (body (if named? (cdddr exp) (cddr exp))))
        (let ((vars (let iter ((lst bindings) (acc '()))
                      (if (null? lst)
                          (reverse acc)
                          (iter (cddr lst) (cons (car lst) acc)))))
              (exps (let iter ((lst (cdr bindings)) (acc '()))
                      (if (null? (cdr lst))
                          (reverse (cons (car lst) acc))
                          (iter (cddr lst) (cons (car lst) acc))))))
          (if named?
              (list 'let bindings
                    (append (list 'define (append (list second) vars))
                            body)
                    (append (list second) vars))
              (append (list (append (list 'lambda vars) (cddr exp))) exps)))))))

(let->combination
 '(let (a 0
        b 1
        c 2)
    (+ a b c)))

;; -> ((lambda (a b c) (+ a b c)) 0 1 2)
;; ok

問題4.9

;; doを作ってみる
(do binds (predicate value) body)
;; である。
;; binds部は
((var-name initialize-value update-expression) ... )
;; である。

(do ((var-name1 initialize-value1 update-expression1)
     (var-name2 initialize-value2 update-expression2))
    (predicate value)
  body)

;; ->

(let iter ((var-name1 initialize-value1)
           (var-name2 initialize-value2))
  (if predicate
      value
      (begin
        body
        (iter update-expression1 update-expression2))))

;; となるとよい。
(define (do->named-let exp)
  (let ((binds (cadr exp))
        (predicate (caaddr exp))
        (value (car (cdaddr exp)))
        (body (cdddr exp)))
    (let ((var-inits (map (lambda (bind) (list (car bind) (cadr bind))) binds))
          (updates (map caddr binds))
          (iter-name (gensym)))
      `(let ,iter-name ,var-inits
            (if ,predicate
                ,value
                (begin
                  ,@body
                  (,iter-name ,@updates)))))))

(define (eval-do exp env)
  (eval (do->named-let exp) env))

(put 'eval 'do eval-do)


(do->named-let
 '(do ((var-name1 initialize-value1 update-expression1)
       (var-name2 initialize-value2 update-expression2))
      (predicate value)
    body))

;; ->
;(let G2 ((var-name1 initialize-value1)
;         (var-name2 initialize-value2))
;  (if predicate
;      value
;      (begin
;        body
;        (G2 update-expression1 update-expression2))))

;; ok

(let fib-iter ((a 1)
                 (b 0)
                 (count n))
    (if (= count 0)
        b
        (fib-iter (+ a b) a (- count 1))))

;; -> do化すると、

(do ((a 1 (+ a b)) (b 0 a) (count 5 (- count 1)))
    ((= count 0) b))

;; -> named-let化すると

;(let G6 ((a 1)
;         (b 0)
;         (count 5))
;  (if (= count 0)
;      b
;      (begin
;        (G6 (+ a b) a (- count 1)))))

;; ok!

問題4.8

(define (fib n)
  (let fib-iter ((a 1)
                 (b 0)
                 (count n))
    (if (= count 0)
        b
        (fib-iter (+ a b) a (- count 1)))))

;; ->

(define (fib n)
  (let ((a 1) (b 0) (count n))
    (define (fib-iter a b count)
      (if (= count 0)
          b
          (fib-iter (+ a b) a (- count 1))))
    (fib-iter a b count)))

;; こんな感じに変換できればいいかな。

(define (let->combination exp)
  (let ((second (cadr exp)))
    (let ((named? (symbol? second)))
      (let ((bindings (if named? (caddr exp) second))
            (body (if named? (cdddr exp) (cddr exp))))
        (let ((vars (map car bindings))
              (exps (map cadr bindings)))
          (if named?
              (list 'let bindings
                    (append (list 'define (append (list second) vars))
                            body)
                    (append (list second) vars))
              (append (list (append (list 'lambda vars) (cddr exp))) exps)))))))

(define (eval-let exp env)
  (eval (let->combitation exp) env))

(put 'eval 'let eval-let)

(let->combination
 '(let fib-iter ((a 1)
                 (b 0)
                 (count n))
    (if (= count 0)
        b
        (fib-iter (+ a b) a (- count 1)))))

;->
;(let ((a 1) (b 0) (count n))
;  (define (fib-iter a b count)
;    (if (= count 0)
;        b
;        (fib-iter (+ a b) a (- count 1))))
;  (fib-iter a b count))

;; ok !!

問題4.7

(let* ((x 3)
       (y (+ x 2))
       (z (+ x y 5)))
  (* x z))

;=>

(let ((x 3))
  (let ((y (+ x 2)))
    (let ((z (+ x y 5)))
      (* x z))))


(define (let*->nested-lets exp)
  (let ((bindings (cadr exp)))
    (let binds->lets ((binds bindings))
      (if (null? (cdr binds))
          (append (list 'let (list (car binds))) (cddr exp))
          (list 'let (list (car binds))
                (binds->lets (cdr binds)))))))


(define (eval-let* exp env)
  (eval (let*->nested-lets exp) env))

(put 'eval 'let* eval-let*)

;; これだけで十分なはず。

問題4.6

(define (let->combination exp)
  (let ((bindings (cadr exp)))
    (let ((vars (map car bindings))
          (exps (map cadr bindings)))
      (append (list (append (list 'lambda vars) (cddr exp))) exps))))

(define (eval-let exp env)
  (eval (let->combitation exp) env))

(put 'eval 'let eval-let)

問題4.5

(define (cond->if exp)
  (expand-clauses (cond-clauses exp)))
(define (make-if predicate consequent alternative)
  (list 'if predicate consequent alternative))

(define (cond-clauses exp) (cdr exp))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else))

(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (last-exp? seq) (null? (rest-exps seq)))
(define (make-begin seq (cons 'begin seq)))
(define (sequence->exp seq)
  (cond ((null? seq) seq)
        ((last-exp? seq) (first-exp seq))
        (else (make-begin seq))))

(define (expand-clauses clauses)
  (if (null? clauses)
      'false
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (if (cond-else-clause? first)
            (if (null? rest)
                (sequence->exp (cond-actions first))
                (error "ELSE clause isn't last -- COND->IF"
                       clauses))

            (make-if (cond-predicate first)
                     (let ((action (cond-actions first))
                           (predicate (cond-predicate first)))
                       (if (eq? (car action) '=>)
                           (list (cadr action) predicate)
                           (sequence->exp action)))

                     (expand-clauses rest))))))

;; と書きたいところだが、これだと、 (cond-predicate first) がダブっているため、predicate文に副作用のあるコードだとわかりにくいバグを仕込むことになる。

;; たとえば、
(cond->if '(cond ((x #f) => (lambda (y) (print "(x #f)='" y "' is true !.")))
                 (else '())))

;=> (if (x #f) ((lambda (y) (print "(x #f)='" y "' is true !.")) (x #f)) '())

(define x
  (let ((z #t))
    (lambda (y)
      (let ((buf z))
        (set! z y)
        buf))))

(eval '(if (x #f) ((lambda (y) (print "(x #f)='" y "' is true !.")) (x #f)) '()) '())
;=> (x #f)='#f' is true !.


;; よってこうやる。
(define (expand-clauses clauses)
  (if (null? clauses)
      'false
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (if (cond-else-clause? first)
            (if (null? rest)
                (sequence->exp (cond-actions first))
                (error "ELSE clause isn't last -- COND->IF"
                       clauses))
            (if (eq? (cadr first) '=>)

                (let ((sym (gensym)))
                  (list 'let (list (list sym (cond-predicate first)))
                        (list 'if
                              sym
                              (list (caddr first) sym)
                              (expand-clauses rest))))

                (make-if (cond-predicate first)
                         (sequence->exp action)
                         (expand-clauses rest)))))))


;; これで
(cond->if '(cond ((x #f) => (lambda (y) (print "(x #f)='" y "' is true !.")))
                 (else '())))

;=> (let ((G1 (x #f))) (if G1 ((lambda (y) (print "(x #f)='" y "' is true !.")) G1) '()))

(define x
  (let ((z #t))
    (lambda (y)
      (let ((buf z))
        (set! z y)
        buf))))

(eval '(let ((G1 (x #f))) (if G1 ((lambda (y) (print "(x #f)='" y "' is true !.")) G1) '())) '())
;(x #f)='#t' is true !.

;; ok !
;;どちらにせよ (gensym) は必要。これが正解！