;; C311 Programming Laguages
;; Fall 2008
;; Dana Vrajitoru

;; Checking and parsing functions for the grammar in the example given
;; in class.

; Recursive descent implementation for the grammar:
; S => F
; S => ( S + F )
; F => 1

("(" 1 "+" 1 ")")

(defun move-input ()
  (pop input)
  t)

(defun check-S ()
  (cond
   ((equal (car input) 1)
    (check-F))
   ((equal (car input) "(")
    (pop input)
    (and (check-S)
	 (equal (car input) "+")
	 (move-input)
	 (check-F)
	 (equal (car input) ")")
	 (move-input)))
   (t nil)))

(defun check-F ()
  (if (equal (car input) 1) 
      (move-input)
    nil))

(defun check-input (L)
  (setq input L)
  (and (check-S)
       (not input)))

(setq input '( "(" 1 "+" 1 ")" ))
("(" 1 "+" 1 ")")

(check-S)
t

(setq input '( 1 "+" 1))
(1 "+" 1)
(check-S)
t
input
("+" 1)

(check-input '(1 "+" 1))
nil

(check-input '("(" 1 "+" 1 ")" ))
t

(defun parse-S ()
  (cond
   ((equal (car input) 1)
    (list 'S (parse-F)))
   ((equal (car input) "(")
    (let ((A nil) (B nil))
      (pop input)
      (if (and (setq A (parse-S))
	       (equal (car input) "+")
	       (move-input)
	       (setq B (parse-F))
	       (equal (car input) ")")
	       (move-input))
	  (list 'S "(" A "+" B ")" )
	nil)))
   (t nil)))

(defun parse-F ()
  (if (equal (car input) 1) 
      (progn (move-input)
	     (list 'F 1))
    nil))

(defun parse-input (L)
  (setq input L)
  (let ((T (parse-S)))
    (if (and T (not input)) T nil)))

(parse-input '("(" 1 "+" 1 ")" ))
(S "(" (S (F 1)) "+" (F 1) ")")


(defun eval-tree (Tree)
  (let ((root (car Tree)))
    (cond
     ((equal root 'factor)
      (if (= (length Tree) 2) 
          ; number or symbol
          (eval (cadr Tree))
        (eval-tree (caddr Tree)))))))


; '( "(" "(" 1 "+" 1 ")" "+" 1 ")" )
; '(S "(" (S "(" (S (F 1)) "+" (F 1) ")") "+" 1 ")")
; '(S (F 1))
(defun eval-S (Tree)
  (cond ((not Tree) nil)
	((equal (length Tree) 2) 1) ;(S (F 1))
	((equal (length Tree) 6) 
	 (+ 1 (eval-S (elt Tree 2))))
	(t nil)))

(eval-S '(S "(" (S "(" (S (F 1)) "+" (F 1) ")") "+" 1 ")"))
3

((defun process (L)
  (let ((Tree (parse-input L)))
    (if (not Tree) nil
      (princ "The parse tree is:\n")
      (prin1 Tree)
      (princ "\nThis is evaluated to\n")
      (eval-S Tree))))

(process '("(" 1 "+" 1 ")" ))
The parse tree is:
(S "(" (S (F 1)) "+" (F 1) ")")
This is evaluated to
2


(process '( "(" "(" 1 "+" 1 ")" "+" 1 ")" ))
The parse tree is:
(S "(" (S "(" (S (F 1)) "+" (F 1) ")") "+" (F 1) ")")
This is evaluated to
3


;; The example of the non-LL grammar for arithmetic expressions.

; E => T
; E => T AO TT
; TT => T
; TT => T AO TT
; '(E (T ...))
; '(E (T ...) "+" (TT ...))
(defun eval-E (Tree)
  (if (equal (length Tree) 1)
      (eval-T (cadr Tree))
    (let ((r1 (eval-T (cadr Tree)) )
	  (r2 (eval-TT (elt Tree 3))))
      (cond ((equal (elt Tree 2) "+")
	     (+ r1 r2))
	    ((equal (elt Tree 2) "-")
	     (- r1 r2))
	    (t nil)))))