Add DO-SOURCE macro for iterating over source files

[jscl.git] / src / compiler-codegen.lisp

diff --git a/src/compiler-codegen.lisp b/src/compiler-codegen.lisp
index 4552430..9bb915d 100644 (file)
--- a/src/compiler-codegen.lisp
+++ b/src/compiler-codegen.lisp
@@ -24,6 +24,27 @@
 
 (/debug "loading compiler-codegen.lisp!")
 
+(defvar *js-macros* nil)
+(defmacro define-js-macro (name lambda-list &body body)
+  (let ((form (gensym)))
+    `(push (cons ',name
+                 (lambda (,form)
+                   (block ,name
+                     (destructuring-bind ,lambda-list ,form
+                       ,@body))))
+           *js-macros*)))
+
+(defun js-macroexpand (js)
+  (if (and (consp js) (assoc (car js) *js-macros*))
+      (let ((expander (cdr (assoc (car js) *js-macros*))))
+        (multiple-value-bind (expansion stop-expand-p)
+            (funcall expander (cdr js))
+          (if stop-expand-p
+              expansion
+              (js-macroexpand expansion))))
+      js))
+
+
 (defconstant no-comma 12)
 
 (defvar *js-output* t)
@@ -178,18 +199,18 @@
          (case (length (cdr form))
            (1 `(unary- ,(cadr form)))
            (t (reduce (lambda (x y) `(- ,x ,y)) (cdr form)))))
+        ((and or)
+         (reduce (lambda (x y) `(,(car form) ,x ,y)) (cdr form)))
         ((progn comma)
          (reduce (lambda (x y) `(comma ,x ,y)) (cdr form) :from-end t))
-        (t form))
+        (t
+         (js-macroexpand form)))
       form))
 
 (defun js-operator-expression (op args precedence associativity operand-order)
   (let ((op1 (car args))
         (op2 (cadr args)))
     (case op
-      ;; Transactional compatible operator
-      (code
-       (js-format "~a" (apply #'code args)))
       ;; Accessors
       (property
        (js-expr (car args) 0)
@@ -349,7 +370,7 @@
          (t
           `(group ,@(cdr form))))))
     (t
-     form)))
+     (js-macroexpand form))))
 
 (defun js-stmt (form &optional parent)
   (let ((form (js-expand-stmt form)))
@@ -365,17 +386,17 @@
            (js-format ";")))
         (t
          (case (car form)
-           (code
-            (js-format "~a" (apply #'code (cdr form))))
            (label
             (destructuring-bind (label &body body) (cdr form)
               (js-identifier label)
               (js-format ":")
               (js-stmt `(progn ,@body))))
            (break
-            (destructuring-bind (label) (cdr form)
-              (js-format "break ")
-              (js-identifier label)
+            (destructuring-bind (&optional label) (cdr form)
+              (js-format "break")
+              (when label
+                (js-format " ")
+                (js-identifier label))
               (js-format ";")))
            (return
              (destructuring-bind (value) (cdr form)
@@ -419,6 +440,25 @@
                  (js-expr condition)
                  (js-format ")")
                  (js-stmt `(progn ,@body))))
+           (switch
+            (destructuring-bind (value &rest cases) (cdr form)
+              (js-format "switch(")
+              (js-expr value)
+              (js-format "){")
+              (dolist (case cases)
+                (cond
+                  ((and (consp case) (eq (car case) 'case))
+                   (js-format "case ")
+                   (let ((value (cadr case)))
+                     (unless (or (stringp value) (integerp value))
+                       (error "Non-constant switch case `~S'." value))
+                     (js-expr value))
+                   (js-format ":"))
+                  ((eq case 'default)
+                   (js-format "default:"))
+                  (t
+                   (js-stmt case))))
+              (js-format "}")))
            (for
             (destructuring-bind ((start condition step) &body body) (cdr form)
               (js-format "for (")