[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/tAAtFW6d    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Apr 13:
; 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)


Output:
1
1080


Create a new paste based on this one


Comments: