codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; 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)
Private
[
?
]
Run code
Submit