From 5c9b1e7354806f5ced64b6f8c5cedc8b3cd62c8f Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vas@oneofus.la>
Date: Mon, 22 Oct 2018 02:01:09 -0700
Subject: [PATCH] Fixed MAYBE-ONCE-ONLY to handle symbol macros

---
 docs/reference.html     |  1 +
 src/compiler.lisp       | 33 +++++++++++++++++++++------------
 tests/output-tests.lisp | 19 +++++++++++++++++++
 3 files changed, 41 insertions(+), 12 deletions(-)

diff --git a/docs/reference.html b/docs/reference.html
index 51a4eed..c6a8f46 100644
--- a/docs/reference.html
+++ b/docs/reference.html
@@ -1417,6 +1417,7 @@ someDiv.offsetLeft;</samp></pre>
       <li>(<code id="ps-gensym">PS-GENSYM</code> {<var>string</var>})</li>
       <li>(<code id="with-ps-gensyms">WITH-PS-GENSYMS</code> <var>symbols</var> &amp;body <var>body</var>)</li>
       <li>(<code id="ps-once-only">PS-ONCE-ONLY</code> (&amp;rest <var>vars</var>) &amp;body <var>body</var>)</li>
+      <li>(<code id="ps-once-only">MAYBE-ONCE-ONLY</code> (&amp;rest <var>vars</var>) &amp;body <var>body</var>)</li>
 
       <li><var id="*ps-gensym-counter*">*PS-GENSYM-COUNTER*</var></li>
     </ul>
diff --git a/src/compiler.lisp b/src/compiler.lisp
index 44a2040..8ea121f 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -352,7 +352,8 @@ form, FORM, returns the new value for *compilation-level*."
                  (incf *ps-gensym-counter*))))))
 
 (defmacro with-ps-gensyms (symbols &body body)
-  "Each element of SYMBOLS is either a symbol or a list of (symbol
+  "Helper macro for writing Parenscript macros. Each element of
+SYMBOLS is either a symbol or a list of (symbol
 gensym-prefix-string)."
   `(let* ,(mapcar (lambda (symbol)
                     (destructuring-bind (symbol &optional prefix)
@@ -366,22 +367,30 @@ gensym-prefix-string)."
      ,@body))
 
 (defmacro ps-once-only ((&rest vars) &body body)
+  "Helper macro for writing Parenscript macros. Useful for preventing unwanted multiple evaluation."
   (let ((gensyms (mapcar (lambda (x) (ps-gensym (string x))) vars)))
     `(let ,(mapcar (lambda (g v) `(,g (ps-gensym ,(string v)))) gensyms vars)
        `(let* (,,@(mapcar (lambda (g v) ``(,,g ,,v)) gensyms vars))
           ,(let ,(mapcar (lambda (g v) `(,v ,g)) gensyms vars)
              ,@body)))))
 
-(defmacro maybe-once-only (vars &body body)
-  "Introduces a binding for a form if the form is not a variable or
-  constant. If it is, uses that form in the body directly."
+(defmacro maybe-once-only ((&rest vars) &body body)
+  "Helper macro for writing Parenscript macros. Like PS-ONCE-ONLY,
+except that if the given VARS are variables or constants, no intermediate variables are created."
   (let ((vars-bound (gensym)))
-    `(let* ((,vars-bound ())
-            ,@(loop for var in vars collect
-                   `(,var (if (or (constantp ,var) (symbolp ,var))
-                              ,var
-                              (let ((gensym (ps-gensym ,(symbol-name var))))
-                                (push `(,gensym ,,var) ,vars-bound)
-                                gensym)))))
+    `(let*
+         ((,vars-bound ())
+          ,@(loop for var in vars collect
+                 `(,var
+                   (if (or
+                        (constantp ,var)
+                        (and
+                         (symbolp ,var)
+                         (not (lookup-macro-def ,var *symbol-macro-env*))
+                         (not (gethash ,var *symbol-macro-toplevel*))))
+                        ,var
+                        (let ((var¹ (ps-gensym ',var)))
+                          (push (list var¹ ,var) ,vars-bound)
+                          var¹)))))
        `(let ,,vars-bound
-         ,,@body))))
+          ,,@body))))
diff --git a/tests/output-tests.lisp b/tests/output-tests.lisp
index b5a6b3a..2408c7b 100644
--- a/tests/output-tests.lisp
+++ b/tests/output-tests.lisp
@@ -4178,3 +4178,22 @@ x = 2 + sideEffect() + x + 5;")
       (write-string "[1,2,3]" ps::*psw-stream*)
       (values))))
   "alert([1,2,3]);")
+
+(test-ps-js maybe-once-only-symbol-macrolet
+  (symbol-macrolet ((x (call-me-once)))
+    (sinh x))
+
+  "(function () {
+    var x1 = callMeOnce();
+    return (Math.exp(x1) - Math.exp(-x1)) / 2;
+})();")
+
+(test-ps-js maybe-once-only-symbol-macro
+  (progn
+    (define-symbol-macro maybe-once-only-symbol-macro (call-me-once))
+    (tanh maybe-once-only-symbol-macro))
+
+  "(function () {
+    var x1 = callMeOnce();
+    return (Math.exp(x1) - Math.exp(-x1)) / (Math.exp(x1) + Math.exp(-x1));
+})();")
-- 
2.11.4.GIT