Fixed compilation of caller argument lists. Changed the handling of keyword symbols...
authorVladimir Sedach <vsedach@gmail.com>
Sat, 6 Dec 2008 05:20:44 +0000 (22:20 -0700)
committerVladimir Sedach <vsedach@gmail.com>
Sat, 6 Dec 2008 05:20:44 +0000 (22:20 -0700)
src/compiler.lisp
src/printer.lisp
src/special-forms.lisp
t/ps-tests.lisp

index e93d8e6..77a6815 100644 (file)
@@ -237,7 +237,8 @@ the form cannot be compiled to a symbol."
 
 (defmethod compile-parenscript-form ((symbol symbol) &key expecting)
   (declare (ignore expecting))
-  (cond ((ps-special-form-p (list symbol))
+  (cond ((keywordp symbol) symbol)
+        ((ps-special-form-p (list symbol))
          (if (ps-literal-p symbol)
              (funcall (get-ps-special-form symbol) :symbol)
              (error "Attempting to use Parenscript special form ~a as variable" symbol)))
@@ -247,25 +248,21 @@ the form cannot be compiled to a symbol."
   "Compiles a bunch of Parenscript forms from a funcall form to an effective set of
 Javascript arguments.  The only extra processing this does is makes :keyword arguments
 into a single options argument via CREATE."
-  (flet ((keyword-arg (arg)
-           "If the given compiled expression is supposed to be a keyword argument, returns
-the keyword for it."
-           (when (and (listp arg) (eql (first arg) 'ps-quote)) (second arg))))
-    (let ((compiled-args (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression))
-                                 arg-forms)))
-      (do ((effective-expressions nil)
-           (expressions-subl compiled-args))
-          ((not expressions-subl) (reverse effective-expressions))
-        (let ((arg-expr (first expressions-subl)))
-          (if (keyword-arg arg-expr)
-              (progn (when (oddp (length expressions-subl))
-                       (error "Odd number of keyword arguments: ~A." arg-forms))
-                     (push (list 'js-object (loop for (name val) on expressions-subl by #'cddr
-                                                  collect (list name val)))
-                           effective-expressions)
-                     (setf expressions-subl nil))
-              (progn (push arg-expr effective-expressions)
-                     (setf expressions-subl (rest expressions-subl)))))))))
+  (let ((compiled-args (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression))
+                               arg-forms)))
+    (do ((effective-expressions nil)
+         (expressions-subl compiled-args))
+        ((not expressions-subl) (reverse effective-expressions))
+      (let ((arg-expr (first expressions-subl)))
+        (if (keywordp arg-expr)
+            (progn (when (oddp (length expressions-subl))
+                     (error "Odd number of keyword arguments: ~A." arg-forms))
+                   (push (list 'js-object (loop for (name val) on expressions-subl by #'cddr
+                                             collect (list (list 'js-variable name) val)))
+                         effective-expressions)
+                   (setf expressions-subl nil))
+            (progn (push arg-expr effective-expressions)
+                   (setf expressions-subl (rest expressions-subl))))))))
 
 (defun ps-convert-op-name (op)
   (case (ensure-ps-symbol op)
index 9205789..bb9691c 100644 (file)
@@ -36,6 +36,10 @@ arguments, defines a printer for that form using the given body."
 (defmethod ps-print ((form null)) ; don't print top-level nils (ex: result of defining macros, etc.)
   )
 
+(defmethod ps-print ((s symbol))
+  (assert (keywordp s))
+  (ps-print (js-translate-symbol s)))
+
 (defmethod ps-print ((compiled-form cons))
   "Prints the given compiled ParenScript form starting at the given
 indent position."
index 7395e9f..e2b6ec9 100644 (file)
@@ -459,6 +459,8 @@ lambda-list::=
   (declare (ignore expecting))
   (list 'js-object (loop for (name val) on args by #'cddr collecting
                          (let ((name-expr (compile-parenscript-form name :expecting :expression)))
+                           (when (keywordp name-expr)
+                             (setf name-expr (list 'js-variable name-expr)))
                            (assert (or (stringp name-expr)
                                        (numberp name-expr)
                                        (and (listp name-expr)
index 4477531..0439ccb 100644 (file)
@@ -76,13 +76,13 @@ x = 2 + sideEffect() + x + 5;")
 
 (test-ps-js simple-slot-value
   (let* ((foo (create :a 1)))
-   (alert (slot-value foo 'a)))
+    (alert (slot-value foo 'a)))
   "var foo = { a : 1 };
    alert(foo.a);")
 
 (test-ps-js buggy-slot-value
    (let* ((foo (create :a 1))
-        (slot-name "a"))
+          (slot-name "a"))
     (alert (slot-value foo slot-name)))
   " var foo = { a : 1 };
     var slotName = 'a';
@@ -361,6 +361,39 @@ x = 2 + sideEffect() + x + 5;")
     return foo + bar + _js1.baz;
 }")
 
+(test-ps-js defun-keyword2
+  (defun zoo (&key baz) (return (* baz baz)))
+  "function zoo(_js1) {
+    if (_js1 === undefined) {
+        _js1 = {  };
+    };
+    return _js1.baz * _js1.baz;
+}")
+
+(test-ps-js defun-keyword3
+  (defun zoo (&key baz (bar 4)) (return (* baz bar)))
+  "function zoo(_js1) {
+    if (_js1 === undefined) {
+        _js1 = {  };
+    };
+    if (_js1.bar === undefined) {
+        _js1.bar = 4;
+    };
+    return _js1.baz * _js1.bar;
+}")
+
+(test-ps-js keyword-funcall1
+  (func :baz 1)
+  "func({ baz : 1 })")
+
+(test-ps-js keyword-funcall2
+  (func :baz 1 :bar foo)
+  "func({ baz : 1, bar : foo })")
+
+(test-ps-js keyword-funcall3
+  (fun a b :baz c)
+  "fun(a, b, { baz : c })")
+  
 (test-ps-js cond1
   (cond ((= x 1) 1))
   "if (x == 1) {
@@ -445,7 +478,7 @@ x = 2 + sideEffect() + x + 5;")
 
 (test-ps-js keyword-consistent
   :x
-  "x")
+  "'x'")
 
 (test-ps-js simple-symbol-macrolet
   (symbol-macrolet ((x 1)) x)