diff --git a/cl-form-types.asd b/cl-form-types.asd index 2f14ca4..b232686 100644 --- a/cl-form-types.asd +++ b/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 diff --git a/src/blacklist.lisp b/src/blacklist.lisp new file mode 100644 index 0000000..7a35741 --- /dev/null +++ b/src/blacklist.lisp @@ -0,0 +1,32 @@ +;;;; form-types.lisp +;;;; +;;;; Copyright 2021 Alexander Gutev +;;;; +;;;; 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*) diff --git a/src/form-types.lisp b/src/form-types.lisp index 21ac2a9..4bba09a 100644 --- a/src/form-types.lisp +++ b/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))) diff --git a/src/package.lisp b/src/package.lisp index f81e6e3..3a6e381 100644 --- a/src/package.lisp +++ b/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)