Plaster

;; Patch sbcl's %find-symbol (in-package #:sb-impl) (defun %find-symbol (string length package) (declare (simple-string string) (type index length)) (let ((hash (compute-symbol-hash string length))) (declare (hash-code hash)) (with-symbol ((symbol) (package-internal-symbols package) string length hash) (when (get symbol :symbol-has-a-link-to) (return-from %find-symbol (values (get symbol :symbol-has-a-link-to) :internal :link))) (return-from %find-symbol (values symbol :internal))) (with-symbol ((symbol) (package-external-symbols package) string length hash) (when (get symbol :symbol-has-a-link-to) (return-from %find-symbol (values (get symbol :symbol-has-a-link-to) :external :link))) (return-from %find-symbol (values symbol :external))) (let* ((tables (package-tables package)) (n (length tables))) (unless (eql n 0) ;; Try the most-recently-used table, then others. ;; TABLES is treated as circular for this purpose. (let* ((mru (package-mru-table-index package)) (start (if (< mru n) mru 0)) (i start)) (loop (with-symbol ((symbol) (locally (declare (optimize (safety 0))) (svref tables i)) string length hash) (setf (package-mru-table-index package) i) (when (get symbol :symbol-has-a-link-to) (return-from %find-symbol (values (get symbol :symbol-has-a-link-to) :inherited :link))) (return-from %find-symbol (values symbol :inherited))) (if (< (decf i) 0) (setq i (1- n))) (if (= i start) (return))))))) (values nil nil)) (in-package #:cl-user) (defmacro link (from to) (if (and (symbolp from) (symbolp to)) `(setf (get ',from :symbol-has-a-link-to) ',to) `(error "FROM and TO must be symbols")))