Fix temporal bug in tagbody

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

diff --git a/src/compiler-codegen.lisp b/src/compiler-codegen.lisp
index d8d442f..83cb4b9 100644 (file)
--- a/src/compiler-codegen.lisp
+++ b/src/compiler-codegen.lisp
@@ -178,6 +178,8 @@
          (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))
@@ -192,25 +194,18 @@
        (js-format "~a" (apply #'code args)))
       ;; Accessors
       (property
-       (js-expr (car args))
+       (js-expr (car args) 0)
        (js-format "[")
        (js-expr (cadr args) no-comma)
        (js-format "]"))
       (get
-       (multiple-value-bind (identifier identifierp)
-           (valid-js-identifier (car args))
-         (multiple-value-bind (accessor accessorp)
-             (valid-js-identifier (cadr args))
-           (cond
-             ((and identifierp accessorp)
-              (js-identifier identifier)
-              (js-format ".")
-              (js-identifier accessor))
-             (t
-              (js-expr (car args))
-              (js-format "[")
-              (js-expr (cadr args))
-              (js-format "]"))))))      
+       (multiple-value-bind (accessor accessorp)
+           (valid-js-identifier (cadr args))
+         (unless accessorp
+           (error "Invalid accessor ~S" (cadr args)))
+         (js-expr (car args) 0)
+         (js-format ".")
+         (js-identifier accessor)))      
       ;; Function call
       (call
        (js-expr (car args) 1)
@@ -380,9 +375,11 @@
               (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)
@@ -426,6 +423,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 (")