From 8cc921d0022b7104db7a354807a3ffee53dc8448 Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vas@oneofus.la>
Date: Sun, 21 Oct 2018 01:02:34 -0700
Subject: [PATCH] Made CASE treat symbol literals as strings, behave more like
 CL

---
 docs/reference.html   | 27 ++++++++++++--------------
 src/macros.lisp       | 52 ++++++++++++++++++++++++---------------------------
 tests/eval-tests.lisp | 16 ++++++++++++++++
 3 files changed, 52 insertions(+), 43 deletions(-)

diff --git a/docs/reference.html b/docs/reference.html
index 51e548d..51a4eed 100644
--- a/docs/reference.html
+++ b/docs/reference.html
@@ -1134,20 +1134,17 @@ blafoo(i);</samp></pre>
       </dd>
     </dl>
 
-    <p><code>CASE</code> works similar to its Common Lisp equivalent,
-    but keys are limited to keywords, numbers, and strings, and the
-    symbols <code>T</code> and <code>OTHERWISE</code>. Any other symbols used
-    as keys are assumed to be symbol-macros that macro-expand to
-    numbers or strings (this behavior differs from Common Lisp, which
-    does not macro-expand keys). If the symbol does not macro-expand to
-    a number or string, an error is signaled.
-
-    An additional form, <code>SWITCH</code>, takes the same syntax
-    as <code>CASE</code>, but the individual branches must be
-    terminated with the
-    symbol <a href="#break"><code>BREAK</code></a>. This allows
-    C-style case "fall-throughs" in <code>switch</code>
-    statements:</p>
+    <p>
+      <code>CASE</code> works similar to its Common Lisp equivalent.
+    </p>
+
+    <p>
+      An additional form, <code>SWITCH</code>, takes the same syntax
+      as <code>CASE</code>, but the individual branches must be
+      terminated with the
+      symbol <a href="#break"><code>BREAK</code></a>. This allows
+      C-style case "fall-throughs" in <code>switch</code> statements:
+    </p>
 
     <dl>
       <dt>
@@ -1570,6 +1567,6 @@ someDiv.offsetLeft;</samp></pre>
     function argument lists to the Emacs minibuffer, like SLIME
     already does for Common Lisp functions and macros.</p>
 
-    <p style="font-size:xx-small;float:right;">Last updated: 2018-07-08</p>
+    <p style="font-size:xx-small;float:right;">Last updated: 2018-10-20</p>
   </body>
 </html>
diff --git a/src/macros.lisp b/src/macros.lisp
index b716fca..46680d6 100644
--- a/src/macros.lisp
+++ b/src/macros.lisp
@@ -226,34 +226,30 @@
 ;;; conditionals
 
 (defpsmacro case (value &rest clauses)
-  (let ((allowed-symbols '(t otherwise false %true)))
-    (labels ((make-switch-clause (val body more)
-               (cond ((listp val)
-                      (append (mapcar #'list (butlast val))
-                              (make-switch-clause
-                               (if (eq t (car (last val))) ;; literal 'true'
-                                   '%true
-                                   (car (last val)))
-                               body
-                               more)))
-                     ((and (symbolp val)
-                           (symbolp (ps-macroexpand-1 val))
-                           (not (keywordp val))
-                           (not (member val allowed-symbols)))
-                      (error "Parenscript only supports keywords, numbers, and string literals as keys in case clauses. ~S is a symbol in clauses ~S"
-                             val clauses))
-                     (t
-                      `((,(case val
-                                ((t otherwise) 'default)
-                                (%true          t)
-                                (t              (ps-macroexpand-1 val)))
-                          ,@body
-                          ,@(when more '(break))))))))
-      `(switch ,value ,@(mapcon (lambda (clause)
-                                  (make-switch-clause (car (first clause))
-                                                      (cdr (first clause))
-                                                      (rest clause)))
-                                clauses)))))
+  (labels
+      ((make-switch-clause (val body more)
+         (if (consp val)
+             (append (mapcar #'list (butlast val))
+                     (make-switch-clause
+                      (if (eq t (car (last val))) ;; literal 'true'
+                          '%true
+                          (car (last val)))
+                      body
+                      more))
+             `((,(cond ((member val '(t otherwise)) 'default)
+                       ((eql val '%true)            t)
+                       ((eql val 'false)            'false)
+                       ((null val)                  'false)
+                       ((symbolp val)               (list 'quote val))
+                       (t                           val))
+                 ,@body
+                 ,@(when more '(break)))))))
+    `(switch ,value
+       ,@(mapcon (lambda (clause)
+                   (make-switch-clause (car (first clause))
+                                       (cdr (first clause))
+                                       (rest clause)))
+                 clauses))))
 
 (defpsmacro when (test &rest body)
   `(if ,test (progn ,@body)))
diff --git a/tests/eval-tests.lisp b/tests/eval-tests.lisp
index e527417..201ca9e 100644
--- a/tests/eval-tests.lisp
+++ b/tests/eval-tests.lisp
@@ -558,6 +558,14 @@
          (otherwise 7)))
   6)
 
+(test-js-eval case-clauses-false-nil
+  (* 2 (case (= 1 2)
+         (1 1)
+         ((nil) 3)
+         (2 5)
+         (otherwise 7)))
+  6)
+
 (test-js-eval case-clauses-true
   (* 2 (case (= 2 2)
          (1 1)
@@ -678,6 +686,14 @@
         (0 3)
         (x 7)
         (t 13))))
+  13)
+
+(test-js-eval case-symbol
+  (let ((blah 'x))
+    (case blah
+      (0 3)
+      (x 7)
+      (t 13)))
   7)
 
 (test-js-eval symbol-macro-funcall
-- 
2.11.4.GIT