blob: ae82b0a87378c0ef467fd7260d740a6a934ba41f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
#lang eopl
;; scanner spec
(define scanner-spec
'(
(whitespace (whitespace) skip)
(number (digit (arbno digit)) make-number)
(operator ((or "+" "-" "*" "/" "(" ")")) make-symbol)))
;; grammar
(define grammar
'(
;; expression - 2+4*2*(1+2+3)
(expression (term (arbno add-op term)) arith-expr)
;; term - 1*2*3
(term (factor (arbno mult-op factor)) arith-factor)
;; factors - 2, (1+2+3)
(factor (number) number-factor)
(factor ("(" expression ")") expr-factor)
;; addition and subtraction
(add-op ("+") plus-op)
(add-op ("-") minus-op)
;; multiplication and division
(mult-op ("*") times-op)
(mult-op ("/") divide-op)
))
;; make the datatypes
(sllgen:make-define-datatypes scanner-spec grammar)
(define dump-datatypes
(lambda ()
(sllgen:list-define-datatypes scanner-spec grammar)))
;; top level expression evaluator
(define execute-expression
(lambda (expr)
(cases expression expr
;; use a helper function to keep code out of here
(arith-expr (term ops terms) (expr-helper term ops terms))
)))
;; helper function to evaluate an expression
(define expr-helper
(lambda (term ops terms)
(if (null? ops)
;; single term
(eval-term term)
;; else, check if there's just one term
(if (equal? (length ops) 1)
(eval-add-op (car ops) term (car terms))
;; else, handle multiple terms
(expr-helper (eval-add-op (car ops) term (car terms)) (cdr ops) (cdr terms))
))))
;; evaluates an add operator
(define eval-add-op
(lambda (op term1 term2)
(cases add-op op
;; perform addition
(plus-op () (if (term? term1) (+ (eval-term term1) (eval-term term2)) (+ term1 (eval-term term2))))
;; perform subtraction
(minus-op () (if (term? term1) (- (eval-term term1) (eval-term term2)) (- term1 (eval-term term2))))
)))
;; evaluate a term
(define eval-term
(lambda (term1)
(cases term term1
;; use a helper function to keep this one clean
(arith-factor (factor ops factors) (term-helper factor ops factors))
)))
;; helper function for evaluating terms
(define term-helper
(lambda (factor ops factors)
;; if there is a single factor...
(if (null? ops)
;; ... evaluate and return it
(eval-factor factor)
;; otherwise, if there are 2 factors...
(if (equal? (length ops) 1)
;; evaluate and return them.
(eval-mult-op (car ops) factor (car factors))
;; otherwise, handle multiple factors
(term-helper (eval-mult-op (car ops) factor (car factors)) (cdr ops) (cdr factors))
))))
;; handles multiplication and division
(define eval-mult-op
(lambda (op fac1 fac2)
(cases mult-op op
;; perform multiplication
(times-op () (if (factor? fac1) (* (eval-factor fac1) (eval-factor fac2)) (* fac1 (eval-factor fac2))))
;; perform division
(divide-op () (if (factor? fac1) (/ (eval-factor fac1) (eval-factor fac2)) (/ fac1 (eval-factor fac2))))
)))
;; evaluate a factor
(define eval-factor
(lambda (fac)
(cases factor fac
;; if it's a number, give the number
(number-factor (num) num)
;; if it's an expression, evaluate the expression
(expr-factor (expr) (execute-expression expr))
)))
;; SLLGEN things
(define scan
(sllgen:make-string-scanner scanner-spec grammar))
(define scan&parse
(sllgen:make-string-parser scanner-spec grammar))
(define read-dump
(sllgen:make-rep-loop "> " (lambda (tree) tree) (sllgen:make-stream-parser scanner-spec grammar)))
(define scan&parse&eval
(lambda (s) (execute-expression (scan&parse s))))
(define read-eval-print
(sllgen:make-rep-loop "> " execute-expression (sllgen:make-stream-parser scanner-spec grammar)))
(define test
(lambda ()
(display "Type something in and see if it works!!!")
(newline)
(read-eval-print)))
(display "Run (test) to test program")
(newline)
|
