3 (require (rename-in racket/base
4 (apply apply-in-underlying-scheme)
5 (eval eval-in-underlying-scheme)))
7 (define (self-evaluating? expr)
14 (define (variable? expr) (symbol? expr))
18 (define (eval-sequence exps env)
19 (cond ((last-exp? exps) (eval (first-exp exps) env))
20 (else (eval (first-exp exps) env)
21 (eval-sequence (rest-exps exps) env))))
24 (define (last-exp? seq) (null? (cdr seq)))
25 (define (first-exp seq) (car seq))
26 (define (rest-exps seq) (cdr seq))
29 (define (make-lambda parameters body)
30 (cons 'lambda (cons parameters (list body))))
32 ;; environment data structures
33 (define (enclosing-environment env) (cdr env))
34 (define (first-frame env) (car env))
35 (define the-empty-environment '())
37 (define (make-frame variables values)
38 (let ([ht (make-hash)])
39 (for-each (lambda (var val)
40 (hash-set! ht var val))
45 (define (frame-variables frame)
48 (define (frame-values frame)
51 (define (add-binding-to-frame! var val frame)
52 (hash-set! frame var val))
54 ;; environment is a list of frames, most recent being the last
55 ;; one consed into the list
56 (define (extend-environment vars vals base-env)
57 (let ([frame (make-frame vars vals)])
58 (cons frame base-env)))
60 (define (lookup-variable-value var env)
61 (if (eq? env the-empty-environment)
62 (error "unbound variable:" var)
63 (let ([frame (first-frame env)])
64 (hash-ref frame var (lambda () (lookup-variable-value var (enclosing-environment env)))))))
66 (define (set-variable-value! var val env)
67 (if (eq? env the-empty-environment)
68 (error "unbound variable")
69 (let ([frame (first-frame env)])
70 (if (hash-has-key? frame var)
71 (hash-set! frame var val)
72 (set-variable-value! var val (enclosing-environment env))))))
74 (define (define-variable! var val env)
75 (let ([frame (first-frame env)])
76 (if (hash-has-key? frame var)
77 (hash-set! frame var val)
78 (add-binding-to-frame! var val frame))))
80 ;; primitive procedure
81 (define (primitive-implementation proc) (cadr proc))
83 (define primitive-procedures
94 (define (primitive-procedure-names)
95 (map car primitive-procedures))
97 (define (primitive-procedure-objects)
98 (map (lambda (proc) (list 'primitive (cadr proc)))
99 primitive-procedures))
101 (define (apply-primitive-procedure proc args)
102 (apply-in-underlying-scheme
103 (primitive-implementation proc) args))
106 (define (setup-environment)
108 (extend-environment (primitive-procedure-names)
109 (primitive-procedure-objects)
110 the-empty-environment)))
111 (define-variable! 'true true initial-env)
112 (define-variable! 'false false initial-env)
115 (define the-global-environment (setup-environment))
118 (define (list-of-values exps env)
119 (if (no-operands? exps)
121 (cons (eval (first-operand exps) env)
122 (list-of-values (rest-operands exps) env))))
124 (define (no-operands? ops) (null? ops))
125 (define (first-operand ops) (car ops))
126 (define (rest-operands ops) (cdr ops))
128 ;; compound procedure
129 (define (make-procedure params body env)
130 (list 'procedure params body env))
132 (define (procedure-parameters p) (cadr p))
133 (define (procedure-body p) (caddr p))
134 (define (procedure-environment p) (cadddr p))
136 (define (apply procedure arguments)
138 [`(primitive ,f ...) (apply-primitive-procedure procedure arguments)]
139 [`(procedure ,f ...) (eval-sequence
140 (procedure-body procedure)
142 (procedure-parameters procedure)
144 (procedure-environment procedure)))]
145 [_ (error "Unknown procedure type -- APPLY" procedure)]))
155 (define (cond->if clauses)
156 (define (seq->exp actions)
157 (if (empty? (cdr actions))
162 (let ([clause (car clauses)])
164 [`(else ,action ...) (seq->exp action)]
165 [`(,pred ,action ...) `(if ,pred
167 ,(cond->if (cdr clauses)))]))))
170 (define (let->combination lexpr)
171 (match-let* ([`(let ,bindings ,body) lexpr]
172 [`((,var ,val) ...) bindings])
173 `((lambda ,var ,body) ,@val)))
176 (define (eval exp env)
178 [(? self-evaluating? exp) exp]
179 [(? variable? exp) (lookup-variable-value exp env)]
181 [`(set! ,var ,val) (set-variable-value! var (eval val env) env)]
182 [`(define ,(? (lambda (x) (not (pair? x))) var) ,b) (define-variable! var (eval b env) env)]
183 [`(define ,(? pair? var) ,b) (define-variable! (car var) (eval (make-lambda (cdr var) b) env) env)]
184 [`(if ,pred ,consequent ,alternative) (if (true? (eval pred env)) (eval consequent env) (eval alternative env))]
185 [`(lambda ,parameters ,body ...) (make-procedure parameters body env)]
186 [`(begin ,exp ...) (eval-sequence exp env)]
187 [`(cond ,clauses ...) (eval (cond->if clauses) env)]
188 [`(let ,bindings ,body) (eval (let->combination exp) env)]
189 [(list f x ...) (apply (eval f env) (list-of-values x env))]
190 [_ (error "unable to evaluate expression -- EVAL " exp)]))
194 (let loop ([input (read)]
195 [env the-global-environment])
196 (let ([output (eval input env)])
201 (let ([t1 (current-inexact-milliseconds)])
202 (eval expr the-global-environment)
203 (displayln (- (current-inexact-milliseconds) t1))))