;;;; 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))))))