Como sombrear de forma programática e portátil um símbolo de uma macro?

Primeiro de tudo: nunca faça isso . Se eu tivesse projetado CL fazendo algo assim, resultaria na liberação no meio ambiente de uma quantidade de radioatividade grande o suficiente para garantir, sem sombra de dúvida, que répteis gigantes mutantes surgiriam de um oceano brilhante com radiação de Čerenkov e consumiriam toda a vida humana. Infelizmente, minhas sugestões nesse sentido foram rejeitadas pelo comitê de padrões.

Apenas... não faça isso. Se você deseja ter um pacote que redefina os nomes exportados pelo CL, defina o pacote desejado , não defina outro pacote e modifique-o gradativamente por formulários que obviamente nem sequer fazem alterações no sistema de pacotes.

Se você escrever um código que modifique o pacote (de maneiras não óbvias), você estará enfrentando sérios problemas.

Por um lado, você imediatamente terá problemas se usar defpackageou qualquer coisa que se expanda para defpackage, porque a especificação diz:

Se a nova definição estiver em desacordo com o estado atual desse pacote, as consequências serão indefinidas

[Minha ênfase.]

E mesmo se você achar que está tudo bem, pense em algo assim

(defun make-string (...)
  ...
  (make-array ...)
  ...)

...

(defun make-array (...)
  ...)

O que exatamente acontecerá quando esse código for processado pelo compilador? A primeira vez? Tempos subsequentes?

No final desta resposta há um adendo que descreve como você pode usar uma versão estendida defpackagepara resolver o problema de uma forma que não faça com que monstros radioativos subam das profundezas.

Mas aqui está a versão radioativa.

O que você deseja é que (defun <name> ...), if <name>seja um símbolo cujo pacote inicial não seja o pacote atual, em vez disso, organize para se referir a um novo símbolo com o mesmo nome, cujo pacote inicial seja o pacote atual e que esteja sombreando o símbolo original.

Bem, na verdade você quer algo mais complicado do que isso, porque <name>pode ser (<setf> <s>), e talvez <setf>não seja cl:setf, mas apenas um símbolo cujo nome é SETF.

Aqui está uma definição inicial do pacote ein-package

(defpackage :my-radioactive--package
  (:use :cl)
  (:shadow #:defun))

(in-package :my-radioactive-package)

Aqui está uma função que faz essa sombra para você:

(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)))))))

E aqui está uma versão defunque usa isso:

(defmacro defun (name arguments &body defining-forms)
  `(cl:defun ,(maybe-shadow-function-name name) ,arguments
     ,@defining-forms))

Agora

> (package-name (symbol-package 'car))
"COMMON-LISP"

> (defun car (x) (cl:car x))
car

> (package-name (symbol-package 'car))
"MY-RADIOACTIVE-PACKAGE"

Como evitar a criação de monstros.

Você pode fazer isso usando mecanismos CL comuns. Mas há vários calços defpackageque tornam isso mais fácil. Isso usa pacotes de conduíte porque estou familiarizado com eles. Acho que os ASDF define-packagetambém podem tornar isso muito fácil.

Aqui está um pacote que exporta uma macro de definição de conduíte:

(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)))

E agora

> (use-package :my-simple-conduits)
t

> (define-conduit-package :my-non-radioactive-cl-variant
    (:cl
     #:defun
     #:make-string))

E

> (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"

então o my-non-radioactive-cl-variantpacote agora é um pacote semelhante ao CL, exceto que alguns símbolos foram substituídos: você pode usá-lo em vez de CL (você não pode usá-lo com CL, pois ele exporta, por exemplo, um símbolo cujo nome é "DEFUN"which é não cl:defun).

E usando isso você tem um código que funciona e que pode ser lido facilmente.