blob: 906ec38b4d793c5262729a5b0445b85e42842502 (
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
|
#lang eopl
(define scanner-spec
'(
(whitespace (whitespace) skip)
(number (digit (arbno digit)) make-number)
(operator ((or "+" "-" "*" "/" "(" ")")) make-symbol)))
(define grammar
'(
(expression (term (arbno add-op term)) arith-expr)
(term (factor (arbno mult-op factor)) arith-factor)
(factor (number) number-factor)
(factor ("(" expression ")") expr-factor)
(add-op ("+") plus-op)
(add-op ("-") minus-op)
(mult-op ("*") times-op)
(mult-op ("/") divide-op)
))
(sllgen:make-define-datatypes scanner-spec grammar)
(define dump-datatypes
(lambda ()
(sllgen:list-define-datatypes scanner-spec grammar)))
(define execute-expression
(lambda (expr)
(cases expression expr
(arith-expr (term ops terms) (expr-helper term ops terms))
)))
(define expr-helper
(lambda (term ops terms)
(if (null? ops)
(eval-term term)
(if (equal? (length ops) 1)
(eval-add-op (car ops) term (car terms))
'a
))))
(define eval-add-op
(lambda (op term1 term2)
(cases add-op op
(plus-op () (+ (eval-term term1) (eval-term term2)))
(minus-op () (- (eval-term term1) (eval-term term2)))
)))
(define eval-term
(lambda (term1)
(cases term term1
(arith-factor (factor ops factors) (term-helper factor ops factors))
)))
(define term-helper
(lambda (factor ops factors)
(if (null? ops)
(eval-factor factor)
(if (equal? (length ops) 1)
(eval-mult-op (car ops) factor (car factors))
'b
))))
(define eval-mult-op
(lambda (op fac1 fac2)
(cases mult-op op
(times-op () (* (eval-factor fac1) (eval-factor fac2)))
(divide-op () (/ (eval-factor fac1) (eval-factor fac2)))
)))
(define eval-factor
(lambda (fac)
(cases factor fac
(number-factor (num) num)
(expr-factor (expr) (execute-expression expr))
)))
(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 spe scan&parse&eval)
|
