From 44f33cb25148a7ce5ede5429f9625445ccbdfe2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Thu, 16 Nov 2023 11:55:17 +0100
Subject: [PATCH] cmp: cleanup of predicates loc-with-*-p

We first explicitly test for an ATOM and after that we use CASE.
---
 src/cmp/cmplocs.lsp | 48 +++++++++++++++++++++------------------------
 1 file changed, 22 insertions(+), 26 deletions(-)

diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index bb247b857..e69736b2c 100644
--- a/src/cmp/cmplocs.lsp
+++ b/src/cmp/cmplocs.lsp
@@ -85,34 +85,30 @@
            (otherwise :object)))))
 
 (defun loc-with-side-effects-p (loc &aux name)
-  (cond ((var-p loc)
-         (and (global-var-p loc)
-              (policy-global-var-checking)))
-        ((atom loc)
-         nil)
-        ((member (setf name (first loc)) '(CALL CALL-NORMAL CALL-INDIRECT CALL-STACK)
-                 :test #'eq)
-         t)
-        ((eq name 'cl:THE)
-         (loc-with-side-effects-p (third loc)))
-        ((eq name 'cl:FDEFINITION)
-         (policy-global-function-checking))
-        ((eq name 'ffi:C-INLINE)
-         (or (eq (sixth loc) 'cl:VALUES) ;; Uses VALUES
-             (fifth loc)))))             ;; or side effects
+  (when (atom loc)
+    (return-from loc-with-side-effects-p
+      (and (var-p loc)
+           (global-var-p loc)
+           (policy-global-var-checking))))
+  (case (first loc)
+    ((CALL CALL-NORMAL CALL-INDIRECT CALL-STACK) T)
+    (CL:THE (loc-with-side-effects-p (third loc)))
+    (CL:FDEFINITION (policy-global-function-checking))
+    ;; Uses VALUES or has side effects.
+    (FFI:C-INLINE (or (eq (sixth loc) 'CL:VALUES) (fifth loc)))
+    (otherwise NIL)))
 
 (defun loc-refers-to-special-p (loc)
-  (cond ((var-p loc)
-         (member (var-kind loc) '(SPECIAL GLOBAL)))
-        ((atom loc)
-         nil)
-        ((eq (first loc) 'THE)
-         (loc-refers-to-special-p (third loc)))
-        ((eq (setf loc (first loc)) 'BIND)
-         t)
-        ((eq loc 'ffi:C-INLINE)
-         t)                             ; We do not know, so guess yes
-        (t nil)))
+  (when (atom loc)
+    (return-from loc-refers-to-special-p
+      (and (var-p loc)
+           (member (var-kind loc) '(SPECIAL GLOBAL)))))
+  (case (first loc)
+    (CL:THE (loc-refers-to-special-p (third loc)))
+    (BIND T)
+     ;; We do not know, so guess yes.
+    (FFI:C-INLINE T)
+    (otherwise NIL)))
 
 ;;; Valid locations are:
 ;;;     NIL