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