主页 / coding / 问题 / 78784847
Accepted
myname
Asked: 2024-07-24 01:35:21 +0800 CST

如何以编程方式且可移植地从宏中隐藏符号？

  • 772

这个有点令人尴尬，但是我被这个问题困扰的时间比我想承认的要长。

我想生成一个宏，如果在某个现有包中找到符号，则该宏会自动隐藏该符号。我只使用 :common-lisp 包，并将从标准中隐藏几个函数。

我之前保存过一个阴影和导出符号列表，但我不想保留这些列表。相反，我更愿意从宏中隐藏符号，这样我就可以同时拥有阴影和导出声明以及定义。这看起来很简单，但是，无论我以何种方式实现它，我要么违反了包锁，要么我的符号未定义，要么其他原因。首先，这是一个包定义：

(in-package :cl-user)

(uiop:define-package :foo-package
  (:nicknames :foo)
  (:use :common-lisp)
  (:shadow #:defun))

(in-package :foo)

测试函数不执行任何操作，只是对测试的一个小包装：

(defun make-string (length init)
  (cl:make-string length :initial-element init))

我的第一次尝试是这样的：

(cl:defmacro defun (name arglist &optional docstring &rest body)
  `(progn
     (when (symbol-package ',name)
       (shadow ',name))
     (cl:defun ,name ,arglist ,docstring ,@body)
     (export '(,name))))

但是，这会导致 SBCL 的包锁冲突，因此在我尝试使用 cl:defun 重新定义该函数之前，影子函数显然没有生效。

将其包装进去 (eval-when (:compile-toplevel :load-toplevel :execute)，以使其在编译时可用并没有帮助。

另一种尝试是使用发电机：

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

这给了我 common-lisp:make-string unbound：

调试器在线程 #<THREAD "main thread" RUNNING {10044982F3}> 中的 UNBOUND-VARIABLE @10039FFD22 上调用：变量 MAKE-STRING 未绑定。

我曾尝试生成一个 lambda 并用 funcall 调用它，但也没有成功。

如果我从 repl: 手动隐藏 make-string (shadow 'make-string)，那么我之后可以重新定义并导出 make-string 而不会出现问题。

看来我误解了一些更基本的东西。

顺便说一句，我正在阅读 M. Cracauers 的编译时编程文章，并认为将所有内容放在同一位置是一个好主意，但我认为我对宏和编译时与运行时评估的熟悉程度还不够。

我知道我可以使用 SBCL 特定的东西来临时删除包锁，但我最初用来检查符号是否在：common-lisp 包中的“shadow”和“symbol-package”或“find-package”和“find-symbol”应该更具可移植性。

common-lisp

1 个回答

  1. Best Answer

    首先：千万不要这样做。如果我设计了 CL，做任何类似的事情都会导致向环境中释放大量的放射性物质，这足以确保巨大的变异爬行动物从充满切伦科夫辐射的海洋中升起并吞噬所有人类生命。遗憾的是，我在这方面的建议被标准委员会拒绝了。

    只是...不要这样做。如果您想要一个重新定义 CL 导出的名称的包，那么请定义您想要的包，不要定义其他包，然后通过显然不会对包系统进行更改的形式逐步修改它。

    如果您编写的代码在运行过程中修改了包（以不明显的方式），那么您会遇到严重的麻烦。

    一方面，如果你使用defpackage或任何扩展为 的东西，你会立即遇到麻烦defpackage，因为规范说：

    如果新定义与该包的当前状态不一致，则后果是不确定的

    [我强调。]

    即使你认为这没什么，想想这样的事情

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

...

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

    当编译器处理该代码时，究竟会发生什么？第一次？后续几次？

    在这个答案的最后有一个附录，描述了如何使用扩展的一个版本defpackage来解决问题，而不会导致放射性怪物从深处升起。

    但，这是放射性版本。

    您想要的是(defun <name> ...)，如果<name>是一个符号，其主包不是当前包，则应该安排引用一个具有相同名称的新符号，其主包是当前包，并且正在遮蔽原始符号。

    嗯，事实上你想要一些比这更复杂的东西，因为<name>可能是(<setf> <s>)，而也许<setf>不是，cl:setf而仅仅是一个名为的符号SETF。

    这是初始包定义 &in-package

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

(in-package :my-radioactive-package)

    这是一个可以为您完成这种可能阴影处理的函数：

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

    defun下面是使用它的版本：

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

    现在

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

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

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

    如何避免制造怪物。

    您可以使用普通的 CL 机制来实现这一点。但是有许多垫片defpackage可以使这更容易。这使用导管包，因为我对它们很熟悉。我认为 ASDFdefine-package也可以使这变得相当容易。

    这是一个导出管道定义宏的包：

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

    现在

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

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

    和

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

    因此，该my-non-radioactive-cl-variant包现在是一个与 CL 类似的包，只是一些符号已被替换：您可以使用它代替 CL（您不能将它与CL 一起使用，因为它会导出名称为 的符号，而"DEFUN"它不是cl:defun）。

    利用这个，您就能获得既能工作又能轻松读取的代码。

    • 1

相关问题