64 lines
1.5 KiB
Scheme
64 lines
1.5 KiB
Scheme
#lang racket
|
|
|
|
(require racket/fixnum)
|
|
|
|
|
|
(define (interp-R1 env)
|
|
(lambda (p)
|
|
(match p
|
|
[`(program ,data ,exp) ((interp-exp env) exp)])))
|
|
|
|
(define (interp-exp env)
|
|
(lambda (sexp)
|
|
(match sexp
|
|
[(? fixnum?) sexp]
|
|
[(? symbol?) (eval-symbol env sexp)]
|
|
[`(read) (read-fixnum)]
|
|
[`(- ,e) (fx- 0 ((interp-exp env) e))]
|
|
[`(+ ,e1 ,e2) (fx+ ((interp-exp env) e1) ((interp-exp env) e2))]
|
|
[`(let ([,var ,rexp]) ,body)
|
|
(let ([value ((interp-exp env) rexp)])
|
|
((interp-exp (add-binding env (list var value))) body))])))
|
|
|
|
(define (read-fixnum)
|
|
(let ([r (read)])
|
|
(cond
|
|
[(fixnum? r) r]
|
|
[else (error "invalid fixnum in input: " r)])))
|
|
|
|
(define (env-head-symbol env)
|
|
(car (car env)))
|
|
|
|
(define (env-head-value env)
|
|
(cadr (car env)))
|
|
|
|
(define (add-binding env binding)
|
|
(cons binding env))
|
|
|
|
(define (eval-symbol env s)
|
|
(cond
|
|
[(equal? env `()) (error "Symbol " s " not found")]
|
|
[(equal? (env-head-symbol env) s) (env-head-value env)]
|
|
[else (eval-symbol (cdr env) s)]))
|
|
|
|
|
|
(define (test-eq a b)
|
|
(if (equal? a b) #t (error "assert failed: " a " != " b)))
|
|
|
|
(define (ppexp exp) (begin (print (exp)) (newline)))
|
|
|
|
(test-eq (env-head-value `((a 1))) 1)
|
|
(test-eq (env-head-symbol `((a 1))) `a)
|
|
(test-eq (eval-symbol `((a 1)) `a) 1)
|
|
(test-eq
|
|
(let ([env `((a 1) (b 2))])
|
|
((interp-exp env) `(+ a (- b))))
|
|
-1)
|
|
(test-eq
|
|
((interp-exp `()) `(let ([a (+ 1 2)]) (+ a 3)))
|
|
6)
|
|
|
|
(test-eq
|
|
((interp-R1 `()) `(program `() (let ([a (+ 1 2)]) (+ a 3))))
|
|
6)
|