;;; File:
;;;   expression.ss
;;; Author:
;;;   Samuel A. Rebelsky
;;; Version:
;;;   1.0 of 30 September 2002
;;; Summary:
;;;   A semi-hack to implement a simple expression parser and evaluator.
;;; Contents:
;;;   Values
;;;     lparen - the left parenthesis character
;;;     rparen - the right parenthesis character
;;;   User Interface
;;;     (evaluate str) - compute the value of an expression
;;;   Testing
;;;     (eexp str) - evaluate an expression, getting value and remaining
;;;       characters
;;;     (eterm str) - evaluate a term, getting value and remaining chars
;;;     (efactor str) - guess
;;;   Parsing
;;;     (exp charlist) - evaluate an expression, getting value and remaining
;;;       characters
;;;     (exphelper (prev-value . charlist)) - evaluate the tail of an
;;;       expression
;;;     (term charlist) - evaluate a term, getting value and remaining chars
;;;     (termhelper (prev-value . charlist)) - evaluate the tail of a term
;;;     (factor charlist) - evaluate a factor, getting value and remaining
;;;       characters
;;;   Helpers
;;;     (add-op? ch) - determine if ch represents an addition operator
;;;     (mul-op? ch) - determine if ch represents a multiplicative operator
;;;     (operator ch) - convert a character that represents an operator
;;;       to the corresponding Scheme procedure
;;; Notes:
;;;   Here's the basic grammar, which is taken from the standard expression
;;;   grammar and then had left recursion removed.
;;;     Exp ::= Term ExpHelper
;;;     ExpHelper ::= epsilon
;;;                |  AddOp Term ExpHelper
;;;     Term ::= Factor TermHelper
;;;     TermHelper ::= epsilon
;;;                 |  MulOp Factor TermHelper
;;;     Factor ::= OPEN Exp CLOSE
;;;             |  NUMBER
;;;
;;;   exp, term, and factor are implemented as Scheme procedures that
;;;   take one parameter, a list of characters, and returns a pair of 
;;;   parameters: the list after the thing is consumed and the value
;;;   of the thing consumed.
;;;
;;;   exphelper and termhelper are implemented as procedures that take
;;;   one parameter: a pair of list and value, and return the same
;;;   kind of pair as the other procedures.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Values

(define lparen #\()
(define rparen #\))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interface

;;; Procedure:
;;;   evaluate
;;; Parameters:
;;;   str, a string
;;; Purpose:
;;;   To evaluate the arithmetic expression given by str.
;;; Produces:
;;;   value, integer.
;;; Preconditions:
;;;   str is a valid arithmetic expression using the operators
;;;   +,-,*,/, parentheses, and single-digits numbers.
;;; Postconditions:
;;;   value is the value of the arithmetic expression using
;;;   precedence.
(define evaluate
  (lambda (str)
    (cdr (eexp str))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Testing

;;; Procedures:
;;;   eexp
;;;   efact
;;;   eterm
;;; Parameter:
;;;   str, a string
;;; Purpose:
;;;   Test exp, factor, and term, respectively.
;;; Produces:
;;;   (chars . value), a pair of a list and a number.
;;; Preconditions:
;;;   str must represent a valid arithmetic expression (or at
;;;   least the start of one).
;;; Postconditions:
;;;   chars is the remaining part of string after the first
;;;     expression, factor, or term has been consumed.
;;;   value is the value of the consumed expression, factor, or term.

(define eexp
  (lambda (str)
    (exp (string->list str))))

(define efact
  (lambda (str)
    (factor (string->list str))))

(define eterm
  (lambda (str)
    (term (string->list str))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Parsing and Evaluating

;;; Procedure:
;;;   exp
;;; Parameters:
;;;   chars, a list of characters
;;; Purpose:
;;;   Parses and evaluates an expression.
;;; Produces:
;;;   (remaining-chars . value), a pair whose first element is
;;;     a list of characters and whose second element is a number.
;;; Preconditions:
;;;   chars begins with a valid expression.
;;; Postconditions:
;;;   remaining-chars contains the elements of chars after the
;;;     first expression is removed.
;;;   value is the value of the removed expression.
(define exp
  (lambda (chars)
    (if (null? chars)
        (error "The empty string cannot be an expression")
        (exphelper (term chars)))))

;;; Procedure:
;;;   exphelper
;;; Parameters:
;;;   (chars . prev-value), a pair whose first element is 
;;;     a list of characters and whose second element is a number.
;;; Purpose:
;;;   Parses and evaluates the tail of an expression.
;;; Produces:
;;;   (remaining-chars . value), a pair whose first element is
;;;     a list of characters and whose second element is a number.
;;; Preconditions:
;;;   chars begins with a valid expression tail (either nothing
;;;     or an addop, a term, and an expression tail).
;;; Postconditions:
;;;   remaining-chars contains the elements of chars after the
;;;     first term tail is removed.
;;;   value is the value of the removed expression tail composed
;;;     with prev-value.
(define exphelper
  (lambda (pair)
    (let ((chars (car pair))
          (val1 (cdr pair)))
      (cond
        ((and (not (null? chars)) (add-op? (car chars)))
         (let ((pair2 (term (cdr chars))))
           (exphelper (cons (car pair2) 
                              ((operator (car chars)) val1 (cdr pair2))))))
        ((null? chars) pair)
        ((char=? (car chars) rparen) pair)
        (else (error "Could not find expression tail in" 
                     (list->string chars)))))))

;;; Procedure:
;;;   term
;;; Parameters:
;;;   chars, a list of characters
;;; Purpose:
;;;   Parses and evaluates a term (an expression with no
;;;     unparenthesized addition).
;;; Produces:
;;;   (remaining-chars . value), a pair whose first element is
;;;     a list of characters and whose second element is a number.
;;; Preconditions:
;;;   chars begins with a valid term.
;;; Postconditions:
;;;   remaining-chars contains the elements of chars after the
;;;     first term is removed.
;;;   value is the value of the removed term.
(define term
  (lambda (chars)
    (if (null? chars)
        (error "The empty string cannot be a term")
        (termhelper (factor chars)))))

;;; Procedure:
;;;   termhelper
;;; Parameters:
;;;   (chars . prev-value), a pair whose first element is 
;;;     a list of characters and whose second element is a number.
;;; Purpose:
;;;   Parses and evaluates the tail of a term.
;;; Produces:
;;;   (remaining-chars . value), a pair whose first element is
;;;     a list of characters and whose second element is a number.
;;; Preconditions:
;;;   chars begins with a valid term tail (either nothing
;;;     or a mulop, a factor, and a term tail).
;;; Postconditions:
;;;   remaining-chars contains the elements of chars after the
;;;     first term tail is removed.
;;;   value is the value of the removed expression as composed
;;;     with the previus value.
(define termhelper
  (lambda (pair)
    (let ((chars (car pair))
          (val1 (cdr pair)))
      (cond
        ((and (not (null? chars)) (mul-op? (car chars)))
         (let ((pair2 (factor (cdr chars))))
           (termhelper (cons (car pair2) 
                             ((operator (car chars)) val1 (cdr pair2))))))
         ((null? chars)  pair)
         ((or (char=? (car chars) rparen) (add-op? (car chars))) pair)
         (else (error "Couldn't find a term tail in" 
                      (list->string chars)))))))

;;; Procedure:
;;;   factor
;;; Parameters:
;;;   chars, a list of characters
;;; Purpose:
;;;   Parses and evaluates a factor (an expression with no
;;;     unparenthesized addition or multiplication)
;;; Produces:
;;;   (remaining-chars . value), a pair whose first element is
;;;     a list of characters and whose second element is a number.
;;; Preconditions:
;;;   chars begins with a valid expression.
;;; Postconditions:
;;;   remaining-chars contains the elements of chars after the
;;;     first factor is removed.
;;;   value is the value of the removed factor.
(define factor
  (lambda (chars)
    (cond
      ((null? chars) (error "Expecting a factor, found nothing!"))
      ((char-numeric? (car chars))
       (cons (cdr chars)
             (string->number (string (car chars)))))
      ((char=? (car chars) lparen)
       (let ((pair (exp (cdr chars))))
         (if (char=? (caar pair) rparen)
             (cons (cdar pair) (cdr pair)))))
      (else
       (error "Couldn't find a term in" (list->string (car pair)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Helpers

;;; Procedure:
;;;   add-op?
;;; Parameters:
;;;   ch, a character
;;; Purpose:
;;;   Determines whether ch represents an additive operator.
;;; Produces:
;;;   is-add-op
;;; Preconditions:
;;;   [Standard]
;;; Postconditions:
;;;   is-add-op is true (#t) if ch represents an additive operator.
;;;   is-add-op is false (#f) otherwise.
(define add-op?
  (lambda (ch)
    (and (char? ch) 
         (or (char=? ch #\+)
             (char=? ch #\-)))))

;;; Procedure:
;;;   mul-op?
;;; Parameters:
;;;   ch, a character
;;; Purpose:
;;;   Determines whether ch represents a multiplicative operator.
;;; Produces:
;;;   is-mul-op
;;; Preconditions:
;;;   [Standard]
;;; Postconditions:
;;;   is-mul-op is true (#t) if ch represents a multiplicative operator.
;;;   is-add-op is false (#f) otherwise.
(define mul-op?
  (lambda (ch)
    (and (char? ch) 
         (or (char=? ch #\*)
             (char=? ch #\/)
             (char=? ch #\%)))))

;;; Procedure:
;;;   operator
;;; Parameters:
;;;   ch, a character
;;; Purpose:
;;;   Finds the Scheme operator that corresponds to ch.
;;; Produces:
;;;   op, a function from numbers to numbers
;;; Preconditions:
;;;   ch names a multiplicative or additive operator [Verified]
;;; Postconditions:
;;;   op is a Scheme operator.
;;;   op is the operator named by ch.
(define operator
  (lambda (ch)
    (cond
      ((char=? ch #\+) (lambda (val1 val2) (list '+ val1 val2)))
      ((char=? ch #\*) (lambda (val1 val2) (list '* val1 val2)))
      ((char=? ch #\/) (lambda (val1 val2) (list '/ val1 val2)))
      ((char=? ch #\-) (lambda (val1 val2) (list '- val1 val2)))
      ((char=? ch #\%) (lambda (val1 val2) (list 'modulo val1 val2)))
      (else (error "Invalid operator:" ch)))))