Permalink
Browse files

ch4

  • Loading branch information...
1 parent 2275fc3 commit e7fad46e1ebba3c8127bb9dd10674727b4166347 @flaming0 committed Aug 30, 2012
Showing with 63 additions and 0 deletions.
  1. +4 −0 ch4/ex4-18.scm
  2. +8 −0 ch4/ex4-19.scm
  3. +30 −0 ch4/ex4-20.scm
  4. +10 −0 ch4/ex4-21.scm
  5. +11 −0 ch4/test_interpreter.scm
View
@@ -0,0 +1,4 @@
+;; Example 4.18
+
+;; doesn't work
+;; test solution works
View
@@ -0,0 +1,8 @@
+;; Example 4.19
+
+(let ((a 1))
+ (define (f x)
+ (define b (+ a x))
+ (define a 5)
+ (+ a b))
+ (f 10))
View
@@ -0,0 +1,30 @@
+;; Example 4.20
+
+;; ((letrec? exp) (meval (letrec->let (cdr exp)) env))
+
+(define (make-begin seq) (cons 'begin seq))
+
+(define (tagged-list? exp tag)
+ (if (pair? exp)
+ (eq? (car exp) tag)
+ #f))
+
+;; a
+
+(define (letrec? exp) (tagged-list? exp 'letrec))
+(define (letrec-vars-and-exps exp) (car exp))
+(define (letrec-body exp) (cdr exp))
+(define (letrec->let exp)
+ (list 'let
+ (map (lambda (var-exp) (list (car var-exp) ''*unassigned)) (letrec-vars-and-exps exp))
+ (make-begin (append (map (lambda (var-exp) (list 'set! (car var-exp) (cadr var-exp))) (letrec-vars-and-exps exp))
+ (letrec-body exp)))))
+
+(define t '(letrec ((y 2)
+ (x 42))
+ (+ x y)
+ (* x y)))
+
+(letrec->let (cdr t))
+
+;; b
View
@@ -0,0 +1,10 @@
+;; Example 4.21
+
+((lambda (n)
+ ((lambda (fact)
+ (fact fact n))
+ (lambda (ft k)
+ (if (= k 1)
+ 1
+ (* k (ft ft (- k 1)))))))
+ 10)
@@ -32,6 +32,7 @@
((or? exp) (eval-or (or-operands exp) env))
((let? exp) (meval (let->combination (cdr exp)) env))
((let*? exp) (meval (let*->nested-lets (cdr exp)) env))
+ ((letrec? exp) (meval (letrec->let (cdr exp)) env))
((lambda? exp)
(make-procedure (lambda-parameters exp)
(lambda-body exp)
@@ -191,6 +192,16 @@
(helper (cdr var-exps) body))))
(helper (let*-vars-and-exps exp) (let*-body exp)))
+;; letrec stuff
+(define (letrec? exp) (tagged-list? exp 'letrec))
+(define (letrec-vars-and-exps exp) (car exp))
+(define (letrec-body exp) (cdr exp))
+(define (letrec->let exp)
+ (list 'let
+ (map (lambda (var-exp) (list (car var-exp) ''*unassigned)) (letrec-vars-and-exps exp))
+ (make-begin (append (map (lambda (var-exp) (list 'set! (car var-exp) (cadr var-exp))) (letrec-vars-and-exps exp))
+ (letrec-body exp)))))
+
;; begin
(define (begin? exp) (tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))

0 comments on commit e7fad46

Please sign in to comment.