Modified the PS compiler to produce an intermediate representation that looks like...

Removed the doeach macro.

diff --git a/docs/reference.lisp b/docs/reference.lisp
index 8ead719..ec5a813 100644 (file)
--- a/docs/reference.lisp
+++ b/docs/reference.lisp
@@ -805,14 +805,14 @@ a-variable  => aVariable
 ;;;t \index{DO}
 ;;;t \index{DOTIMES}
 ;;;t \index{DOLIST}
-;;;t \index{DOEACH}
+;;;t \index{FOR-IN}
 ;;;t \index{WHILE}
 
 ; (DO ({var | (var {init}? {step}?)}*) (end-test {result}?) body)
 ; (DO* ({var | (var {init}? {step}?)}*) (end-test {result}?) body)
 ; (DOTIMES (var numeric-form {result}?) body)
 ; (DOLIST (var list-form {result}?) body)
-; (DOEACH ({var | (key value)} object-form {result}?) body)
+; (FOR-IN (var object) body)
 ; (WHILE end-test body)
 ;
 ; var          ::= a Lisp symbol
@@ -926,28 +926,16 @@ a-variable  => aVariable
        return s;
    })());
 
-;;; `DOEACH' iterates across the enumerable properties of JS objects,
-;;; binding either simply the key of each slot, or alternatively, both
-;;; the key and the value.
+;;; `FOR-IN' is translated to the JS `for...in' statement.
 
 (let* ((obj (create :a 1 :b 2 :c 3)))
-  (doeach (i obj)
+  (for-in (i obj)
     (document.write (+ i ": " (aref obj i) "<br/>"))))
 => var obj = { a : 1, b : 2, c : 3 };
    for (var i in obj) {
        document.write(i + ': ' + obj[i] + '<br/>');
    };
 
-(let* ((obj (create :a 1 :b 2 :c 3)))
-  (doeach ((k v) obj)
-    (document.write (+ k ": " v "<br/>"))))
-=> var obj = { a : 1, b : 2, c : 3 };
-   var v;
-   for (var k in obj) {
-       v = obj[k];
-       document.write(k + ': ' + v + '<br/>');
-   };
-
 ;;; The `WHILE' form is transformed to the JavaScript form `while',
 ;;; and loops until a termination test evaluates to false.
 

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 3cf539e..160ff52 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -198,7 +198,7 @@ compiled to an :expression (the default), a :statement, or a
 resultant symbol has an associated script-package. Raises an error if
 the form cannot be compiled to a symbol."
   (let ((exp (compile-parenscript-form form)))
-    (when (eql (first exp) 'js-variable)
+    (when (eq (first exp) 'js:variable)
       (setf exp (second exp)))
     (assert (symbolp exp) ()
             "~a is expected to be a symbol, but compiles to ~a (the ParenScript output for ~a alone is \"~a\"). This could be due to ~a being a special form." form exp form (ps* form) form)
@@ -227,7 +227,7 @@ the form cannot be compiled to a symbol."
          (if (ps-literal-p symbol)
              (funcall (get-ps-special-form symbol) :symbol)
              (error "Attempting to use Parenscript special form ~a as variable" symbol)))
-        (t (list 'js-variable symbol))))
+        (t `(js:variable ,symbol))))
 
 (defun ps-convert-op-name (op)
   (case (ensure-ps-symbol op)
@@ -243,13 +243,12 @@ the form cannot be compiled to a symbol."
          (args (cdr form)))
     (cond ((ps-special-form-p form) (apply (get-ps-special-form name) (cons expecting args)))
           ((op-form-p form)
-           (list 'operator
-                 (ps-convert-op-name (compile-parenscript-form (first form) :expecting :symbol))
-                 (mapcar (lambda (form) (compile-parenscript-form form :expecting :expression)) (rest form))))
+           `(js:operator
+                 ,(ps-convert-op-name (compile-parenscript-form (first form) :expecting :symbol))
+                 ,@(mapcar (lambda (form) (compile-parenscript-form form :expecting :expression)) (rest form))))
           ((funcall-form-p form)
-           (list 'js-funcall
-                 (compile-parenscript-form name :expecting :expression)
-                 (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression)) args)))
+           `(js:funcall ,(compile-parenscript-form name :expecting :expression)
+             ,@(mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression)) args)))
           (t (error "Cannot compile ~S to a ParenScript form." form)))))
 
 (defvar *ps-gensym-counter* 0)

diff --git a/src/package.lisp b/src/package.lisp
index b078cba..452de0e 100644 (file)
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -92,7 +92,6 @@
       #:do*
       #:dotimes
       #:dolist
-      #:doeach
 
       ;; with
       #:with
@@ -250,6 +249,31 @@
       #:if
       #:unary-operator
       #:--
+      #:!
+      #:block
+      #:literal
+      #:break
+      #:continue
+      #:return
+      #:throw
+      #:array
+      #:aref
+      #:++
+      #:+=
+      #:operator
+      #:-=
+      #:-
+      #:=
+      #:cond
+      #:lambda
+      #:object
+      #:variable
+      #:slot-value
+      #:new
+      #:funcall
+      #:instanceof
+      #:in
+      #:escape
       ))
   )
 

diff --git a/src/printer.lisp b/src/printer.lisp
index c4ce792..778cd6b 100644 (file)
--- a/src/printer.lisp
+++ b/src/printer.lisp
@@ -15,11 +15,11 @@ vice-versa.")
 (defmethod parenscript-print (form)
   (let ((*indent-level* 0)
         (*print-accumulator* ()))
-      (if (and (listp form) (eql 'js-block (car form))) ; ignore top-level block
-          (loop for (statement . remaining) on (third form) do
-               (ps-print statement) (psw ";") (when remaining (psw #\Newline)))
-          (ps-print form))
-      (nreverse *print-accumulator*)))
+    (if (and (listp form) (eq 'js:block (car form))) ; ignore top-level block
+        (loop for (statement . remaining) on (third form) do
+             (ps-print statement) (psw ";") (when remaining (psw #\Newline)))
+        (ps-print form))
+    (nreverse *print-accumulator*)))
 
 (defun psw (obj)
   (push (if (characterp obj) (string obj) obj) *print-accumulator*))
@@ -83,10 +83,10 @@ arguments, defines a printer for that form using the given body."
 (defun expression-precedence (expr)
   (if (consp expr)
       (case (car expr)
-        ((js-slot-value js-aref) (op-precedence (car expr)))
-        (js-assign (op-precedence '=))
+        ((js:slot-value js:aref) (op-precedence (car expr)))
+        (js:= (op-precedence 'js:=))
         (js:? (op-precedence 'js:?))
-        (unary-operator (op-precedence (second expr)))
+        (js:unary-operator (op-precedence (second expr)))
         (operator (op-precedence (second expr)))
         (otherwise 0))
       0))
@@ -95,13 +95,13 @@ arguments, defines a printer for that form using the given body."
   (defparameter *op-precedence-hash* (make-hash-table :test 'eq))
 
   (let ((precedence 1))
-    (dolist (ops '((new js-slot-value js-aref)
+    (dolist (ops '((js:new js:slot-value js:aref)
                    (postfix++ postfix--)
                    (delete void typeof ++ -- unary+ unary- ~ !)
                    (* / %)
                    (+ -)
                    (<< >> >>>)
-                   (< > <= >= js-instance-of in)
+                   (< > <= >= js:instanceof js:in)
                    (== != === !== eql)
                    (&)
                    (^)
@@ -109,7 +109,7 @@ arguments, defines a printer for that form using the given body."
                    (\&\& and)
                    (\|\| or)
                    (js:?)
-                   (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|= js-assign)
+                   (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|=)
                    (comma)))
       (dolist (op ops)
         (setf (gethash op *op-precedence-hash*) precedence))
@@ -118,31 +118,31 @@ arguments, defines a printer for that form using the given body."
   (defun op-precedence (op)
     (gethash op *op-precedence-hash*)))
 
-(defprinter js-literal (str)
+(defprinter js:literal (str)
   (psw str))
 
 (defun print-comma-delimited-list (ps-forms)
   (loop for (form . remaining) on ps-forms do
         (ps-print form) (when remaining (psw ", "))))
 
-(defprinter array-literal (&rest initial-contents)
+(defprinter js:array (&rest initial-contents)
   (psw #\[) (print-comma-delimited-list initial-contents) (psw #\]))
 
-(defprinter js-aref (array indices)
-  (if (>= (expression-precedence array) #.(op-precedence 'js-aref))
+(defprinter js:aref (array indices)
+  (if (>= (expression-precedence array) #.(op-precedence 'js:aref))
       (parenthesize-print array)
       (ps-print array))
   (loop for idx in indices do
         (psw #\[) (ps-print idx) (psw #\])))
 
-(defprinter js-variable (var)
+(defprinter js:variable (var)
   (psw (js-translate-symbol var)))
 
 ;;; arithmetic operators
 (defun parenthesize-print (ps-form)
   (psw #\() (ps-print ps-form) (psw #\)))
 
-(defprinter operator (op args)
+(defprinter js:operator (op &rest args)
   (loop for (arg . remaining) on args
         with precedence = (op-precedence op) do
         (if (>= (expression-precedence arg) precedence)
@@ -150,7 +150,7 @@ arguments, defines a printer for that form using the given body."
             (ps-print arg))
         (when remaining (psw (format nil " ~(~A~) " op)))))
 
-(defprinter unary-operator (op arg &key prefix space)
+(defprinter js:unary-operator (op arg &key prefix space)
   (when prefix (psw (format nil "~(~a~)~:[~; ~]" op space)))
   (if (> (expression-precedence arg)
          (op-precedence (case op
@@ -161,14 +161,14 @@ arguments, defines a printer for that form using the given body."
       (ps-print arg))
   (unless prefix (psw (format nil "~(~a~)" op))))
 
-(defprinter js-funcall (fun-designator args)
-  (funcall (if (member (car fun-designator) '(js-variable js-aref js-slot-value js-funcall))
+(defprinter js:funcall (fun-designator &rest args)
+  (funcall (if (member (car fun-designator) '(js:variable js:aref js:slot-value js:funcall))
                #'ps-print
                #'parenthesize-print)
            fun-designator)
   (psw #\() (print-comma-delimited-list args) (psw #\)))
 
-(defprinter js-block (block-type statements)
+(defprinter js:block (block-type statements)
   (case block-type
     (:statement
      (psw #\{)
@@ -184,10 +184,10 @@ arguments, defines a printer for that form using the given body."
            (ps-print statement) (when remaining (psw ", ")))
      (psw #\)))))
 
-(defprinter js-lambda (args body)
+(defprinter js:lambda (args body)
   (print-fun-def nil args body))
 
-(defprinter js-defun (name args body)
+(defprinter js:defun (name args body)
   (print-fun-def name args body))
 
 (defun print-fun-def (name args body-block)
@@ -197,7 +197,7 @@ arguments, defines a printer for that form using the given body."
   (psw ") ")
   (ps-print body-block))
 
-(defprinter js-object (slot-defs)
+(defprinter js:object (&rest slot-defs)
   (psw "{ ")
   (loop for ((slot-name . slot-value) . remaining) on slot-defs do
         (if (and (listp slot-name) (eq 'quote (car slot-name)) (symbolp (second slot-name)))
@@ -208,17 +208,17 @@ arguments, defines a printer for that form using the given body."
         (when remaining (psw ", ")))
   (psw " }"))
 
-(defprinter js-slot-value (obj slot)
-  (if (or (> (expression-precedence obj) #.(op-precedence 'js-slot-value))
+(defprinter js:slot-value (obj slot)
+  (if (or (> (expression-precedence obj) #.(op-precedence 'js:slot-value))
           (numberp obj)
-          (and (listp obj) (member (car obj) '(js-lambda js-object))))
+          (and (listp obj) (member (car obj) '(js:lambda js:object))))
       (parenthesize-print obj)
       (ps-print obj))
   (if (symbolp slot)
       (progn (psw #\.) (psw (js-translate-symbol slot)))
       (progn (psw #\[) (ps-print slot) (psw #\]))))
 
-(defprinter js-cond-statement (clauses)
+(defprinter js:cond (clauses)
   (loop for (test body-block) in clauses
         for start = "if (" then " else if (" do
         (if (equalp test "true")
@@ -246,30 +246,30 @@ arguments, defines a printer for that form using the given body."
       (parenthesize-print else)
       (ps-print else)))
 
-(defprinter js-assign (lhs rhs)
+(defprinter js:= (lhs rhs)
   (ps-print lhs) (psw " = ") (ps-print rhs))
 
-(defprinter js-var (var-name &rest var-value)
+(defprinter js:var (var-name &rest var-value)
   (psw "var ")
   (psw (js-translate-symbol var-name))
   (when var-value
     (psw " = ")
     (ps-print (car var-value))))
 
-(defprinter js-break (&optional label)
+(defprinter js:break (&optional label)
   (psw "break")
   (when label
     (psw " ")
     (psw (js-translate-symbol label))))
 
-(defprinter js-continue (&optional label)
+(defprinter js:continue (&optional label)
   (psw "continue")
   (when label
     (psw " ")
     (psw (js-translate-symbol label))))
 
 ;;; iteration
-(defprinter js-for (label vars tests steps body-block)
+(defprinter js:for (label vars tests steps body-block)
   (when label (psw (js-translate-symbol label)) (psw ": ") (newline-and-indent))
   (psw "for (")
   (loop for ((var-name . var-init) . remaining) on vars
@@ -284,7 +284,7 @@ arguments, defines a printer for that form using the given body."
   (psw ") ")
   (ps-print body-block))
 
-(defprinter js-for-in (var object body-block)
+(defprinter js:for-in (var object body-block)
   (psw "for (") (ps-print var) (psw " in ")
   (if (> (expression-precedence object) (op-precedence 'in))
       (parenthesize-print object)
@@ -292,15 +292,15 @@ arguments, defines a printer for that form using the given body."
   (psw ") ")
   (ps-print body-block))
 
-(defprinter js-while (test body-block)
+(defprinter js:while (test body-block)
   (psw "while (") (ps-print test) (psw ") ")
   (ps-print body-block))
 
-(defprinter js-with (expression body-block)
+(defprinter js:with (expression body-block)
   (psw "with (") (ps-print expression) (psw ") ")
   (ps-print body-block))
 
-(defprinter js-switch (test clauses)
+(defprinter js:switch (test clauses)
   (flet ((print-body-statements (body-statements)
            (incf *indent-level*)
            (loop for statement in body-statements do
@@ -321,7 +321,7 @@ arguments, defines a printer for that form using the given body."
     (newline-and-indent)
     (psw #\})))
 
-(defprinter js-try (body-block &key catch finally)
+(defprinter js:try (body-block &key catch finally)
   (psw "try ")
   (ps-print body-block)
   (when catch
@@ -332,42 +332,40 @@ arguments, defines a printer for that form using the given body."
     (ps-print finally)))
 
 ;;; regex
-(defprinter js-regex (regex)
+(defprinter js:regex (regex)
   (flet ((first-slash-p (string)
            (and (> (length string) 0) (char= (char string 0) #\/))))
     (let ((slash (unless (first-slash-p regex) "/")))
       (psw (format nil (concatenate 'string slash "~A" slash) regex)))))
 
 ;;; conditional compilation
-(defprinter cc-if (test body-forms)
+(defprinter js:cc-if (test &rest body)
   (psw "/*@if ")
   (ps-print test)
   (incf *indent-level*)
-  (dolist (form body-forms)
+  (dolist (form body)
     (newline-and-indent) (ps-print form) (psw #\;))
   (decf *indent-level*)
   (newline-and-indent)
   (psw "@end @*/"))
 
-(defprinter js-instanceof (value type)
+(defprinter js:instanceof (value type)
   (psw #\()
-  (if (> (expression-precedence value) (op-precedence 'js-instance-of))
+  (if (> (expression-precedence value) (op-precedence 'js:instanceof))
       (parenthesize-print value)
       (ps-print value))
   (psw " instanceof ")
-  (if (> (expression-precedence type) (op-precedence 'js-instance-of))
+  (if (> (expression-precedence type) (op-precedence 'js:instanceof))
       (parenthesize-print type)
       (ps-print type))
   (psw #\)))
 
-(defprinter js-escape (lisp-form)
-  (psw `(ps1* ,lisp-form)))
+(defprinter js:escape (literal-js)
+  (psw literal-js))
 
 ;;; named statements
-(macrolet ((def-stmt-printer (&rest stmts)
-             `(progn ,@(mapcar (lambda (stmt)
-                                 `(defprinter ,(intern (format nil "JS-~a" stmt)) (expr)
-                                    (psw (format nil "~(~a~) " ',stmt))
-                                    (ps-print expr)))
-                               stmts))))
-  (def-stmt-printer throw return))
+(defprinter js:throw (x)
+  (psw "throw ") (ps-print x))
+
+(defprinter js:return (x)
+  (psw "return ") (ps-print x))

diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index d34f501..0839dcb 100644 (file)
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -1,4 +1,4 @@
-(in-package :parenscript)
+(in-package "PARENSCRIPT")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; literals
@@ -6,7 +6,7 @@
   `(progn
      (add-ps-literal ',name)
      (define-ps-special-form ,name ()
-       (list 'js-literal ,string))))
+       (list 'js:literal ,string))))
 
 (defpsliteral this      "this")
 (defpsliteral t         "true")
@@ -21,8 +21,8 @@
                 (add-ps-literal ',name)
                 (define-ps-special-form ,name (&optional label)
                   (list ',printer label)))))
-  (def-for-literal break js-break)
-  (def-for-literal continue js-continue))
+  (def-for-literal break js:break)
+  (def-for-literal continue js:continue))
 
 (defpsmacro quote (x)
   (typecase x
@@ -39,7 +39,7 @@
                                  (let ((op (if (listp op) (car op) op))
                                        (spacep (if (listp op) (second op) nil)))
                                    `(define-ps-special-form ,op (x)
-                                      (list 'unary-operator ',op
+                                      (list 'js:unary-operator ',op
                                             (compile-parenscript-form x :expecting :expression)
                                             :prefix t :space ,spacep))))
                                ops))))
@@ -48,22 +48,22 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; statements
 (define-ps-special-form return (&optional value)
-  (list 'js-return (compile-parenscript-form value :expecting :expression)))
+  `(js:return ,(compile-parenscript-form value :expecting :expression)))
 
 (define-ps-special-form throw (value)
-  (list 'js-throw (compile-parenscript-form value :expecting :expression)))
+  `(js:throw ,(compile-parenscript-form value :expecting :expression)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; arrays
 (define-ps-special-form array (&rest values)
-  (cons 'array-literal (mapcar (lambda (form) (compile-parenscript-form form :expecting :expression))
+  `(js:array ,@(mapcar (lambda (form) (compile-parenscript-form form :expecting :expression))
                                values)))
 
 (define-ps-special-form aref (array &rest coords)
-  (list 'js-aref (compile-parenscript-form array :expecting :expression)
-        (mapcar (lambda (form)
-                  (compile-parenscript-form form :expecting :expression))
-                coords)))
+  `(js:aref ,(compile-parenscript-form array :expecting :expression)
+            ,(mapcar (lambda (form)
+                       (compile-parenscript-form form :expecting :expression))
+                     coords)))
 
 (defpsmacro list (&rest values)
   `(array ,@values))
@@ -74,47 +74,46 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; operators
 (define-ps-special-form incf (x &optional (delta 1))
-  (if (equal delta 1)
-      (list 'unary-operator '++ (compile-parenscript-form x :expecting :expression) :prefix t)
-      (list 'operator '+= (list (compile-parenscript-form x :expecting :expression)
-                                (compile-parenscript-form delta :expecting :expression)))))
+  (if (eql delta 1)
+      `(js:unary-operator js:++ ,(compile-parenscript-form x :expecting :expression) :prefix t)
+      `(js:operator js:+= ,(compile-parenscript-form x :expecting :expression)
+                    ,(compile-parenscript-form delta :expecting :expression))))
 
 (define-ps-special-form decf (x &optional (delta 1))
-  (if (equal delta 1)
-      (list 'unary-operator '-- (compile-parenscript-form x :expecting :expression) :prefix t)
-      (list 'operator '-= (list (compile-parenscript-form x :expecting :expression)
-                                (compile-parenscript-form delta :expecting :expression)))))
+  (if (eql delta 1)
+      `(js:unary-operator js:-- ,(compile-parenscript-form x :expecting :expression) :prefix t)
+      `(js:operator js:-= ,(compile-parenscript-form x :expecting :expression)
+                    ,(compile-parenscript-form delta :expecting :expression))))
 
 (define-ps-special-form - (first &rest rest)
-  (if (null rest)
-      (list 'unary-operator '- (compile-parenscript-form first :expecting :expression) :prefix t)
-      (list 'operator '- (mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
-                                 (cons first rest)))))
+  (if rest
+      `(js:operator js:- ,@(mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
+                                   (cons first rest)))
+      `(js:unary-operator js:- ,(compile-parenscript-form first :expecting :expression) :prefix t)))
 
 (define-ps-special-form not (x)
   (let ((form (compile-parenscript-form x :expecting :expression))
-        (not-op nil))
-    (if (and (eql (first form) 'operator)
-             (= (length (third form)) 2)
-             (setf not-op (case (second form)
-                            (== '!=)
-                            (< '>=)
-                            (> '<=)
-                            (<= '>)
-                            (>= '<)
-                            (!= '==)
-                            (=== '!==)
-                            (!== '===)
-                            (t nil))))
-        (list 'operator not-op (third form))
-        (list 'unary-operator '! form :prefix t))))
+        inverse-op)
+    (if (and (eq (car form) 'js:operator)
+             (= (length (cddr form)) 2)
+             (setf inverse-op (case (cadr form)
+                                (== '!=)
+                                (< '>=)
+                                (> '<=)
+                                (<= '>)
+                                (>= '<)
+                                (!= '==)
+                                (=== '!==)
+                                (!== '===))))
+        `(js:operator ,inverse-op ,@(cddr form))
+        `(js:unary-operator js:! ,form :prefix t))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; control structures
 (defun flatten-blocks (body)
   (when body
     (if (and (listp (car body))
-             (eql 'js-block (caar body)))
+             (eq 'js:block (caar body)))
         (append (third (car body)) (flatten-blocks (cdr body)))
         (cons (car body) (flatten-blocks (cdr body))))))
 
@@ -122,31 +121,26 @@
   (or (numberp form)
       (stringp form)
       (and (listp form)
-           (eql 'js-literal (car form)))))
+           (eq 'js:literal (car form)))))
 
 (define-ps-special-form progn (&rest body)
   (if (and (eq expecting :expression) (= 1 (length body)))
       (compile-parenscript-form (car body) :expecting :expression)
-      (list 'js-block
-            expecting
-            (let* ((block (mapcar (lambda (form)
-                                    (compile-parenscript-form form :expecting expecting))
-                                  body))
-                   (clean-block (remove nil block))
-                   (flat-block (flatten-blocks clean-block))
-                   (reachable-block (append (remove-if #'constant-literal-form-p (butlast flat-block))
-                                            (last flat-block))))
-              reachable-block))))
+      `(js:block
+           ,expecting
+         ,(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 (list 'js-cond-statement
-                      (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: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)))
     (:expression (make-cond-clauses-into-nested-ifs clauses))))
 
 (defun make-cond-clauses-into-nested-ifs (clauses)
@@ -158,7 +152,7 @@
             `(js:? ,(compile-parenscript-form test :expecting :expression)
                    ,(compile-parenscript-form `(progn ,@body) :expecting :expression)
                    ,(make-cond-clauses-into-nested-ifs (cdr clauses)))))
-      (compile-parenscript-form nil :expecting :expression)))
+      (compile-parenscript-form nil :expecting :expression))) ;; js:null
 
 (define-ps-special-form if (test then &optional else)
   (ecase expecting
@@ -170,18 +164,13 @@
                         ,(compile-parenscript-form else :expecting :expression)))))
 
 (define-ps-special-form switch (test-expr &rest clauses)
-  (let ((clauses (mapcar (lambda (clause)
-                             (let ((val (car clause))
-                                   (body (cdr clause)))
-                               (cons (if (and (symbolp val)
-                                              (eq (ensure-ps-symbol val) 'default))
-                                         'default
-                                         (compile-parenscript-form val :expecting :expression))
-                                     (mapcar (lambda (statement) (compile-parenscript-form statement :expecting :statement))
-                                             body))))
-                         clauses))
-        (expr (compile-parenscript-form test-expr :expecting :expression)))
-    (list 'js-switch expr clauses)))
+  `(js:switch ,(compile-parenscript-form test-expr :expecting :expression)
+     ,(loop for (val . body) in clauses collect
+           (cons (if (and (symbolp val) (eq (ensure-ps-symbol val) 'default))
+                     'default
+                     (compile-parenscript-form val :expecting :expression))
+                 (mapcar (lambda (x) (compile-parenscript-form x :expecting :statement))
+                         body)))))
 
 (defpsmacro case (value &rest clauses)
   (labels ((make-clause (val body more)
@@ -212,14 +201,16 @@
           ;; the first compilation will produce a list of variables we need to declare in the function body
           (compile-parenscript-form `(progn ,@body) :expecting :statement)
           ;; now declare and compile
-          (compile-parenscript-form `(progn ,@(loop for var in *enclosing-lexical-block-declarations* collect `(var ,var))
-                                      ,@body) :expecting :statement))))
+          (compile-parenscript-form `(progn
+                                       ,@(mapcar (lambda (var) `(var ,var)) *enclosing-lexical-block-declarations*)
+                                       ,@body)
+                                    :expecting :statement))))
 
 (define-ps-special-form %js-lambda (args &rest body)
-  (cons 'js-lambda (compile-function-definition args body)))
+  `(js:lambda ,@(compile-function-definition args body)))
 
 (define-ps-special-form %js-defun (name args &rest body)
-  (append (list 'js-defun name) (compile-function-definition args body)))
+  `(js:defun ,name ,@(compile-function-definition args body)))
 
 (defun parse-function-body (body)
   (let* ((docstring
@@ -314,7 +305,7 @@ the given lambda-list and body."
             (if rest?
                 (with-ps-gensyms (i)
                   `(progn (var ,rest (array))
-                    (dotimes (,i (- arguments.length ,(length effective-args)))
+                    (dotimes (,i (- (slot-value arguments 'length) ,(length effective-args)))
                       (setf (aref ,rest ,i) (aref arguments (+ ,i ,(length effective-args)))))))
                 `(progn)))
            (body-paren-forms (parse-function-body body)) ; remove documentation
@@ -429,11 +420,11 @@ lambda-list::=
               (cons t (lambda (x) (declare (ignore x)) expansion)))))
     (compile-parenscript-form `(progn ,@body))))
 
-(define-ps-special-form defmacro (name args &body body)
+(define-ps-special-form defmacro (name args &body body) ;; should this be a macro?
   (eval `(defpsmacro ,name ,args ,@body))
   nil)
 
-(define-ps-special-form define-symbol-macro (name expansion)
+(define-ps-special-form define-symbol-macro (name expansion) ;; should this be a macro?
   (eval `(define-ps-symbol-macro ,name ,expansion))
   nil)
 
@@ -443,28 +434,28 @@ lambda-list::=
 (define-ps-symbol-macro {} (create))
 
 (define-ps-special-form create (&rest arrows)
-  (list 'js-object (loop for (key-expr val-expr) on arrows by #'cddr collecting
-                         (let ((key (compile-parenscript-form key-expr :expecting :expression)))
-                           (when (keywordp key)
-                             (setf key (list 'js-variable key)))
-                           (assert (or (stringp key)
-                                       (numberp key)
-                                       (and (listp key)
-                                            (or (eq 'js-variable (car key))
-                                                (eq 'quote (car key)))))
-                                   ()
-                                   "Slot key ~s is not one of js-variable, keyword, string or number." key)
-                           (cons key (compile-parenscript-form val-expr :expecting :expression))))))
+  `(js:object ,@(loop for (key-expr val-expr) on arrows by #'cddr collecting
+                     (let ((key (compile-parenscript-form key-expr :expecting :expression)))
+                       (when (keywordp key)
+                         (setf key `(js:variable ,key)))
+                       (assert (or (stringp key)
+                                   (numberp key)
+                                   (and (listp key)
+                                        (or (eq 'js:variable (car key))
+                                            (eq 'quote (car key)))))
+                               ()
+                               "Slot key ~s is not one of js-variable, keyword, string or number." key)
+                       (cons key (compile-parenscript-form val-expr :expecting :expression))))))
 
 (define-ps-special-form %js-slot-value (obj slot)
-  (list 'js-slot-value (compile-parenscript-form obj :expecting :expression)
-        (if (and (listp slot) (eq 'quote (car slot)))
-            (second slot) ;; assume we're quoting a symbol
-            (compile-parenscript-form slot))))
+  `(js:slot-value ,(compile-parenscript-form obj :expecting :expression)
+                  ,(if (and (listp slot) (eq 'quote (car slot)))
+                       (second slot) ;; assume we're quoting a symbol
+                       (compile-parenscript-form slot))))
 
 (define-ps-special-form instanceof (value type)
-  (list 'js-instanceof (compile-parenscript-form value :expecting :expression)
-        (compile-parenscript-form type :expecting :expression)))
+  `(js:instanceof ,(compile-parenscript-form value :expecting :expression)
+                  ,(compile-parenscript-form type :expecting :expression)))
 
 (defpsmacro slot-value (obj &rest slots)
   (if (null (rest slots))
@@ -497,21 +488,15 @@ lambda-list::=
     (/   '/=)
     (t   nil)))
 
-(defun smart-setf (lhs rhs)
-  (if (and (listp rhs)
-           (eql 'operator (car rhs))
-           (member lhs (third rhs) :test #'equalp))
-      (let ((args-without-first (remove lhs (third rhs) :count 1 :end 1 :test #'equalp)))
-        (cond ((and (assignment-op (second rhs))
-                    (member (second rhs) '(+ *))
-                    (equalp lhs (first (third rhs))))
-               (list 'operator (assignment-op (second rhs))
-                     (list lhs (list 'operator (second rhs) args-without-first))))
-              (t (list 'js-assign lhs rhs))))
-      (list 'js-assign lhs rhs)))
-
 (define-ps-special-form setf1% (lhs rhs)
-  (smart-setf (compile-parenscript-form lhs :expecting :expression) (compile-parenscript-form rhs :expecting :expression)))
+  (let ((lhs (compile-parenscript-form lhs :expecting :expression))
+        (rhs (compile-parenscript-form rhs :expecting :expression)))
+    (if (and (listp rhs)
+             (eq 'js:operator (car rhs))
+             (member (cadr rhs) '(+ *))
+             (equalp lhs (caddr rhs)))
+        `(js:operator ,(assignment-op (cadr rhs)) ,lhs (js:operator ,(cadr rhs) ,@(cdddr rhs)))
+        `(js:= ,lhs ,rhs))))
 
 (defpsmacro setf (&rest args)
   (flet ((process-setf-clause (place value-form)
@@ -546,17 +531,15 @@ lambda-list::=
   (check-setq-args args)
   `(psetf ,@args))
 
-(define-ps-special-form var (name &rest value)
-  (append (list 'js-var name)
-          (when value
-            (assert (= (length value) 1) () "Wrong number of arguments to var: ~s" `(var ,name ,@value))
-            (list (compile-parenscript-form (car value) :expecting :expression)))))
+(define-ps-special-form var (name &optional (value (values) value-provided?) documentation)
+  (declare (ignore documentation))
+  `(js:var ,name ,@(when value-provided?
+                         (list (compile-parenscript-form value :expecting :expression)))))
 
-(defpsmacro defvar (name &rest value)
+(defpsmacro defvar (name &optional (value (values) value-provided?) documentation)
   "Note: this must be used as a top-level form, otherwise the result will be undefined behavior."
   (pushnew name *ps-special-variables*)
-  (assert (or (null value) (= (length value) 1)) () "Wrong number of arguments to defvar: ~s" `(defvar ,name ,@value))
-  `(var ,name ,@value))
+  `(var ,name ,@(when value-provided? (list value))))
 
 (defun make-let-vars (bindings)
   (mapcar (lambda (x) (if (listp x) (car x) x)) bindings))
@@ -625,11 +608,11 @@ lambda-list::=
           init-forms))
 
 (define-ps-special-form labeled-for (label init-forms cond-forms step-forms &rest body)
-  (let ((vars (make-for-vars/inits init-forms))
-        (steps (mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) step-forms))
-        (tests (mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) cond-forms))
-        (body (compile-parenscript-form `(progn ,@body))))
-    (list 'js-for label vars tests steps body)))
+  `(js:for ,label
+           ,(make-for-vars/inits init-forms)
+           ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) cond-forms)
+           ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) step-forms)
+           ,(compile-parenscript-form `(progn ,@body))))
 
 (defpsmacro for (init-forms cond-forms step-forms &body body)
   `(labeled-for nil ,init-forms ,cond-forms ,step-forms ,@body))
@@ -687,43 +670,14 @@ lambda-list::=
               ,@body
               ,(do-make-iter-psteps decls)))))
 
-(define-ps-special-form for-in (decl &rest body)
-  (list 'js-for-in
-        (compile-parenscript-form (first decl) :expecting :expression)
-        (compile-parenscript-form (second decl) :expecting :expression)
-        (compile-parenscript-form `(progn ,@body))))
-
-(defpsmacro doeach ((var array &optional (result (values) result?)) &body body)
-  "Iterates over `array'.  If `var' is a symbol, binds `var' to each
-element key.  If `var' is a list, it must be a list of two
-symbols, (key value), which will be bound to each successive key/value
-pair in `array'."
-  (if result?
-      (if (consp var)
-          (destructuring-bind (key val) var
-            `((lambda ()
-                (let* (,val)
-                  (for-in ((var ,key) ,array)
-                    (setf ,val (aref ,array ,key))
-                    ,@body)
-                  (return ,result)))))
-          `((lambda ()
-              (for-in ((var ,var) ,array)
-                ,@body)
-              (return ,result))))
-      (if (consp var)
-          (destructuring-bind (key val) var
-            `(progn
-               (let* (,val)
-                 (for-in ((var ,key) ,array)
-                   (setf ,val (aref ,array ,key))
-                   ,@body))))
-          `(progn
-             (for-in ((var ,var) ,array) ,@body)))))
+(define-ps-special-form for-in ((var object) &rest body)
+  `(js:for-in ,(compile-parenscript-form `(var ,var) :expecting :expression)
+              ,(compile-parenscript-form object :expecting :expression)
+              ,(compile-parenscript-form `(progn ,@body))))
 
 (define-ps-special-form while (test &rest body)
-  (list 'js-while (compile-parenscript-form test :expecting :expression)
-                  (compile-parenscript-form `(progn ,@body))))
+  `(js:while ,(compile-parenscript-form test :expecting :expression)
+     ,(compile-parenscript-form `(progn ,@body))))
 
 (defpsmacro dotimes ((var count &optional (result nil result?)) &rest body)
   `(do* ((,var 0 (1+ ,var)))
@@ -744,8 +698,8 @@ pair in `array'."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; misc
 (define-ps-special-form with (expression &rest body)
-  (list 'js-with (compile-parenscript-form expression :expecting :expression)
-                 (compile-parenscript-form `(progn ,@body))))
+  `(js:with ,(compile-parenscript-form expression :expecting :expression)
+     ,(compile-parenscript-form `(progn ,@body))))
 
 (define-ps-special-form try (form &rest clauses)
   (let ((catch (cdr (assoc :catch clauses)))
@@ -753,18 +707,18 @@ pair in `array'."
     (assert (not (cdar catch)) nil "Sorry, currently only simple catch forms are supported.")
     (assert (or catch finally) ()
             "Try form should have either a catch or a finally clause or both.")
-    (list 'js-try (compile-parenscript-form `(progn ,form))
-          :catch (when catch (list (compile-parenscript-form (caar catch) :expecting :symbol)
+    `(js:try ,(compile-parenscript-form `(progn ,form))
+          :catch ,(when catch (list (compile-parenscript-form (caar catch) :expecting :symbol)
                                    (compile-parenscript-form `(progn ,@(cdr catch)))))
-          :finally (when finally (compile-parenscript-form `(progn ,@finally))))))
+          :finally ,(when finally (compile-parenscript-form `(progn ,@finally))))))
 
 (define-ps-special-form cc-if (test &rest body)
-  (list 'cc-if test (mapcar #'compile-parenscript-form body)))
+  `(js:cc-if ,test ,@(mapcar #'compile-parenscript-form body)))
 
 (define-ps-special-form regex (regex)
-  (list 'js-regex (string regex)))
+  `(js:regex ,(string regex)))
 
 (define-ps-special-form lisp (lisp-form)
   ;; (ps (foo (lisp bar))) is in effect equivalent to (ps* `(foo ,bar))
   ;; when called from inside of ps*, lisp-form has access only to the dynamic environment (like for eval)
-  (list 'js-escape lisp-form))
+  `(js:escape ,(ps1* lisp-form)))

diff --git a/src/utils.lisp b/src/utils.lisp
index 897305e..4e2066a 100644 (file)
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -103,4 +103,4 @@ SOMEGLOBAL."
 (defun flatten (x &optional acc)
   (cond ((null x) acc)
         ((atom x) (cons x acc))
-        (t (flatten (car x) (flatten (cdr x) acc)))))
\ No newline at end of file
+        (t (flatten (car x) (flatten (cdr x) acc)))))

diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 97b37dd..4e61258 100644 (file)
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -682,10 +682,6 @@ try {
   (instanceof (or a b) (if x y z))
   "((a || b) instanceof (x ? y : z))")
 
-(test-ps-js op-p6
-  (doeach (x (or a b)))
-  "for (var x in (a || b)) { };")
-
 (test-ps-js op-p7
   (or x (if (= x 0) "zero" "empty"))
   "x || (x == 0 ? 'zero' : 'empty')")

diff --git a/t/reference-tests.lisp b/t/reference-tests.lisp
index 3460390..0701942 100644 (file)
--- a/t/reference-tests.lisp
+++ b/t/reference-tests.lisp
@@ -507,7 +507,7 @@ alert('Sum of ' + l + ' is: ' + (function () {
 
 (test-ps-js iteration-constructs-8
   (let* ((obj (create :a 1 :b 2 :c 3)))
-  (doeach (i obj)
+  (for-in (i obj)
     (document.write (+ i ": " (aref obj i) "<br/>"))))
   "var obj = { a : 1, b : 2, c : 3 };
 for (var i in obj) {
@@ -515,17 +515,6 @@ for (var i in obj) {
 };")
 
 (test-ps-js iteration-constructs-9
-  (let* ((obj (create :a 1 :b 2 :c 3)))
-  (doeach ((k v) obj)
-    (document.write (+ k ": " v "<br/>"))))
-  "var obj = { a : 1, b : 2, c : 3 };
-var v;
-for (var k in obj) {
-    v = obj[k];
-    document.write(k + ': ' + v + '<br/>');
-};")
-
-(test-ps-js iteration-constructs-10
   (while (film.is-not-finished)
   (this.eat (new *popcorn)))
   "while (film.isNotFinished()) {