1(define (make-env) '())
2
3(define (extend-env name value env)
4 (cons (cons name value) env))
5
6(define (lookup-env name env)
7 (cond
8 ((null? env) (error "Unbound variable" name))
9 ((eq? (caar env) name) (cdar env))
10 (else (lookup-env name (cdr env)))))
11
12(define (eval-expr expr env)
13 (cond
14 ((number? expr) expr)
15 ((string? expr) expr)
16 ((symbol? expr) (lookup-env expr env))
17 ((eq? (car expr) 'quote) (cadr expr))
18 ((eq? (car expr) 'if)
19 (if (eval-expr (cadr expr) env)
20 (eval-expr (caddr expr) env)
21 (eval-expr (cadddr expr) env)))
22 ((eq? (car expr) 'lambda)
23 (list 'closure (cadr expr) (caddr expr) env))
24 ((eq? (car expr) 'let)
25 (let* ((bindings (cadr expr))
26 (body (caddr expr))
27 (new-env
28 (fold-left
29 (lambda (e binding)
30 (extend-env
31 (car binding)
32 (eval-expr (cadr binding) env)
33 e))
34 env
35 bindings)))
36 (eval-expr body new-env)))
37 (else (apply-proc
38 (eval-expr (car expr) env)
39 (map (lambda (arg)
40 (eval-expr arg env))
41 (cdr expr))))))
42
43(define (apply-proc proc args)
44 (cond
45 ((and (list? proc) (eq? (car proc) 'closure))
46 (let ((params (cadr proc))
47 (body (caddr proc))
48 (closed-env (cadddr proc)))
49 (let ((new-env
50 (fold-left
51 (lambda (env pair)
52 (extend-env (car pair) (cdr pair) env))
53 closed-env
54 (map cons params args))))
55 (eval-expr body new-env))))
56 ((procedure? proc) (apply proc args))
57 (else (error "Not a procedure" proc))))
58
59(define (fold-left f init lst)
60 (if (null? lst)
61 init
62 (fold-left f (f init (car lst)) (cdr lst))))
63
64(define (fold-right f init lst)
65 (if (null? lst)
66 init
67 (f (car lst) (fold-right f init (cdr lst)))))
68
69(define (my-map f lst)
70 (fold-right (lambda (x acc) (cons (f x) acc))
71 '()
72 lst))
73
74(define (my-filter pred lst)
75 (fold-right (lambda (x acc)
76 (if (pred x) (cons x acc) acc))
77 '()
78 lst))