Merge pull request #19 from digikar99/expand-compiler-macros-blacklist

Add *expand-compiler-macros-blacklist*

cl-form-types.asd

@@ -37,7 +37,8 @@
                  (:file "form-types")
 		 (:file "walker")
 		 (:file "block-types")
-		 (:file "cl-functions"))))
+         (:file "cl-functions")
+         (:file "blacklist"))))
 
   :depends-on (#:cl-environments
 	       #:agutil

src/blacklist.lisp

@@ -0,0 +1,32 @@
+;;;; form-types.lisp
+;;;;
+;;;; Copyright 2021 Alexander Gutev <alex.gutev@mail.bg>
+;;;;
+;;;; Permission is hereby granted, free of charge, to any person
+;;;; obtaining a copy of this software and associated documentation
+;;;; files (the "Software"), to deal in the Software without
+;;;; restriction, including without limitation the rights to use,
+;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell
+;;;; copies of the Software, and to permit persons to whom the
+;;;; Software is furnished to do so, subject to the following
+;;;; conditions:
+;;;;
+;;;; The above copyright notice and this permission notice shall be
+;;;; included in all copies or substantial portions of the Software.
+;;;;
+;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+;;;; OTHER DEALINGS IN THE SOFTWARE.
+
+;;;; Functions for obtaining the types of forms based on the type
+;;;; information stored in the environment.
+
+(in-package :cl-form-types)
+
+#+ccl
+(push 'cl:aref *expand-compiler-macros-blacklist*)

src/form-types.lisp

@@ -106,6 +106,12 @@
   "Flag for whether compiler-macros should be expanded prior to
    determining form types.")
 
+(defvar *expand-compiler-macros-blacklist* nil
+  "A list of symbols whose compiler macros should not be used for
+   expansion. This may be useful because some implementations
+   provide compiler macros which expand into their parent forms,
+   resulting in infinite expansions.")
+
 (defvar *handle-sb-lvars* nil
   "Flag for whether SBCL `SB-C::LVAR' structures should be recognized.
 
@@ -560,10 +566,17 @@
    Returns the compiler-macro-expanded form or NIL if there is no
    compiler-macro for OPERATOR."
 
-  (when-let* ((fn (and *expand-compiler-macros*
-		       (compiler-macro-function operator env)))
+  (when-let* ((fn (if (and *expand-compiler-macros*
+                           (compiler-macro-function operator env)
+
+                           (not (member operator
+                                        *expand-compiler-macros-blacklist*
+                                        ;; OPERATORs can be lists
+                                        :test #'equal)))
+                      (compiler-macro-function operator env)
+                      nil))
 
-	      (form (funcall fn (cons operator arguments) env)))
+              (form (funcall fn (cons operator arguments) env)))
 
     (unless (equal form (cons operator arguments))
       form)))

src/package.lisp

@@ -40,7 +40,8 @@
 
 	   :malformed-form-error
 	   :unknown-special-operator
-	   :return-default-type)
+       :return-default-type
+       :*expand-compiler-macros-blacklist*)
 
   (:intern :walk-form)