From 4525e3cd399d31c86b12d62281f7502310944644 Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vsedach@gmail.com>
Date: Mon, 13 Apr 2009 15:31:07 -0600
Subject: [PATCH] Introduced the *js-target-version* special variable, which is
 designed to control which version of JavaScript Parenscript is emitting code
 for. This can be used to emit shorter code for certain constructs (this patch
 uses this facility to generate shorter keyword-handling code for JS version
 1.6 and later).

---
 parenscript.asd                |  2 +-
 src/compilation-interface.lisp |  4 +++-
 src/package.lisp               |  1 +
 src/special-forms.lisp         | 36 +++++++++++++++++++++-------------
 t/ps-tests.lisp                | 10 ++++++++++
 t/test.lisp                    |  6 +++---
 6 files changed, 40 insertions(+), 19 deletions(-)

diff --git a/parenscript.asd b/parenscript.asd
index 86bae8a..c8d5696 100755
--- a/parenscript.asd
+++ b/parenscript.asd
@@ -21,9 +21,9 @@
                                      (:file "namespace")
                                      (:file "parse-lambda-list")
                                      (:file "compiler")
-                                     (:file "special-forms")
                                      (:file "printer")
                                      (:file "compilation-interface")
+                                     (:file "special-forms")
                                      (:file "deprecated-interface")
                                      (:file "js-dom-symbol-exports")
                                      ;; standard library
diff --git a/src/compilation-interface.lisp b/src/compilation-interface.lisp
index 8ba868c..e715279 100644
--- a/src/compilation-interface.lisp
+++ b/src/compilation-interface.lisp
@@ -1,4 +1,6 @@
-(in-package :parenscript)
+(in-package "PARENSCRIPT")
+
+(defvar *js-target-version* 1.3)
 
 (defmacro ps (&body body)
   "Given Parenscript forms (an implicit progn), compiles those forms
diff --git a/src/package.lisp b/src/package.lisp
index 82c5b09..ca9e357 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -217,6 +217,7 @@
       ))
   (defparameter *parenscript-interface-exports*
     '(;; compiler
+      #:*js-target-version*
       #:compile-script
       #:ps
       #:ps-doc
diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index df4ebd3..e2bda58 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -287,20 +287,28 @@ the given lambda-list and body."
                     optionals))
            (key-forms
             (when keys?
-              (with-ps-gensyms (n)
-                (let ((decls nil) (assigns nil) (defaults nil))
-                  (mapc (lambda (k)
-                          (multiple-value-bind (var init-form keyword)
-                              (parse-key-spec k)
-                            (push (list 'var var) decls)
-                            (push `(,keyword (setf ,var (aref arguments (1+ ,n)))) assigns)
-                            (push (list 'defaultf var init-form) defaults)))
-                        (reverse keys))
-                  `(,@decls
-                    (loop :for ,n :from ,(length requireds)
-                      :below (length arguments) :by 2 :do
-                      (case (aref arguments ,n) ,@assigns))
-                    ,@defaults)))))
+              (if (< *js-target-version* 1.6)
+                  (with-ps-gensyms (n)
+                    (let ((decls nil) (assigns nil) (defaults nil))
+                      (mapc (lambda (k)
+                              (multiple-value-bind (var init-form keyword-str)
+                                  (parse-key-spec k)
+                                (push `(var ,var) decls)
+                                (push `(,keyword-str (setf ,var (aref arguments (1+ ,n)))) assigns)
+                                (push (list 'defaultf var init-form) defaults)))
+                            (reverse keys))
+                      `(,@decls
+                        (loop :for ,n :from ,(length requireds)
+                           :below (length arguments) :by 2 :do
+                           (case (aref arguments ,n) ,@assigns))
+                        ,@defaults)))
+                  (mapcar (lambda (k)
+                            (multiple-value-bind (var init-form keyword-str)
+                                (parse-key-spec k)
+                              (with-ps-gensyms (x)
+                                `(let ((,x ((@ *Array prototype index-of call) arguments ,keyword-str ,(length requireds))))
+                                   (var ,var (if (= -1 ,x) ,init-form (aref arguments (1+ ,x))))))))
+                          keys))))
            (rest-form
             (if rest?
                 (with-ps-gensyms (i)
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 4d9c60e..c883c91 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -789,3 +789,13 @@ try {
 
 (test ps-lisp-dynamic-environment
   (is (string= "1 + 2;" (let ((*print-level* 2)) (ps (+ 1 (lisp *print-level*)))))))
+
+(test-ps-js ps-js-target-version-keyword-test1
+  (defun foo (x y &key bar baz))
+  "function foo(x, y) {
+    var x1 = Array.prototype.indexOf.call(arguments, 'bar', 2);
+    var bar = -1 == x1 ? null : arguments[x1 + 1];
+    var x2 = Array.prototype.indexOf.call(arguments, 'baz', 2);
+    var baz = -1 == x2 ? null : arguments[x2 + 1];
+}"
+  :js-target-version 1.6)
diff --git a/t/test.lisp b/t/test.lisp
index 716b102..ac390f5 100644
--- a/t/test.lisp
+++ b/t/test.lisp
@@ -30,9 +30,10 @@
      (same-space-between-statements
       (normalize-whitespace str))))))
 
-(defmacro test-ps-js (testname parenscript javascript)
+(defmacro test-ps-js (testname parenscript javascript &key (js-target-version *js-target-version*))
   `(test ,testname ()
-         (is (string= (normalize-js-code (ps-doc* ',parenscript))
+         (is (string= (normalize-js-code (let ((*js-target-version* ,js-target-version))
+                                           (ps-doc* ',parenscript)))
                       (normalize-js-code ,javascript)))))
 
 (defun run-tests()
@@ -42,4 +43,3 @@
   (run! 'ps-tests)
   (format t "Running Package System tests:~&")
   (run! 'package-system-tests))
-
-- 
2.20.1