This one is a little bit embarrassing, but I have been stuck with this one way longer than I want to admit.
I would like to generate a macro that automatically shadow a symbol if it is found in some existing package. I am only using :common-lisp package, and will shadow several functions from the standard.
I have previously kept a list of shadowed and exported symbols, but I would like not to keep those lists. Instead, I would prefer to shadow the symbol from a macro, so I can have both shadow and export declaration together with the definition. It seems very simple, however, whichever way I implemented it, I am either violating package locks, or my symbol is undefined, or something else. To start with, here is a package def:
(in-package :cl-user)
(uiop:define-package :foo-package
(:nicknames :foo)
(:use :common-lisp)
(:shadow #:defun))
(in-package :foo)
The test function does nothing, just a small wrapper for the test:
(defun make-string (length init)
(cl:make-string length :initial-element init))
My first attempt looked like this:
(cl:defmacro defun (name arglist &optional docstring &rest body)
`(progn
(when (symbol-package ',name)
(shadow ',name))
(cl:defun ,name ,arglist ,docstring ,@body)
(export '(,name))))
However, that results in a package lock violation with SBCL, so shadow function obviously is not taking effect before I try to re-define the function with cl:defun.
Wrapping it in
(eval-when (:compile-toplevel :load-toplevel :execute), to make it available at compile time didn't help.
Another attempt was using a generator:
(eval-when (:compile-toplevel :load-toplevel :execute)
(cl:defmacro defun (name args &optional docstring &rest body)
(macrolet ((export-it (name args &optional docstring &rest body)
`(progn
(when (symbol-package ',name)
(shadow ',name))
(cl:defun ,name ,args ,docstring ,@body)
(export '(,name) *package*))))
`(export-it ,name ,args ,docstring ,@body))))
This gives me common-lisp:make-string unbound:
debugger invoked on a UNBOUND-VARIABLE @10039FFD22 in thread #<THREAD "main thread" RUNNING {10044982F3}>: The variable MAKE-STRING is unbound.
I have tried to generate a lambda and funcall it, but without much success either.
If I shadow make-string manually from repl: (shadow 'make-string), I can afterwards redefine and export make-string without problems.
Seems I misunderstand something more fundamental there.
By the way, I was reading M. Cracauers Compile Time Programming article, and thought it was a nice idea to keep everything at the same place, but I think my familiarity with macros and compile-time vs runtime evaluation is not where it should be.
I understand I can use SBCL specific things to temporary remove package locks, but 'shadow' and 'symbol-package' or 'find-package' and 'find-symbol' which I initially used to check if a symbol is interned in :common-lisp package, should be more portable.
First of all: don't ever do this. If I had designed CL doing anything like this would result in the release into the environment of an amount of radioactivity large enough to ensure beyond doubt that giant mutant reptiles would rise from an ocean bright with Čerenkov radiation and consume all human life. Sadly my suggestions along these lines were rejected by the standards committee.
Just ... don't do this. If you want to have a package which redefines names exported by CL then define the package you want, don't define some other package and then incrementally modify it by forms which are not obviously even making changes to the package system.
If you write code which modifies the package (in non-obvious ways) as it goes then you are asking for serious trouble.
For one thing you immediately run into trouble if you use defpackage or anything which expands into defpackage, because the spec says:
If the new definition is at variance with the current state of that package, the consequences are undefined
[My emphasis.]
And even if you think that's OK, think of something like this
(defun make-string (...)
...
(make-array ...)
...)
...
(defun make-array (...)
...)
What exactly is going to happen when that code is processed by the compiler? The first time? Subsequent times?
At the end of this answer there's an addentum describing how you can use one version of an extended defpackage to solve the problem in a way which will not cause radioactive monsters to rise from the deep.
But, here is the radioactive version.
What you want is that (defun <name> ...) should, if <name> is a symbol whose home package is not the current package, instead arrange to refer to a new symbol with the same name, whose home package is the current package, and which is shadowing the original symbol.
Well, in fact you want something more complicated than this, because <name> might be (<setf> <s>), and perhaps <setf> is not cl:setf but merely a symbol whose name is SETF.
Here is an initial package definition & in-package
(defpackage :my-radioactive--package
(:use :cl)
(:shadow #:defun))
(in-package :my-radioactive-package)
Here is a function which does this maybe-shadowing for you:
(cl:defun maybe-shadow-function-name (name &optional (package *package*))
(flet ((maybe-shadow (s)
(if (eq (symbol-package s) package)
s
(let ((n (symbol-name s)))
(shadow n package)
(values (find-symbol n package))))))
(etypecase name
(symbol
(maybe-shadow name))
(cons
(destructuring-bind (setf it) name
(unless (and (symbolp setf) (eql (symbol-name setf) "SETF")
(symbolp it))
;; SETF might be shadowed
(error "hopeless"))
`(,setf ,(maybe-shadow it)))))))
And here is a version of defun which uses this:
(defmacro defun (name arguments &body defining-forms)
`(cl:defun ,(maybe-shadow-function-name name) ,arguments
,@defining-forms))
Now
> (package-name (symbol-package 'car))
"COMMON-LISP"
> (defun car (x) (cl:car x))
car
> (package-name (symbol-package 'car))
"MY-RADIOACTIVE-PACKAGE"
How to avoid creating monsters.
You can do this using ordinary CL mechanisms. But there are a number of shims around defpackage which make this easier. This uses conduit packages because I am familiar with them. I think ASDF's define-package may also make this pretty easy.
Here is a package which exports a conduit-defining macro:
(defpackage :my-simple-conduits
(:use cl)
(:use :org.tfeb.conduit-packages/define-package)
(:export #:define-conduit-package))
(in-package :my-simple-conduits)
(defmacro define-conduit-package (name &body conduit-descriptions)
"NAME is defined as a conduot for the CONDUIT_DESCRIPTIONS
Each conduit-description is a form like (p &rest
symbol-names-to-replace): NAME extends p but replaces the
symbols-to-replace from it."
`(define-package ,name
(:use)
,@(mapcan (lambda (d)
(destructuring-bind (p &rest symbol-names) d
(list
`(:extends/excluding ,p ,@symbol-names)
`(:export ,@symbol-names))))
conduit-descriptions)))
And now
> (use-package :my-simple-conduits)
t
> (define-conduit-package :my-non-radioactive-cl-variant
(:cl
#:defun
#:make-string))
And
> (package-name (symbol-package 'my-non-radioactive-cl-variant:car))
"COMMON-LISP"
> (package-name (symbol-package 'my-non-radioactive-cl-variant:defun))
"MY-NON-RADIOACTIVE-CL-VARIANT"
so the my-non-radioactive-cl-variant package is now a package which is like CL except that some symbols have been replaced: you can use it instead of CL (you can't use it with CL, since it exports, for instance, a symbol whose name is "DEFUN" which is not cl:defun).
And using this you have code which both works, and which can be read easily.