Create a program which parses and evaluates arithmetic expressions.

Requirements

 An abstract-syntax tree (AST) for the expression must be created from parsing the input. 
 The AST must be used in evaluation, also, so the input may not be directly evaluated (e.g. by calling eval or a similar language feature.) 
 The expression will be a string or list of symbols like "(1+3)*7". 
 The four symbols + - * / must be supported as binary operators with conventional precedence rules. 
 Precedence-control parentheses must also be supported.


Note

For those who don't remember, mathematical precedence is as follows:

 Parentheses
 Multiplication/Division (left to right)
 Addition/Subtraction (left to right)


C.f
 
 24 game Player.
 Parsing/RPN calculator algorithm.
 Parsing/RPN to infix conversion.


 
(import (scheme base)
        (scheme char)
        (scheme cxr)
        (scheme write)
        (srfi 1 lists))
 
;; convert a string into a list of tokens
(define (string->tokens str)
  (define (next-token chars)
    (cond ((member (car chars) (list #\+ #\- #\* #\/) char=?)
           (values (cdr chars)
                   (cdr (assq (car chars) ; convert char for op into op procedure, using a look up list
                              (list (cons #\+ +) (cons #\- -) (cons #\* *) (cons #\/ /))))))
          ((member (car chars) (list #\( #\)) char=?)
           (values (cdr chars)
                   (if (char=? (car chars) #\()
                     'open
                     'close)))
          (else ; read a multi-digit positive integer
            (let loop ((rem chars)
                       (res 0))
              (if (and (not (null? rem)) 
                       (char-numeric? (car rem)))
                (loop (cdr rem)
                      (+ (* res 10)
                         (- (char->integer (car rem))
                            (char->integer #\0))))
                (values rem
                        res))))))
  ;
  (let loop ((chars (remove char-whitespace? (string->list str)))
             (tokens '()))
    (if (null? chars)
      (reverse tokens)
      (let-values (((remaining-chars token) (next-token chars)))
                  (loop remaining-chars
                        (cons token tokens))))))
 
;; turn list of tokens into an AST 
;; -- using recursive descent parsing to obey laws of precedence
(define (parse tokens)
  (define (parse-factor tokens)
    (if (number? (car tokens))
      (values (car tokens) (cdr tokens))
      (let-values (((expr rem) (parse-expr (cdr tokens))))
                  (values expr (cdr rem)))))
  (define (parse-term tokens)
    (let-values (((left-expr rem) (parse-factor tokens)))
                (if (and (not (null? rem))
                         (member (car rem) (list * /)))
                  (let-values (((right-expr remr) (parse-term (cdr rem))))
                              (values (list (car rem) left-expr right-expr)
                                      remr))
                  (values left-expr rem))))
  (define (parse-part tokens)
    (let-values (((left-expr rem) (parse-term tokens)))
                (if (and (not (null? rem))
                         (member (car rem) (list + -)))
                  (let-values (((right-expr remr) (parse-part (cdr rem))))
                              (values (list (car rem) left-expr right-expr)
                                      remr))
                  (values left-expr rem))))
  (define (parse-expr tokens)
    (let-values (((expr rem) (parse-part tokens)))
                (values expr rem)))
  ;
  (let-values (((expr rem) (parse-expr tokens)))
                (if (null? rem) 
                  expr
                  (error "Misformed expression"))))
 
;; evaluate the AST, returning a number
(define (eval-expression ast)
  (cond ((number? ast)
         ast)
        ((member (car ast) (list + - * /))
         ((car ast) 
          (eval-expression (cadr ast)) 
          (eval-expression (caddr ast))))
        (else
          (error "Misformed expression"))))
 
;; parse and evaluate the given string
(define (interpret str)
  (eval-expression (parse (string->tokens str))))
 
;; running some examples
(for-each
  (lambda (str)
    (display 
      (string-append str
                     " => "
                     (number->string (interpret str))))
    (newline))
  '("1 + 2" "20+4*5" "1/2+5*(6-3)" "(1+3)/4-1" "(1 - 5) * 2 / (20 + 1)"))
 