new file mode 100644

@@ -0,0 +1 @@

+This is the stub README.txt for the "phpgen" project.

new file mode 100644

@@ -0,0 +1,5 @@

+;;;; package.lisp

+

+(defpackage #:phpgen

+  (:use #:cl #:alexandria #:serapeum #:fw.lu))

+

new file mode 100644

@@ -0,0 +1,13 @@

+;;;; phpgen.asd

+

+(asdf:defsystem #:phpgen

+  :description "Describe phpgen here"

+  :author "Your Name <your.name@example.com>"

+  :license "Specify license here"

+  :depends-on (#:fwoar.lisputils

+               #:alexandria

+               #:serapeum)

+  :serial t

+  :components ((:file "package")

+               (:file "phpgen")))

+

new file mode 100644

@@ -0,0 +1,120 @@

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