44 lines
1.2 KiB
Scheme
44 lines
1.2 KiB
Scheme
#lang racket
|
|
|
|
(require racket/fixnum)
|
|
|
|
(provide interp-R1 interp-exp env-head-value env-head-symbol eval-symbol add-binding)
|
|
|
|
(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)]))
|