;;;; php_pre.lisp

(in-package #:php_pre)

(defclass statement ()
  ((statement-keyword :initarg :keyword :accessor statement-keyword)
   (param :initarg :param :accessor param)
   (body :initarg :body :accessor body)))

(defmethod print-object ((object statement) s)
  (print-unreadable-object (object s :type t :identity t)
    (format s "~a (~d expressions)"
	    (statement-keyword object)
	    (length (body object)))))

(defun make-statement (type param body)
  (make-instance 'statement :keyword type :param param :body body))

(defun .constituent ()
  (.is #'alpha-char-p))

(defun .keyword ()
  (.first
   (.map 'string (.constituent))))

(defun .whitespace-char ()
  (.or (.char= #\space)
       (.is-not #'graphic-char-p)))

(defun .comment ()
  (.or (.first
	(.prog2 (.string= "//")
		(.word-list)
		(.char= #\newline)
		(.optional (.whitespace))))
       (.first
	(.prog2 (.string= "/*")
		(.map 'string (.and (.not (.string= "*/"))
				    (.item)))
		(.string= "*/")
		(.optional (.whitespace))))))

(defun .whitespace ()
  (.first (.map 'string (.whitespace-char))))

(defun .word-terminator ()
  (.or (.whitespace-char)
       (.is (lambda (x)
	      (or (char= x #\{)
		  (char= x #\})
		  (char= x #\})
		  (char= x #\;))))))

(defun .array-el ()
  (.let* ((first (.first (.map 'string
			       (.prog2 (.optional (.whitespace))
				       (.is-not (lambda (it)
						  (member it '(#\= #\,))))
				       (.optional (.whitespace))))))
	  (second (.optional (.progn (.string= "=>")
				     (.optional (.whitespace))
				     (.first
				      (.map 'string
					    (.is-not #'char= #\,))))))
	  (divider (.optional (.char= #\,))))
    divider
    (.identity (cons first second))))

(defun .php-array ()
  (.let* ((begin (.char= #\[))
	  (els (.map 'list (.array-el) :at-least 0))
	  (end (.char= #\])))
    (.identity (list :array begin els end))))

(defun .word ()
  (.or (.first (.concatenate 'string
			     (.string= "'")
			     (.map 'string (.is-not #'char= #\'))
			     (.string= "'")))
       (.first (.concatenate 'string
			     (.string= "\"")
			     (.map 'string (.is-not #'char= #\"))
			     (.string= "\"")))
       (.first (.map 'string (.and (.not (.word-terminator))
				   (.item))))))

(defun .word-list (&optional (word-parser '.word))
  (.map 'list
	(.progn (.optional (.whitespace))
		(.first (funcall word-parser)))))

(defun .line (&optional (word-parser '.word))
  (.prog1 (.word-list)
	  (.progn (.optional (.whitespace))
		  (.char= #\;))))

(defun .paren-word ()
  (.map 'string (.and (.not (.or (.word-terminator)
				 (.char= #\( )
				 (.char= #\) )))
		      (.item))))

(defun .statement-list ()
  (.map 'list (.or (.prog1 (.first (.word-list))
			   (.optional (.whitespace))
			   (.char= #\;))
		   (.progn (.optional (.whitespace))
			   (.first (.statement))))
	:at-least 0))

(defun .statement-start ()
  (.let* ((type (.progn (.optional (.whitespace))
			(.first (.keyword))))
	  (param (.optional (.or (.prog2 (.progn (.optional (.whitespace))
						 (.char= #\( ))
					 (.word-list)
					 (.progn (.optional (.whitespace))
						 (.char= #\) )))
				 (.word-list))))
	  (_ (.progn (.whitespace)
		     (.char= #\{))))
    (.identity (cons type param))))

(defun .statement ()
  (.let* ((start (.progn (.prog1 (.map 'list
				       (.progn (.optional (.whitespace))
					       (.comment))
				       :at-least 0)
				 (.optional (.whitespace)))
			 (.statement-start)))
	  (statements (.progn (.whitespace)
			      (.statement-list)))
	  (_ (.progn (.optional (.whitespace))
		     (.char= #\}))))
    (destructuring-bind (type . param) start
      (.identity (make-statement type param statements)))))

(defun slurp (fn)
  (with-open-file (s fn)
    (let ((result (make-string (file-length s))))
      (read-sequence result s)
      result)))

(defun .main-parser ()
  (.map 'list (.or (.prog1 (.word-list) (.char= #\;))
		   (.first
		    (.progn (.optional (.whitespace))
			    (.statement))))))