git.fiddlerwoaroof.com
Raw Blame History
;;;; 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")))