Common Lisp: metodo migliore per importare temporaneamente alcune funzioni da un pacchetto

Question

C'è un modo per importare temporaneamente alcune funzioni da un pacchetto nel pacchetto corrente, utilizzando le funzioni/macro standard common-lisp?

Non riuscivo a trovarne uno e ho dovuto rotolare da solo. Preferirei non dover codificare nulla o introdurre un altro costrutto linguistico, se lo standard fornisce già tale funzionalità.

(defmacro with-functions (functions the-package &body body) 
    "Allows functions in the-package to be visible only for body. 
    Does this by creating local lexical function bindings that redirect calls 
    to functions defined in the-package" 
    `(labels 
    ,(mapcar (lambda (x) `(,x (&rest args) 
           (apply (find-symbol ,(format nil "~:@(~a~)" x) 
                ,the-package) 
             args))) 
       functions) 
    ,@body)) 

Esempio utilizzo:

(defclass-default test-class() 
    ((a 5 "doc") 
    (b 4 "doc"))) 
#<STANDARD-CLASS TEST-CLASS> 
CL-USER> 
(with-functions (class-direct-slots slot-definition-name) 'sb-mop 
    (with-functions (slot-definition-initform) 'sb-mop 
    (slot-definition-initform 
     (car (class-direct-slots (find-class 'test-class)))))) 
5 
CL-USER> 

EDIT: Incorporated alcuni dei suggerimenti di Rainer alla macro.

Ho deciso di mantenere la capacità di ricerca in fase di esecuzione, al momento del costo della ricerca in fase di esecuzione per trovare la funzione nel pacchetto.

Ho provato a scrivere una macro con importazione che utilizzava shadowing-import e unintern, ma non riuscivo a farlo funzionare. Ho avuto problemi con il lettore che diceva che le funzioni importate non esistevano ancora (al momento della lettura) prima che il codice che importava le funzioni fosse valutato.

Penso che farlo funzionare con shadowing-import e unintern sia un modo migliore per andare, in quanto ciò sarebbe molto più pulito, veloce (senza alcuna capacità di ricerca in fase di esecuzione) e funzionerà con funzioni e simboli nei pacchetti.

Sarei molto interessato a vedere se qualcuno può codificare una macro con importazione utilizzando unintern e shadowing-import.

Answer 1

È possibile utilizzare import con un elenco di simboli qualificati (cioè package:symbol o package::symbol) che si desidera importare e poi li unintern.

Answer 2

Rende le chiamate di funzione di runtime molto più costose: si tratta di una lista di argomenti, cerca un simbolo in un pacchetto, chiama una funzione attraverso la cella della funzione del simbolo.

Funziona solo tramite simboli, non funzioni lessicali. Ciò lo rende meno utile nei casi in cui il codice viene generato tramite macro.

La sua denominazione è confusa. 'importare' è un'operazione di pacchetto e i pacchetti si occupano solo di simboli, non di funzioni. Non è possibile importare una funzione in un pacchetto, solo un simbolo.

(labels ((foo() 'bar)) 
    (foo)) 

Il nome della funzione lessicale FOO è solo nel codice sorgente di un simbolo. Non è possibile accedere alla funzione tramite il relativo simbolo sorgente in seguito (ad esempio utilizzando (symbol-function 'foo)). Se un compilatore compila sopra il codice, non ha bisogno di conservare il simbolo - non è necessario se non per scopi di debug. La chiamata a APPLY non troverà alcuna funzione creata da LABELS o FLET.

La macro non importa un simbolo, crea un binding di funzione lessicale locale.

Per i macro leggermente simili, vedere CL:WITH-SLOTS e CL:WITH-ACCESSORS. Quelli non supportano la ricerca runtime, ma consentono una compilazione efficiente.

La macro non nidificano in questo modo (in questo caso l'utilizzo di "CLOS" come un pacchetto, proprio come il vostro "SB-MOP"):

(defpackage "P1" (:use "CL")) 
(defpackage "P2" (:use "CL")) 

(with-import (p1::class-direct-slots) 'CLOS 
    (with-import (p2::class-direct-slots) 'P1 
    (p2::class-direct-slots (find-class 'test-class)))) 

Il codice generato è:

(LABELS ((P1::CLASS-DIRECT-SLOTS (&REST ARGS) 
      (APPLY (FIND-SYMBOL "CLASS-DIRECT-SLOTS" 'CLOS) ARGS))) 
    (LABELS ((P2::CLASS-DIRECT-SLOTS (&REST ARGS) 
      (APPLY (FIND-SYMBOL "CLASS-DIRECT-SLOTS" 'P1) ARGS))) 
    (P2::CLASS-DIRECT-SLOTS (FIND-CLASS 'TEST-CLASS))))