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
|
#lang scheme
;; An interactive calculator inspired by the calculator example in the bison manual.
;; Import the parser and lexer generators.
(require parser-tools/yacc
parser-tools/lex
(prefix-in : parser-tools/lex-sre))
(define-tokens value-tokens (NUM VAR FNCT))
(define-empty-tokens op-tokens (newline = OP CP + - * / ^ EOF NEG))
;; A hash table to store variable values in for the calculator
(define vars (make-hash))
(define-lex-abbrevs
(lower-letter (:/ "a" "z"))
(upper-letter (:/ #\A #\Z))
;; (:/ 0 9) would not work because the lexer does not understand numbers. (:/ #\0 #\9) is ok too.
(digit (:/ "0" "9")))
(define calcl
(lexer
[(eof) 'EOF]
;; recursively call the lexer on the remaining input after a tab or space. Returning the
;; result of that operation. This effectively skips all whitespace.
[(:or #\tab #\space) (calcl input-port)]
;; (token-newline) returns 'newline
[#\newline (token-newline)]
;; Since (token-=) returns '=, just return the symbol directly
[(:or "=" "+" "-" "*" "/" "^") (string->symbol lexeme)]
["(" 'OP]
[")" 'CP]
["sin" (token-FNCT sin)]
[(:+ (:or lower-letter upper-letter)) (token-VAR (string->symbol lexeme))]
[(:+ digit) (token-NUM (string->number lexeme))]
[(:: (:+ digit) #\. (:* digit)) (token-NUM (string->number lexeme))]))
(define calcp
(parser
(start start)
(end newline EOF)
(tokens value-tokens op-tokens)
(error (lambda (a b c) (void)))
(precs (right =)
(left - +)
(left * /)
(left NEG)
(right ^))
(grammar
(start [() #f]
;; If there is an error, ignore everything before the error
;; and try to start over right after the error
[(error start) $2]
[(exp) $1])
(exp [(NUM) $1]
[(VAR) (hash-ref vars $1 (lambda () 0))]
[(VAR = exp) (begin (hash-set! vars $1 $3)
$3)]
[(FNCT OP exp CP) ($1 $3)]
[(exp + exp) (+ $1 $3)]
[(exp - exp) (- $1 $3)]
[(exp * exp) (* $1 $3)]
[(exp / exp) (/ $1 $3)]
[(- exp) (prec NEG) (- $2)]
[(exp ^ exp) (expt $1 $3)]
[(OP exp CP) $2]))))
;; run the calculator on the given input-port
(define (calc ip)
(port-count-lines! ip)
(letrec ((one-line
(lambda ()
(let ((result (calcp (lambda () (calcl ip)))))
(when result
(printf "~a\n" result)
(one-line))))))
(one-line)))
(calc (open-input-string "x=1\n(x + 2 * 3) - (1+2)*3"))
|
