Added support for &whole arguments in ps macro lambda lists; renamed parser.lisp...

diff --git a/parenscript.asd b/parenscript.asd
index 7f1cc75..75f4a5a 100644 (file)
--- a/parenscript.asd
+++ b/parenscript.asd
@@ -20,8 +20,8 @@
                              (:file "utils" :depends-on ("package"))
                              (:file "namespace" :depends-on ("package"))
                              (:file "parse-lambda-list" :depends-on ("package"))
-                            (:file "parser" :depends-on ("namespace"))
-                            (:file "js-macrology" :depends-on ("parser"))
+                            (:file "compiler" :depends-on ("namespace"))
+                            (:file "js-macrology" :depends-on ("compiler"))
                             (:file "ps-macrology" :depends-on ("js-macrology" "parse-lambda-list"))
                             (:file "js-translation" :depends-on ("ps-macrology"))
                             (:file "compilation-interface" :depends-on ("package" "js-translation"))

diff --git a/src/parser.lisp b/src/compiler.lisp
similarity index 93%
rename from src/parser.lisp
rename to src/compiler.lisp
index 4b554cd..792b485 100644 (file)
--- a/src/parser.lisp
+++ b/src/compiler.lisp
@@ -1,6 +1,6 @@
 (in-package :parenscript)
 
-;;;; The mechanisms for defining macros & parsing Parenscript.
+;;;; The mechanisms for parsing Parenscript.
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defvar *toplevel-special-forms* (make-hash-table :test #'equal)
     "A hash-table containing functions that implement Parenscript special forms,
@@ -105,16 +105,21 @@ function and the parent macro environment of the macro."
     (values (cdr macro-spec) parent-env)))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun make-ps-macro-function (args body)
+    (let* ((whole-var (when (eql '&whole (first args)) (second args)))
+           (effective-lambda-list (if whole-var (cddr args) args))
+           (form-arg (or whole-var (gensym "ps-macro-form-arg-")))
+           (body (if (and (cdr body) (stringp (first body))) (rest body) body))) ;; drop docstring
+      (compile nil `(lambda (,form-arg)
+                     (destructuring-bind ,effective-lambda-list
+                         (cdr ,form-arg)
+                       ,@body)))))
+      
   (defun define-script-macro% (name args body &key symbol-macro-p)
-    (let ((lambda-list (gensym "ps-lambda-list-"))
-         (body (if (and (cdr body) (stringp (first body))) (rest body) body))) ;; drop docstring
-      (undefine-ps-special-form name)
-      (setf (get-macro-spec name *script-macro-toplevel*)
-           (cons symbol-macro-p (compile nil `(lambda (&rest ,lambda-list)
-                                               (destructuring-bind ,args
-                                                   ,lambda-list
-                                                 ,@body)))))
-      nil)))
+    (undefine-ps-special-form name)
+    (setf (get-macro-spec name *script-macro-toplevel*)
+          (cons symbol-macro-p (make-ps-macro-function args body)))
+    nil))
 
 (defmacro defpsmacro (name args &body body)
   "Define a ParenScript macro, and store it in the toplevel ParenScript
@@ -162,7 +167,7 @@ whether any expansion was performed on the form or not."
                (if (equalp '(nil) args) nil form) ;; leave quotes alone, unless it's a quoted nil
                nil))
               ((script-macro-p op) ;; recursively expand parenscript macros in parent env.
-               (values (ps-macroexpand (apply (lookup-macro-expansion-function op) args)) t))
+               (values (ps-macroexpand (funcall (lookup-macro-expansion-function op) form)) t))
               (t (values form nil))))
       (cond ((script-symbol-macro-p form)
             ;; recursively expand symbol macros in parent env.

diff --git a/src/ps-macrology.lisp b/src/ps-macrology.lisp
index 04c64cc..0d5ac9f 100644 (file)
--- a/src/ps-macrology.lisp
+++ b/src/ps-macrology.lisp
@@ -108,11 +108,7 @@ gensym-prefix-string)."
       (destructuring-bind (name arglist &body body)
           macro
        (setf (get-macro-spec name macro-env-dict)
-             (cons nil (let ((args (gensym "ps-macrolet-args-")))
-                          (compile nil `(lambda (&rest ,args)
-                                         (destructuring-bind ,arglist
-                                             ,args
-                                           ,@body))))))))
+             (cons nil (make-ps-macro-function arglist body)))))
     (compile-parenscript-form `(progn ,@body))))
 
 (define-ps-special-form symbol-macrolet (expecting symbol-macros &body body)

diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 4fbf3db..fe6112c 100644 (file)
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -415,3 +415,10 @@ x = 2 + sideEffect() + x + 5;")
     };
 };
 "))))
+
+(test-ps-js ampersand-whole-1
+  (macrolet ((foo (&whole foo bar baz)
+               (declare (ignore bar baz))
+               (format nil "~a" foo)))
+    (foo 1 2))
+  "'(FOO 1 2)';")
\ No newline at end of file