;;; wrapper
(defun simple_parser (filename)
  "Parse a simple language"
  (interactive "fWhat file to parse? ")
  (find-file-other-window filename)
  (goto-char (point-min))
  (if (program)
      (message "%s is okay" filename)
    (beep)
    (message "%s is not okay -- problem is here" filename)))


;;; main bit
(defun program ()
  (and
    (match "program")
    (id)
    (variables-section)
    (functions-section)
    (statements-section)
    (match "end")))
    
;;; see if we can match (ignoring whitespace) the requested regular expression
;;; if we can, move to the end of that match
(defun match (word)
  (if (looking-at (concat "[ \n]*" word))
      (goto-char (match-end 0))))

(defun lookahead(word)
  (looking-at (concat "[ \n]*" word)))


;;;
;;; recursive descent
(defun id ()
  (match "[a-zA-Z0-9]+"))

(defun variables-section ()
  (and
   (match "variables")
   (match "\{")
   (variable-declarations)
   (match "\}")))

(defun variable-declarations ()
  (if (lookahead "\}")
      t
    (if (variable-declaration)
	(variable-declarations))))
   
(defun variable-declaration ()
  (and
   (id)
   (match ":")
   (id)
   (match ";")))

;;(defun body ()
;;  (and
;;   (match "\{")
;;   (declarations)
;;   (statements)
;;   (match "\}")))

(defun argpair ()
  (and
   (id)
   (id)))

(defun argslist ()
  (if (lookahead "\)")
      t
    (if (argpair)
	(if (lookahead "\)")
	    t
	  (and
	   (match ",")
	   (argslist))))))

(defun function-declaration ()
  (and
   (match "define")
   (id)
   (match ":")
   (id)
   (match "\(")
   (argslist)
   (match "\)")
   (match "\{")
   (statements)
   (match "\}")))

(defun function-declarations ()
  (if (lookahead "\}")
      t
    (if (function-declaration)
	(function-declarations))))

(defun functions-section ()
  (and
   (match "functions")
   (match "\{")
   (function-declarations)
   (match "\}")))


(defun statement ()
  (or
   (if (lookahead "var")
       (and
	(match "var")
	(variable-declaration)))
   (if (lookahead "while")
       (while-loop))
   (if (lookahead "if")
       (if-struct))
   (if (lookahead "[a-zA-Z0-9]+")
       (and
	(subroutine-call)
	(match ";")))))

(defun statements ()
  (if (lookahead "\}")
      t
    (and
     (statement)
     (statements))))
	
(defun statements-section ()
  (and
   (match "statements")
   (match "\{")
   (statements)
   (match "\}")))


;;;
;;;
;;; subroutine call
(defun subroutine-call ()
  (and
   (id)
   (match "\(")
   (callargslist)
   (match "\)")))

(defun callargslist ()
  (if (lookahead "\)")
      t
    (if (id)
	(if (lookahead "\)")
	    t
	  (and
	   (match ",")
	   (callargslist))))))


;;; control structures
;;;
;;;  while
(defun while-loop ()
  (and
   (match "while")
   (match "\(")
   (subroutine-call)
   (match "\)")
   (match "\{")
   (statements)
   (match "\}")))

;;;
;;;
;;; if
(defun if-struct ()
  (and
   (match "if")
   (match "\(")
   (subroutine-call)
   (match "\)")
   (match "\{")
   (statements)
   (match "\}")
   (if (lookahead "else")
       (and
	(match "else")
	(match "\{")
	(statements)
	(match "\}"))
     t)))