Hide
Easily highlight source code for your blog with our Syntax Highlighter. Join Siafoo Now or Learn More

CS 330 Lecture 15 Interpreter Atom Feed 0

# 's
  1;;================================================================================
2;;== Lecture 15 Interpreter ==
3;;================================================================================
4
5;;================================================================================
6;;== Top Level ==
7;;================================================================================
8
9(define run
10 (lambda (string)
11 (eval-program (scan&parse string))))
12
13;;================================================================================
14;;== Grammatical Specification ==
15;;================================================================================
16
17(define the-lexical-spec
18 '((whitespace (whitespace) skip)
19 (comment ("%" (arbno (not #\newline))) skip)
20 (identifier (letter (arbno (or letter digit "_" "-" "?"))) symbol)
21 (number (digit (arbno digit)) number)))
22
23(define the-grammar
24 '((program (expression) a-program)
25
26 (expression (number) lit-exp)
27 (expression (identifier) var-exp)
28 (expression (primitive "(" (separated-list expression ",") ")") primapp-exp)
29
30 (primitive ("+") add-prim)
31 (primitive ("-") subtract-prim)
32 (primitive ("*") mult-prim)
33 (primitive ("add1") incr-prim)
34 (primitive ("sub1") decr-prim)
35
36 ))
37
38(sllgen:make-define-datatypes the-lexical-spec the-grammar)
39
40(define show-the-datatypes
41 (lambda ()
42 (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
43
44(define scan&parse
45 (sllgen:make-string-parser the-lexical-spec the-grammar))
46
47(define just-scan
48 (sllgen:make-string-scanner the-lexical-spec the-grammar))
49
50(define read-eval-print
51 (sllgen:make-rep-loop "--> "
52 (lambda (pgm) (eval-program pgm))
53 (sllgen:make-stream-parser the-lexical-spec the-grammar)))
54
55;;================================================================================
56;;== The Interpreter ==
57;;================================================================================
58
59(define eval-program
60 (lambda (pgm)
61 (cases program pgm
62 (a-program (body) (eval-expression body (init-env))))))
63
64(define eval-expression
65 (lambda (exp env)
66 (cases expression exp
67 (lit-exp (datum) datum)
68 (var-exp (id) (apply-env env id))
69 (primapp-exp (prim rands) (let ((args (eval-rands rands env)))
70 (apply-primitive prim args)))
71 (else (eopl:error 'eval-expression "Not here:~s" exp))
72 )))
73
74(define eval-rands ;; Evaluate all of the expressions in the list --rands--
75 (lambda (rands env)
76 (map (lambda (x) (eval-rand x env)) rands)))
77
78(define eval-rand ;; Evaluate an expression --rand-- ;; Just a wrapper for eval-expression
79 (lambda (rand env)
80 (eval-expression rand env)))
81
82(define apply-primitive ;; Apply a primitive procedure to a list of expressed values --args--
83 (lambda (prim args)
84 (cases primitive prim
85 (add-prim () (+ (car args) (cadr args)))
86 (subtract-prim () (- (car args) (cadr args)))
87 (mult-prim () (* (car args) (cadr args)))
88 (incr-prim () (+ (car args) 1))
89 (decr-prim () (- (car args) 1))
90 )))
91
92;;================================================================================
93;;== Environments ==
94;;================================================================================
95
96(define init-env ;; Parameterless function that creates an initial environment
97 (lambda ()
98 (extend-env '(i v x)
99 '(1 5 10)
100 (empty-env))))
101
102(define-datatype environment environment?
103 (empty-env-record)
104 (extended-env-record (syms (list-of symbol?))
105 (vals vector?) ;; You can put any type of expressed value in here
106 (env environment?)))
107
108(define empty-env
109 (lambda ()
110 (empty-env-record)))
111
112(define extend-env ;; Add variables to an environment
113 (lambda (syms vals env)
114 (extended-env-record syms (list->vector vals) env)))
115
116(define apply-env ;; Looks up a variable in an environment
117 (lambda (env sym)
118 (cases environment env
119 (empty-env-record () (eopl:error 'apply-env "No binding for ~s" sym))
120 (extended-env-record (syms vals env) (let ((position (rib-find-position sym syms)))
121 (if (number? position)
122 (vector-ref vals position)
123 (apply-env env sym)))))))
124
125;; apply-env helper functions
126(define rib-find-position
127 (lambda (sym los)
128 (list-find-position sym los)))
129
130(define list-find-position
131 (lambda (sym los)
132 (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
133
134(define list-index
135 (lambda (pred ls)
136 (cond ((null? ls) #f)
137 ((pred (car ls)) 0)
138 (else (let ((list-index-r (list-index pred (cdr ls))))
139 (if (number? list-index-r)
140 (+ list-index-r 1)
141 #f))))))