Changed representation of expression blocks and 'if' to look more like JS in intermed...
authorVladimir Sedach <vsedach@gmail.com>
Mon, 13 Apr 2009 04:33:29 +0000 (22:33 -0600)
committerVladimir Sedach <vsedach@gmail.com>
Mon, 13 Apr 2009 04:33:29 +0000 (22:33 -0600)
src/package.lisp
src/printer.lisp
src/special-forms.lisp
t/ps-tests.lisp

index ac0280d..82c5b09 100644 (file)
       ))
 
   (defparameter *javascript-exports*
-    '(;; for representing js code as s-expressions
-      #:?
-      #:if
-      #:unary-operator
+    '(;;; for representing js code as s-expressions
+
+      ;; operators
+      ; arithmetic
+      #:+
+      #:-
+      #:*
+      #:/
+      #:%
+
+      ; bitwise
+      #:&
+      #:|\||
+      #:^
+      #:~
+      #:>>
+      #:<<
+      #:>>>
+
+      ; assignment
+      #:=
+      #:+=
+      #:-=
+      #:*=
+      #:/=
+      #:%=
+      #:&=
+      #:\|=
+      #:^+
+      #:>>=
+      #:<<=
+      #:>>>=
+
+      ; increment/decrement
+      #:++
       #:--
+
+      ; comparison
+      #:==
+      #:===
+      #:!=
+      #:!==
+      #:>
+      #:>=
+      #:<
+      #:<=
+
+      ; logical
+      #:&&
+      #:||||
       #:!
+      
+      ; misc
+      #:? ; ternary
+      #:|,|
+      #:delete
+      #:function
+      #:get
+      #:in
+      #:instanceof
+      #:new
+      #:this
+      #:typeof
+      #:void
+      
+
+      ;; statements
       #:block
-      #:literal
       #:break
       #:continue
+      #:do-while
+      #:for
+      #:for-in
+      #:if
+      #:label
       #:return
+      #:switch
       #:throw
+      #:try
+      #:var
+      #:while
+      #:with
+
+      
+      #:unary-operator
+      #:literal
       #:array
       #:aref
-      #:++
-      #:+=
       #:operator
-      #:-=
-      #:-
-      #:=
       #:cond
       #:lambda
       #:object
       #:variable
       #:slot-value
-      #:new
       #:funcall
-      #:instanceof
-      #:in
       #:escape
       ))
   )
index ef77c6f..2f6e2a0 100644 (file)
@@ -16,7 +16,7 @@ vice-versa.")
   (let ((*indent-level* 0)
         (*print-accumulator* ()))
     (if (and (listp form) (eq 'js:block (car form))) ; ignore top-level block
-        (loop for (statement . remaining) on (third form) do
+        (loop for (statement . remaining) on (cdr form) do
              (ps-print statement) (psw ";") (when remaining (psw #\Newline)))
         (ps-print form))
     (nreverse *print-accumulator*)))
@@ -168,21 +168,20 @@ arguments, defines a printer for that form using the given body."
            fun-designator)
   (psw #\() (print-comma-delimited-list args) (psw #\)))
 
-(defprinter js:block (block-type statements)
-  (case block-type
-    (:statement
-     (psw #\{)
-     (incf *indent-level*)
-     (dolist (statement statements)
-       (newline-and-indent) (ps-print statement) (psw #\;))
-     (decf *indent-level*)
-     (newline-and-indent)
-     (psw #\}))
-    (:expression
-     (psw #\()
-     (loop for (statement . remaining) on statements do
-           (ps-print statement) (when remaining (psw ", ")))
-     (psw #\)))))
+(defprinter js:|,| (&rest expressions)
+  (psw #\()
+  (loop for (exp . remaining) on expressions do
+       (ps-print exp) (when remaining (psw ", ")))
+  (psw #\)))
+
+(defprinter js:block (&rest statements)
+  (psw #\{)
+  (incf *indent-level*)
+  (dolist (statement statements)
+    (newline-and-indent) (ps-print statement) (psw #\;))
+  (decf *indent-level*)
+  (newline-and-indent)
+  (psw #\}))
 
 (defprinter js:lambda (args body)
   (print-fun-def nil args body))
@@ -218,22 +217,17 @@ arguments, defines a printer for that form using the given body."
       (progn (psw #\.) (psw (js-translate-symbol slot)))
       (progn (psw #\[) (ps-print slot) (psw #\]))))
 
-(defprinter js:cond (clauses)
-  (loop for (test body-block) in clauses
-        for start = "if (" then " else if (" do
-        (if (equalp test "true")
-            (psw " else ")
-            (progn (psw start)
-                   (ps-print test)
-                   (psw ") ")))
-        (ps-print body-block)))
-
-(defprinter js:if (test then-block else-block)
+(defprinter js:if (test consequent &rest clauses)
   (psw "if (") (ps-print test) (psw ") ")
-  (ps-print then-block)
-  (when else-block
-      (psw " else ")
-      (ps-print else-block)))
+  (ps-print consequent)
+  (loop while clauses do
+       (ecase (car clauses)
+         (:else-if (psw " else if (") (ps-print (cadr clauses)) (psw ") ")
+                   (ps-print (caddr clauses))
+                   (setf clauses (cdddr clauses)))
+         (:else (psw " else ")
+                (ps-print (cadr clauses))
+                (return)))))
 
 (defprinter js:? (test then else)
   (ps-print test)
index ad49e28..f7e8304 100644 (file)
   (when body
     (if (and (listp (car body))
              (eq 'js:block (caar body)))
-        (append (third (car body)) (flatten-blocks (cdr body)))
+        (append (cdr (car body)) (flatten-blocks (cdr body)))
         (cons (car body) (flatten-blocks (cdr body))))))
 
 (defun constant-literal-form-p (form)
 (define-ps-special-form progn (&rest body)
   (if (and (eq expecting :expression) (= 1 (length body)))
       (compile-parenscript-form (car body) :expecting :expression)
-      `(js:block
-           ,expecting
-         ,(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
-                                                              (compile-parenscript-form form :expecting expecting))
-                                                            body)))))
+      `(,(if (eq expecting :expression) 'js:|,| 'js:block)
+         ,@(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
+                                                               (compile-parenscript-form form :expecting expecting))
+                                                             body)))))
                  (append (remove-if #'constant-literal-form-p (butlast block)) (last block))))))
 
 (define-ps-special-form cond (&rest clauses)
   (ecase expecting
-    (:statement `(js:cond ,(mapcar (lambda (clause)
-                                     (destructuring-bind (test &rest body)
-                                         clause
-                                       (list (compile-parenscript-form test :expecting :expression)
-                                             (compile-parenscript-form `(progn ,@body) :expecting :statement))))
-                                   clauses)))
+    (:statement `(js:if ,(compile-parenscript-form (caar clauses) :expecting :expression)
+                        ,(compile-parenscript-form `(progn ,@(cdar clauses)))
+                        ,@(loop for (test . body) in (cdr clauses) appending
+                               (if (eq t test)
+                                   `(:else ,(compile-parenscript-form `(progn ,@body) :expecting :statement))
+                                   `(:else-if ,(compile-parenscript-form test :expecting :expression)
+                                              ,(compile-parenscript-form `(progn ,@body) :expecting :statement))))))
     (:expression (make-cond-clauses-into-nested-ifs clauses))))
 
 (defun make-cond-clauses-into-nested-ifs (clauses)
   (ecase expecting
     (:statement `(js:if ,(compile-parenscript-form test :expecting :expression)
                         ,(compile-parenscript-form `(progn ,then))
-                        ,(when else (compile-parenscript-form `(progn ,else)))))
+                        ,@(when else `(:else ,(compile-parenscript-form `(progn ,else))))))
     (:expression `(js:? ,(compile-parenscript-form test :expecting :expression)
                         ,(compile-parenscript-form then :expecting :expression)
                         ,(compile-parenscript-form else :expecting :expression)))))
index 1c52019..4d9c60e 100644 (file)
@@ -465,7 +465,8 @@ __setf_someThing(_js1, _js2, _js3);")
 }")
 
 (test-ps-js cond2
-  (cond ((= x 1) 2) ((= y (* x 4)) (foo "blah") (* x y)))
+  (cond ((= x 1) 2)
+        ((= y (* x 4)) (foo "blah") (* x y)))
   "if (x == 1) {
     2;
 } else if (y == x * 4) {