39 lines
1014 B
Scheme
39 lines
1014 B
Scheme
(use-modules (ice-9 match)
|
|
(srfi srfi-64))
|
|
|
|
(define (meaning expr)
|
|
(match expr
|
|
[`(lambda (,var) ,expr)
|
|
(lambda (env)
|
|
(lambda (e)
|
|
((meaning expr) (rename env e var))))]
|
|
[(exp0 exp1)
|
|
(lambda (env)
|
|
(((meaning exp0) env) ((meaning exp1) env)))]
|
|
[var (lambda (env) (env var))]))
|
|
|
|
(define (rename env var e)
|
|
(let ([v (env var)])
|
|
(lambda (var)
|
|
(if (eq? e var)
|
|
v
|
|
(env var)))))
|
|
|
|
;; Okay this isn't really that useful
|
|
(define (echo-env)
|
|
(lambda (x) x))
|
|
(test-begin "echo-env")
|
|
(test-eq 'x ((meaning 'x) (echo-env)))
|
|
(test-eq 'y ((meaning '((lambda (x) x) y)) (echo-env)))
|
|
(test-end "echo-env")
|
|
|
|
(define (successor-env)
|
|
(lambda (x)
|
|
(cond
|
|
[(number? x) x]
|
|
[else (lambda (x) (+ x 1))])))
|
|
(test-begin "successor-env")
|
|
(test-eqv 1 ((meaning '(((lambda (f) (lambda (x) (f x))) succ) 0)) (successor-env)))
|
|
(test-eqv 2 ((meaning '(((lambda (f) (lambda (x) (f (f x)))) succ) 0)) (successor-env)))
|
|
(test-end "successor-env")
|