Implement till 4.21
parent
4c9dc3138b
commit
f2cd087e04
115
ex-4_11-xx.scm
115
ex-4_11-xx.scm
|
@ -244,7 +244,7 @@
|
|||
(define (make-procedure parameters body env)
|
||||
(list 'procedure parameters (scan-out-defines body) env))
|
||||
|
||||
(display "\nex-4.17\n")
|
||||
(display "\nex-4.17 - extra-frame\n")
|
||||
|
||||
; Why is there an extra frame in the transformed program? We have implemented
|
||||
; let via an additional transformation. Therefore, there is another
|
||||
|
@ -292,7 +292,116 @@
|
|||
|
||||
(display "[answered]\n")
|
||||
|
||||
(display "\nex-4.19\n")
|
||||
(display "\nex-4.19 - ambiguous-expression\n")
|
||||
|
||||
; (display "\nex-4.20\n")
|
||||
; (let ((a 1))
|
||||
; (define (f x)
|
||||
; (define b (+ a x))
|
||||
; (define a 5)
|
||||
; (+ a b))
|
||||
; (f 10))
|
||||
|
||||
; Ben: 16
|
||||
; Alyssa: error
|
||||
; Eva: 20
|
||||
|
||||
; To implement Eva's suggested behavior one could reorder the defines so that
|
||||
; defines with self-evaluating expressions are interpreted first.
|
||||
|
||||
(display "[answered]\n")
|
||||
|
||||
(display "\nex-4.20 - letrec\n")
|
||||
|
||||
(letrec ((fact
|
||||
(lambda (n)
|
||||
(if (= n 1)
|
||||
1
|
||||
(* n (fact (- n 1)))))))
|
||||
(assert (fact 10) 3628800))
|
||||
|
||||
(define letrec-before
|
||||
'(letrec ((a 3) (b 2))
|
||||
(+ a b)))
|
||||
|
||||
(define letrec-after
|
||||
'(let ((a *unassigned*) (b *unassigned*))
|
||||
(set! a 3)
|
||||
(set! b 2)
|
||||
(+ a b)))
|
||||
|
||||
(define (letrec? exp) (tagged-list exp 'letrec))
|
||||
(define (letrec-bindings exp) (cadr exp))
|
||||
(define (letrec-body exp) (cddr exp))
|
||||
(define (letrec-binding-var binding) (car binding))
|
||||
(define (letrec-binding-exp binding) (cadr binding))
|
||||
(define (letrec-vars exp) (map let-binding-var (let-bindings exp)))
|
||||
(define (letrec-exps exp) (map let-binding-exp (let-bindings exp)))
|
||||
|
||||
(define (letrec->combination exp)
|
||||
(define (binding->unassigned binding)
|
||||
(list (letrec-binding-var binding) '*unassigned*))
|
||||
(define (binding->set binding)
|
||||
(list 'set! (letrec-binding-var binding) (letrec-binding-exp binding)))
|
||||
(let* ((bindings (letrec-bindings exp))
|
||||
(bindings-unassigned (map binding->unassigned bindings))
|
||||
(let-unassigned (list 'let bindings-unassigned))
|
||||
(set-exps (map binding->set bindings))
|
||||
(body (letrec-body exp)))
|
||||
(append
|
||||
(append let-unassigned set-exps)
|
||||
body)))
|
||||
|
||||
(assert (letrec->combination letrec-before) letrec-after)
|
||||
|
||||
; b. With the let implementation the procedures odd? and even? cannot see and
|
||||
; therefore not call each other.
|
||||
|
||||
(display "\nex-4.21 - recursive-without-define/letrec\n")
|
||||
|
||||
; factorial
|
||||
(assert
|
||||
((lambda (n)
|
||||
((lambda (fact)
|
||||
(fact fact n))
|
||||
(lambda (ft k)
|
||||
(if (= k 1)
|
||||
1
|
||||
(* k (ft ft (- k 1)))))))
|
||||
10)
|
||||
3628800)
|
||||
|
||||
; a. Fibonacci
|
||||
(define (fibo n)
|
||||
(cond
|
||||
((= n 0) 0)
|
||||
((< n 3) 1)
|
||||
(else (+ (fibo (- n 2)) (fibo (- n 1))))))
|
||||
|
||||
(assert
|
||||
((lambda (n)
|
||||
((lambda (fib)
|
||||
(fib fib n))
|
||||
(lambda (f k)
|
||||
(cond
|
||||
((= k 0) 0)
|
||||
((< k 3) 1)
|
||||
(else (+ (f f (- k 2)) (f f (- k 1))))))))
|
||||
11)
|
||||
(fibo 11))
|
||||
|
||||
; b. odd?/even?
|
||||
(define (f x)
|
||||
((lambda (even? odd?)
|
||||
(even? even? odd? x))
|
||||
(lambda (ev? od? n)
|
||||
(if (= n 0) true (od? ev? od? (- n 1))))
|
||||
(lambda (ev? od? n)
|
||||
(if (= n 0) false (ev? ev? od? (- n 1))))))
|
||||
|
||||
(assert (f 31) false)
|
||||
(assert (f 42) true)
|
||||
|
||||
(display "\nex-4.22\n")
|
||||
|
||||
; (display "\nex-4.23\n")
|
||||
; (display "\nex-4.24\n")
|
||||
|
|
Loading…
Reference in New Issue