functionParser.scm

; A simple parser for a Java/C-ish language minus the objects
; EECS 345: Programming Languages Concepts
;
; A recursive descent parser and a lexical analyzer for simple Java statements.
; The language allows assignments, all mathematical expressions, if statements,
; while statements (including break and continue), blocks, and functions.
;
; To call the parser, use:
;     (parser filename)
;
; The return value is a parse tree in list format

(load "lex.scm")

(define parser
  (lambda (filename)
    (begin (start-lex filename)
           (let ((parse-tree (program-parse)))
             (end-lex)
             parse-tree))))

;===============================================
; The recursive descent parser

(define program-parse
  (lambda ()
    (if (eq? (car (get-next-symbol)) 'EOF)
       '()
       (begin
         (unget-next-symbol)
         (let ((parsetree (top-level-parse)))
           (cons parsetree (program-parse)))))))

; parse the top level of the program.  The top level is a function definition (an identifier followed by a left
; parenthesis) or is an assignment statement.

(define top-level-parse
  (lambda ()
    (let ((firstsymbol (get-next-symbol)))
      (cond
        ((eq? (car firstsymbol) 'ID) 
           (if (eq? (car (get-next-symbol)) 'LEFTPAREN) 
               (function-parse (cdr firstsymbol))
               (error "Illegal start of function definition")))
        ((eq? (car firstsymbol) 'var)
            (let ((parse-statement '()))
              (begin 
                (set! parse-statement (declare-parse))
                (if (eq? (car (get-next-symbol)) 'SEMICOLON)
                    parse-statement
                    (error 'parser "Missing semicolon")))))
        (else (error 'parser "Illegal start of top level statement"))))))

; parse a function. A function is the name, followed by a formal parameter list, 
; followed by the body nested in braces

(define function-parse
  (lambda (name)
    (let ((paramlist (get-formalparameter-list)))
       (if (not (eq? (car (get-next-symbol)) 'LEFTBRACE))
           (error 'parser "Missing left brace")
           (list 'function name paramlist (compound-statement-parse))))))

; parse the formal parameter list.  The list is a sequence of identifiers separated by commas

(define get-formalparameter-list
  (lambda ()
    (let ((nextsymbol (get-next-symbol)))
      (cond
        ((eq? (car nextsymbol) 'RIGHTPAREN) '())
        ((eq? (car nextsymbol) 'ID)
          (let ((separator (car (get-next-symbol))))
            (cond
              ((eq? separator 'COMMA) (cons (cdr nextsymbol) (get-formalparameter-list)))
              ((eq? separator 'RIGHTPAREN) (list (cdr nextsymbol)))
              (else (error 'parser "Missing comma")))))
        ((and (eq? (car nextsymbol) 'BINARY-OP) (eq? (cdr nextsymbol) '&))
	   (let* ((id (get-next-symbol))
                  (separator (car (get-next-symbol))))
             (if (eq? (car id) 'ID)
                 (cond
                   ((eq? separator 'COMMA) (cons '& (cons (cdr id) (get-formalparameter-list))))
                   ((eq? separator 'RIGHTPAREN) (list '& (cdr id)))
                   (else (error 'parser "Missing comma")))
                 (error 'parser "Missing identifier after reference operator"))))
        (else (error 'parser "Illegal function parameter, missing right parenthesis?"))))))

; parse a statement that can be an if-statement, a while-statement, or a compound statement
; and if none of the above, it is a simple statement

(define statement-parse
  (lambda ()
    (let ((nextsymbol (car (get-next-symbol))))
      (cond
        ((eq? nextsymbol 'if) (if-parse))
        ((eq? nextsymbol 'while) (while-parse))
        ((eq? nextsymbol 'LEFTBRACE) (cons 'begin (compound-statement-parse)))
        (else (begin
                (unget-next-symbol)
                (simple-statement-parse)))))))

; parse a simple statement that can be a return, break, continue, or an assignment statement

(define simple-statement-parse
  (lambda ()
    (let ((nextsymbol (get-next-symbol))
          (parse-statement '()))
      (begin
        (cond ((eq? (car nextsymbol) 'return) (set! parse-statement (return-parse)))
              ((eq? (car nextsymbol) 'var) (set! parse-statement (declare-parse)))
              ((eq? (car nextsymbol) 'break) (set! parse-statement (list 'break)))
              ((eq? (car nextsymbol) 'continue) (set! parse-statement (list 'continue)))
              ((eq? (car nextsymbol) 'ID) (set! parse-statement (id-parse nextsymbol)))
              (else (set! parse-statement (assign-parse nextsymbol))))
         (if (eq? (car (get-next-symbol)) 'SEMICOLON)
             parse-statement
             (error 'parser "Missing semicolon"))))))

; parse a compound statement.  We already saw the left brace so continue until we see a right brace.

(define compound-statement-parse
  (lambda ()
    (if (eq? (car (get-next-symbol)) 'RIGHTBRACE)
        '()
        (begin
          (unget-next-symbol)
          (cons (statement-parse) (compound-statement-parse))))))

; parse a return statement: return followed by a value.

(define return-parse
  (lambda ()
    (list 'return (value-parse))))

; parse an if statement: a condition inside parentheses, an if statement, and an optional else

(define if-parse
  (lambda ()
    (if (not (eq? (car (get-next-symbol)) 'LEFTPAREN))
        (error 'parser "Missing opening parenthesis")
        (let ((condition (value-parse)))  ; changed
           (if (not (eq? (car (get-next-symbol)) 'RIGHTPAREN))
               (error 'parser "Missing closing parenthesis")
               (let ((if-statement (statement-parse)))
                  (if (eq? (car (get-next-symbol)) 'else)
                      (list 'if condition if-statement (statement-parse))
                      (begin
                        (unget-next-symbol)
                        (list 'if condition if-statement)))))))))

; parse a while statement: a condition followed by a statement

(define while-parse
  (lambda ()
    (if (not (eq? (car (get-next-symbol)) 'LEFTPAREN))
        (error 'parser "Missing opening parenthesis")
        (let ((condition (value-parse)))
          (if (not (eq? (car (get-next-symbol)) 'RIGHTPAREN))
              (error 'parser "Missing closing parenthesis")
              (list 'while condition (statement-parse)))))))

; parse an identifier.  It could be a function call or the start of an assignment statement

(define id-parse
  (lambda (firstsymbol)
    (if (not (eq? (car firstsymbol) 'ID))
        (error 'parser "Illegal start of statement")
        (let ((secondsymbol (get-next-symbol)))
          (if (eq? (car secondsymbol) 'LEFTPAREN)
              (funcall-parse (cdr firstsymbol))
              (begin
                (unget-next-symbol)
                (assign-parse firstsymbol)))))))

; parse a function call: an identifier followed by a parameter list

(define funcall-parse
  (lambda (name)
    (cons 'funcall (cons name (get-actualparameter-list)))))

; parse a parameter list: a list with an arbitrary number of identifiers separated by commas

(define get-actualparameter-list
  (lambda ()
    (let ((nextsymbol (get-next-symbol)))
      (if (eq? (car nextsymbol) 'RIGHTPAREN)
          '()
          (begin
            (unget-next-symbol)
            (let* ((parameter (value-parse))
                   (separator (car (get-next-symbol))))
              (cond
                ((eq? separator 'COMMA) (cons parameter (get-actualparameter-list)))
                ((eq? separator 'RIGHTPAREN) (list parameter))
                (else (error 'parser "Missing comma")))))))))

; parse a variable declaration: var then left-hand-side with optional = followed by a value

(define declare-parse
  (lambda ()
    (let* ((lhs (lhs-parse (get-next-symbol)))
           (op (get-next-symbol)))
      (if (and (eq? (car op) 'BINARY-OP) (eq? (cdr op) '=))
          (append (cons 'var lhs) (list (value-parse)))
          (begin
            (unget-next-symbol)
            (cons 'var lhs))))))
    

; parse an assignment statement: a left-hand-side followed by an = followed by a value

(define assign-parse
  (lambda (firstsymbol)
    (let* ((lhs (lhs-parse firstsymbol))
           (op (get-next-symbol)))
      (if (and (eq? (car op) 'BINARY-OP) (eq? (cdr op) '=))
          (append (cons (cdr op) lhs) (list (value-parse)))
          (error 'parser "Unknown assignment operator")))))

; parse the left hand side of an assignment.  Only variables are allowed.

(define lhs-parse
  (lambda (lhs)
    (if (eq? (car lhs) 'ID)
        (list (cdr lhs))
        (error 'parser "Illegal left hand side of assignment"))))

; parse a value.  The top level of the parse is the assignment operator.

(define value-parse
  (lambda ()
    (let* ((lhs (get-next-symbol))
           (op (get-next-symbol)))
      (if (and (eq? (car lhs) 'ID) (eq? (car op) 'BINARY-OP) (eq? (cdr op) '=))
          (list (cdr op) (cdr lhs) (value-parse))
          (begin
            (unget-next-symbol)
            (orterm-parse lhs))))))

; continuing parsing the value.  The second level is the OR operator

(define orterm-parse
  (lambda (firstsymbol)
    (orterm-parse-helper (andterm-parse firstsymbol))))

; parse the OR expression.

(define orterm-parse-helper
  (lambda (firstoperand)
    (let ((op (get-next-symbol)))
      (if (and (eq? (car op) 'BINARY-OP) (eq? (cdr op) '\|\|))
          (orterm-parse-helper (list '|| firstoperand (andterm-parse (get-next-symbol))))
          (begin
            (unget-next-symbol)
            firstoperand)))))

; the third level is the AND expression

(define andterm-parse
  (lambda (firstsymbol)
    (andterm-parse-helper (equalterm-parse firstsymbol))))

; parse the AND expression.

(define andterm-parse-helper
  (lambda (firstoperand)
    (let ((op (get-next-symbol)))
      (if (and (eq? (car op) 'BINARY-OP) (eq? (cdr op) '&&))
          (andterm-parse-helper (list (cdr op) firstoperand (equalterm-parse (get-next-symbol))))
          (begin
            (unget-next-symbol)
            firstoperand)))))

; the next level is the equal operators

(define equalterm-parse
  (lambda (firstsymbol)
    (equalterm-parse-helper (compareterm-parse firstsymbol))))

; parse the equals expression.

(define equalterm-parse-helper
  (lambda (firstoperand)
    (let ((op (get-next-symbol)))
      (if (and (eq? (car op) 'BINARY-OP) (or (eq? (cdr op) '==) (eq? (cdr op) '!=)))
          (equalterm-parse-helper (list (cdr op) firstoperand (compareterm-parse (get-next-symbol))))
          (begin
            (unget-next-symbol)
            firstoperand)))))

; next we have the comparison operators

(define compareterm-parse
  (lambda (firstsymbol)
    (compareterm-parse-helper (addterm-parse firstsymbol))))

; parse the comparison expression.

(define compareterm-parse-helper
  (lambda (firstoperand)
    (let ((op (get-next-symbol)))
      (if (and (eq? (car op) 'BINARY-OP) (or (eq? (cdr op) '<) (eq? (cdr op) '<=) (eq? (cdr op) '>) (eq? (cdr op) '>=)))
          (compareterm-parse-helper (list (cdr op) firstoperand (addterm-parse (get-next-symbol))))
          (begin
            (unget-next-symbol)
            firstoperand)))))

; continue parsing the value.  The next level is the addition and subtraction operators.

(define addterm-parse
  (lambda (firstsymbol)
    (addterm-parse-helper (multterm-parse firstsymbol))))

; parse the addition expression.

(define addterm-parse-helper
  (lambda (firstoperand)
    (let ((op (get-next-symbol)))
      (if (and (eq? (car op) 'BINARY-OP) (or (eq? (cdr op) '+) (eq? (cdr op) '-)))
          (addterm-parse-helper (list (cdr op) firstoperand (multterm-parse (get-next-symbol))))
          (begin
            (unget-next-symbol)
            firstoperand)))))

; continue parsing the value.  The next level is the multiplication and division operators.

(define multterm-parse
  (lambda (firstsymbol)
    (multterm-parse-helper (operand-parse firstsymbol))))

; parse the multiplication expression.

(define multterm-parse-helper
  (lambda (firstoperand)
     (let ((op (get-next-symbol)))
       (if (and (eq? (car op) 'BINARY-OP) (or (eq? (cdr op) '*) (eq? (cdr op) '/) (eq? (cdr op) '%)))
           (multterm-parse-helper (list (cdr op) firstoperand (operand-parse (get-next-symbol))))
           (begin
             (unget-next-symbol)
             firstoperand)))))

; continue parsing the value.  The final level is the unary operators, variables, numbers, and nested parentheses.

(define operand-parse
  (lambda (firstsymbol)
    (cond
      ((eq? (car firstsymbol) 'LEFTPAREN)
          (let ((retvalue (value-parse)))
            (if (eq? (car (get-next-symbol)) 'RIGHTPAREN)
                retvalue
                (error 'parser "Unmatched left parenthesis"))))
      ((and (eq? (car firstsymbol) 'BINARY-OP) (eq? (cdr firstsymbol) '-)) (list '- (operand-parse (get-next-symbol))))  ; this is a new line
      ((and (eq? (car firstsymbol) 'BINARY-OP) (eq? (cdr firstsymbol) '!)) (list '! (operand-parse (get-next-symbol))))  ; this is a new line
      ((eq? (car firstsymbol) 'NUMBER) (cdr firstsymbol))
      ((eq? (car firstsymbol) 'ID)
             (let ((secondsymbol (get-next-symbol)))
               (if (eq? (car secondsymbol) 'LEFTPAREN)
                   (funcall-parse (cdr firstsymbol))
                   (begin
                     (unget-next-symbol)
                     (cdr firstsymbol)))))
      ((eq? (car firstsymbol) 'BOOLEAN) (cdr firstsymbol))
      (else (error 'parser "Unknown statmement")))));)