-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathexercise-4.8.scm
75 lines (72 loc) · 2.37 KB
/
exercise-4.8.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
;; Exercise 4.8
;; Installed as a package
(define (let-package install-proc eval)
;; Internal definitions
(define (named-let? exp)
(symbol? (cadr exp)))
(define (named-let-name exp)
(cadr exp))
(define (named-let-vars exp)
(define (named-let-vars-helper bindings)
(if (null? bindings) '()
(cons (car (car bindings))
(named-let-vars-helper (cdr bindings)))))
(named-let-vars-helper (caddr exp)))
(define (named-let-body exp)
(cadddr exp))
(define (make-def name parameters body)
(list 'define (cons name parameters) body))
(define (named-let-args exp)
(define (named-let-args-helper bindings)
(if (null? bindings) '()
(cons (cadr (car bindings))
(named-let-args-helper (cdr bindings)))))
(named-let-args-helper (caddr exp)))
(define (make-named-let exp)
(let* ((definition (make-def (named-let-name exp)
(named-let-vars exp)
(named-let-body exp)))
(thunk (make-lambda nil (list definition
(named-let-name exp))))
(args (named-let-args exp)))
(cons (list thunk) args)))
(define (let-bindings exp) (cadr exp))
(define (let-body exp) (cddr exp))
(define (binding-exps bindings)
(if (null? bindings)
'()
(cons (cadar bindings)
(binding-exps (cdr bindings)))))
(define (binding-var binding) (car binding))
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (let->combination exp)
(cond ((named-let? exp) (make-named-let exp))
(else
(cons (make-lambda
(map binding-var (let-bindings exp))
(let-body exp))
(binding-exps (let-bindings exp))))))
;; Interface
(install-proc
(list
(list 'eval 'let (lambda (exp env) (eval (let->combination exp) env)))))
'let-package-installed!)
;; tests
(define (test4-8)
(define expression
'(let fib-iter ((a 1)
(b 0)
(count 20))
(if (= count 0)
b
(fib-iter (+ a b) a (- count 1)))))
(define target
'(((lambda ()
(define (fib-iter a b count)
(if (= count 0)
b
(fib-iter (+ a b) a (- count 1))))
fib-iter)) 1 0 20))
(define result (let->combination expression))
(equal? result target))