; expression evaluation
(define (numb xs)
(let loop ((n (- (char->integer (car xs)) 48)) (xs (cdr xs)))
(cond ((null? xs) (values n xs))
((member (car xs) (string->list "0123456789"))
(loop (+ (* 10 n) (- (char->integer (car xs)) 48)) (cdr xs)))
(else (values n xs)))))
(define (fact xs)
(cond ((null? xs) (error 'fact "missing factor"))
((char=? (car xs) #\space) (fact (cdr xs)))
((member (car xs) (string->list "0123456789"))
(let-values (((n rest) (numb xs)))
(values n rest)))
((char=? (car xs) #\()
(let-values (((n rest) (expr (cdr xs))))
(if (or (null? rest) (not (char=? (car rest) #\))))
(error 'fact "missing right parenthesis")
(values n (cdr rest)))))
(else (error 'fact "expected number or left parenthesis"))))
(define (term xs)
(let-values (((f rest) (fact xs)))
(let loop ((n f) (xs rest))
(cond ((null? xs) (values n xs))
((char=? (car xs) #\space)
(loop n (cdr xs)))
((char=? (car xs) #\*)
(let-values (((f rest) (fact (cdr xs))))
(loop (* n f) rest)))
((char=? (car xs) #\/)
(let-values (((f rest) (fact (cdr xs))))
(loop (/ n f) rest)))
(else (values n xs))))))
(define (expr xs)
(let-values (((t rest) (term xs)))
(let loop ((n t) (xs rest))
(cond ((null? xs) (values n xs))
((char=? (car xs) #\space)
(loop n (cdr xs)))
((char=? (car xs) #\+)
(let-values (((t rest) (term (cdr xs))))
(loop (+ n t) rest)))
((char=? (car xs) #\-)
(let-values (((t rest) (term (cdr xs))))
(loop (- n t) rest)))
(else (values n xs))))))
(define (evaluate str)
(let-values (((x xs) (expr (string->list str))))
(if (null? xs) x
(error 'evaluate "extra characters at end"))))
(display (evaluate "12 * (34 + 56)")) (newline)
(define-syntax assert
(syntax-rules ()
((assert expr result)
(if (not (equal? expr result))
(for-each display `(
#\newline "failed assertion:" #\newline
expr #\newline "expected: " ,result
#\newline "returned: " ,expr #\newline))))))
(define (test-evaluate)
(assert (evaluate "6+2") 8)
(assert (evaluate "6-2") 4)
(assert (evaluate "6*2") 12)
(assert (evaluate "6/2") 3)
(assert (evaluate "6 * 2") 12)
(assert (evaluate "2+3*4") 14)
(assert (evaluate "2*3+4") 10)
(assert (evaluate "2+3+4") 9)
(assert (evaluate "2-3-4") -5)
(assert (evaluate "2*3*4") 24)
(assert (evaluate "(2+3)*4") 20)
(assert (evaluate "(2*3)+4") 10)
(assert (evaluate "2+(3*4)") 14)
(assert (evaluate "2*(3+4)") 14)
)
(test-evaluate)