;;;; phpgen.lisp
 
 (in-package #:phpgen)
 
 ;;; "phpgen" goes here. Hacks and glory await!
 
 (defgeneric generate-php (ast &optional level))
 
 (defclass ast ()
   ((%children :initarg :children :accessor children :initform '())))
 
 (defclass statement (ast)
   ((%statement-control :initarg :statement-control :accessor statement-control :initform nil))
   (:documentation "A linguistic construct without a return value"))
 
 (defclass expression (ast)
   ()
   (:documentation "A linguistic construct with a return value"))
 
 (defmethod generate-php ((ast string) &optional level)
   (declare (ignore level))
   (when (ends-with #\; ast)
     (setf ast (subseq ast (length ast))))
   (trim-whitespace ast))
 
 (defmethod separate-children ((ast ast))
   " ")
 
 (defmethod separate-children ((ast statement))
   (format nil ";~%"))
 
 
 (defmethod generate-php ((ast ast) &optional (level 0))
   (apply #'concatenate 'string
          (loop for child in (children ast)
                collect (format nil "~vt~a~a"
                                (* 4 (1+ level))
                                (generate-php child (1+ level))
                                (separate-children ast)))))
 
 (defmethod generate-php :around ((ast statement) &optional (level 0))
   (declare (ignore level))
   (format nil "~a{~%~a~&}~a~%"
           (format-preamble ast (statement-control ast))
           (call-next-method)
           (format-postamble ast (statement-control ast))))
 
 (defclass conditional-statement (statement)
   ())
 
 (defmethod format-postamble ((ast conditional-statement) value)
   (declare (ignore ast))
   (format nil "" value))
 
 (defmethod format-preamble ((ast conditional-statement) value)
   (declare (ignore ast))
   (format nil "(~a)" value))
 
 (defclass if-statement (conditional-statement)
   ())
 
 (defclass while-statement (conditional-statement)
   ())
 
 (defclass do-while-statement (conditional-statement)
   ())
 
 (defmacro define-conditional-statement (name &optional (keyword (string-downcase name)))
   (let ((name (intern (format nil "~a-STATEMENT" name))))
     `(progn
        (defclass ,name (conditional-statement)
          ())
 
        (defmethod generate-php :around ((ast ,name) &optional level)
          (declare (ignore level))
          (format nil ,(format nil "~a ~~a" keyword)
                  (call-next-method))))))
 
 (define-conditional-statement if)
 (define-conditional-statement elseif "elseif")
 (define-conditional-statement while "while")
 
 (defmethod generate-php :around ((ast do-while-statement) &optional level)
   (declare (ignore level))
   (format nil "do ~a"
           (call-next-method)))
 
 (defmethod format-preamble ((ast do-while-statement) value)
   "")
 
 (defmethod format-postamble ((ast do-while-statement) value)
   (format nil " while (~a)" value))
 
 (defclass assignment (expression)
   ((place :initarg :place :accessor ast-place :initform nil)
    (value :initarg :value :accessor ast-value :initform nil)))
 
 (defclass function-call (expression)
   ((name :initarg :name :accessor ast-name :initform nil)))
 
 (defmethod generate-php ((ast function-call) &optional level)
   (declare (ignore level))
   (format nil "~a(~{~a~^, ~})"
           (ast-name ast)
           (mapcar #'generate-php (children ast))))
 
 (defmethod generate-php ((ast assignment) &optional level)
   (declare (ignore level))
   (format nil "~a = ~a"
           (generate-php (ast-place ast))
           (generate-php (ast-value ast))))
 
 (trace generate-php)
 
 (generate-php "bar")
 (generate-php (make-instance 'ast :children (list "bar" "baz")))
 (generate-php (make-instance 'function-call :name "foo" :children (list "bar" "baz")))
 (generate-php (make-instance 'do-while-statement :statement-control "foo"
                              :children (list "bar"
                                              "baz")))