Prev: Emacs Form Feed (^L) Display Suggestion and Tips
Next: graph breadth first search
From: Tamas K Papp on 24 Jun 2010 08:41
Sometimes I need a lot of symbols from another package which are not
exported. Eg if I have unit tests in a separate package, but I want
to test internal functions in a library, I am forced to either import
the symbols, or write

(addtest (optimization-tests)
minmax-tests
(ensure-same (cl-random::minmax 1 2 3) 2)
(ensure-same (cl-random::minmax 2.2 2 3) 2.2)
(ensure-same (cl-random::minmax 4 2 3) 3))

I thought that it would be great if I could import symbols "locally",
but AFAIK CL offers no such facility. But it turns out that it is not
needed in this case. I came up with the following macro to get what I want:

(defmacro use-locally (package-symbols-list &body body)
`(progn
,@(sublis (iter
(for (package . symbols) :in package-symbols-list)
(dolist (symbol symbols)
(collecting (cons symbol
(find-symbol (symbol-name symbol) package)))))
body :test #'eq)))

so now I can write

(addtest (optimization-tests)
minmax-tests
(use-locally ((cl-random minmax))
(ensure-same (minmax 1 2 3) 2)
(ensure-same (minmax 2.2 2 3) 2.2)
(ensure-same (minmax 4 2 3) 3)))

Is there a better way?

Thanks,

Tamas
From: Helmut Eller on 24 Jun 2010 08:50
* Tamas K Papp [2010-06-24 12:41] writes:

> (addtest (optimization-tests)
> minmax-tests
> (use-locally ((cl-random minmax))
> (ensure-same (minmax 1 2 3) 2)
> (ensure-same (minmax 2.2 2 3) 2.2)
> (ensure-same (minmax 4 2 3) 3)))
>
> Is there a better way?

(addtest (optimization-tests)
minmax-tests
(macrolet ((minmax (&rest stuff) `(cl-random:minmax . ,stuff)))
(ensure-same (minmax 1 2 3) 2)
(ensure-same (minmax 2.2 2 3) 2.2)
(ensure-same (minmax 4 2 3) 3)))

Helmut
From: Captain Obvious on 24 Jun 2010 10:06
TKP> I thought that it would be great if I could import symbols "locally",
TKP> but AFAIK CL offers no such facility. But it turns out that it is not
TKP> needed in this case. I came up with the following macro to get what I
TKP> want:

TKP> (defmacro use-locally (package-symbols-list &body body)
TKP> `(progn
TKP> ,@(sublis (iter
TKP> (for (package . symbols) :in package-symbols-list)
TKP> (dolist (symbol symbols)
TKP> (collecting (cons symbol
TKP> (find-symbol (symbol-name symbol) package)))))
TKP> body :test #'eq)))

I think it is more like a shadowing-import, because it completely discards
already accessible symbols.

TKP> (addtest (optimization-tests)
TKP> minmax-tests
TKP> (use-locally ((cl-random minmax))
TKP> (ensure-same (minmax 1 2 3) 2)
TKP> (ensure-same (minmax 2.2 2 3) 2.2)
TKP> (ensure-same (minmax 4 2 3) 3)))

TKP> Is there a better way?

It depends on what is better for you.
I think your macro might be optimal as long as we don't care about shadowing
and we want to mention symbols explicitly one by one.

If you do not like explicit mentioning part, I think it is possible to
devise some devious macro that will "import" (via sublis) everything
automatically according to some rules.
Kind of do-what-I-mean style.
Or that can be a reader macro.

From: Pascal J. Bourguignon on 24 Jun 2010 10:23
Tamas K Papp <tkpapp(a)gmail.com> writes:

> Sometimes I need a lot of symbols from another package which are not
> exported. Eg if I have unit tests in a separate package, but I want
> to test internal functions in a library, I am forced to either import
> the symbols, or write
>
> (addtest (optimization-tests)
> minmax-tests
> (ensure-same (cl-random::minmax 1 2 3) 2)
> (ensure-same (cl-random::minmax 2.2 2 3) 2.2)
> (ensure-same (cl-random::minmax 4 2 3) 3))
>
> I thought that it would be great if I could import symbols "locally",
> but AFAIK CL offers no such facility.

However, it is easy enough to implement. With a reader macro.

{LOCALLY-IMPORTING-FROM ((P1 (S11 S12 ...))
(P2 (S21 S22 ...))
...)
BODY...}

The reader macro would then read the BODY by reading S11 as
P1::S11, etc.

Notice that you will want to read the symbols character by character to
be able to distinguish P0::S11 or :S11 from S11 that should be read as P1::S11
(assuming *PACKAGE* bound to P0).


> But it turns out that it is not
> needed in this case.

--
__Pascal Bourguignon__
http://www.informatimago.com
From: Pascal J. Bourguignon on 25 Jun 2010 05:44
pjb(a)informatimago.com (Pascal J. Bourguignon) writes:

> Tamas K Papp <tkpapp(a)gmail.com> writes:
>
>> Sometimes I need a lot of symbols from another package which are not
>> exported. Eg if I have unit tests in a separate package, but I want
>> to test internal functions in a library, I am forced to either import
>> the symbols, or write
>>
>> (addtest (optimization-tests)
>> minmax-tests
>> (ensure-same (cl-random::minmax 1 2 3) 2)
>> (ensure-same (cl-random::minmax 2.2 2 3) 2.2)
>> (ensure-same (cl-random::minmax 4 2 3) 3))
>>
>> I thought that it would be great if I could import symbols "locally",
>> but AFAIK CL offers no such facility.
>
> However, it is easy enough to implement. With a reader macro.
>
> {LOCALLY-IMPORTING-FROM ((P1 (S11 S12 ...))
> (P2 (S21 S22 ...))
> ...)
> BODY...}
>
> The reader macro would then read the BODY by reading S11 as
> P1::S11, etc.
>
> Notice that you will want to read the symbols character by character to
> be able to distinguish P0::S11 or :S11 from S11 that should be read as P1::S11
> (assuming *PACKAGE* bound to P0).


Like this, for example.

To make it even easier, I would need to design an API for parsing
tokens that would allow to modify the parsing of each kind of token
more modularly. Here I shamelessly copy-and-paste-and-patched code
from my reader.


;;;------------------------------------------------------------------------

(cl:in-package :cl-user )
(asdf-load :com.informatimago.common-lisp)

(defpackage "BRACE-READER-MACRO"
(:NICKNAMES "BRM")
(:use "CL")
(:EXPORT "BRACE-READER-MACRO"
"LOCALLY-IMPORTING-FROM"))
(in-package "BRACE-READER-MACRO")

(defun brace-reader-macro (stream ch)
(declare (ignore ch))
(let ((brace-macro (read stream)))
(cond
((string= brace-macro 'locally-importing-from)
(locally-importing-from stream))
(t
(error "Unknonw brace macro: ~A" brace-macro)))))


(reader::defparser parse-symbol-token-as-string (token)
(let ((colon (position-if
(lambda (traits) (reader::traitp reader::+ct-package-marker+ traits))
(reader::token-traits token))))
(if colon
(let* ((double-colon (and (< (1+ colon) (reader::token-length token))
(reader::traitp reader::+ct-package-marker+
(reader::token-char-traits token (1+ colon)))))
(pname (subseq (reader::token-text token) 0 colon))
(sname (subseq (reader::token-text token)
(+ colon (if double-colon 2 1)))))
(when (position-if
(lambda (traits) (reader::traitp reader::+ct-package-marker+ traits))
(reader::token-traits token) :start (+ colon (if double-colon 2 1)))
(reader::reject t "Too many package markers in token ~S" (reader::token-text token)))
(if (find-package pname)
(multiple-value-bind (sym where) (find-symbol sname pname)
(declare (ignore sym))
(if where
(reader::accept 'string pname)
(reader::reject t "There is no symbol named ~S in ~
the package named ~S" sname pname)))
(reader::reject t "There is no package with name ~S" pname)))
;; no colon in token, let's just return the symbol name:
(reader::accept 'string (reader::token-text token)))))


(defun parse-token/symbol-as-string (token)
"
RETURN: okp ; the parsed lisp object if okp, or an error message if (not okp)
"
(let ((message nil))
(macrolet
((rom (&body body)
"Result Or Message"
(if (null body)
'nil
(let ((vals (gensym)))
`(let ((,vals (multiple-value-list ,(car body))))
(if (first ,vals)
(values-list ,vals)
(progn
(when (second ,vals)
(setf message (third ,vals)))
(rom ,@(cdr body)))))))))
(multiple-value-bind (ok type object)
(rom (READER::parse-decimal-integer-token token)
(READER::parse-integer-token token)
(READER::parse-ratio-token token)
(READER::parse-float-1-token token)
(READER::parse-float-2-token token)
(parse-symbol-token-as-string token))
(declare (ignorable type))
(values ok (if ok object message))))))



(defvar *imports* '())

(reader::defparser parse-symbol-token (token)
"symbol ::= symbol-name
symbol ::= package-marker symbol-name
symbol ::= package-marker package-marker symbol-name
symbol ::= package-name package-marker symbol-name
symbol ::= package-name package-marker package-marker symbol-name
symbol-name ::= {alphabetic}+
package-name ::= {alphabetic}+ "
(let ((colon (position-if
(lambda (traits) (reader::traitp reader::+ct-package-marker+ traits))
(reader::token-traits token))))
(if colon
;; With a colon, we leave it alone.
(let* ((double-colon (and (< (1+ colon) (reader::token-length token))
(reader::traitp reader::+ct-package-marker+
(reader::token-char-traits token (1+ colon)))))
(pname (subseq (reader::token-text token) 0 colon))
(sname (subseq (reader::token-text token)
(+ colon (if double-colon 2 1)))))
(when (position-if
(lambda (traits) (reader::traitp reader::+ct-package-marker+ traits))
(reader::token-traits token) :start (+ colon (if double-colon 2 1)))
(reader::reject t "Too many package markers in token ~S" (reader::token-text token)))
(when (zerop colon)
;; Keywords always exist, so let's intern them before finding them.
(setf pname "KEYWORD")
(intern sname pname))
;; The following form thanks to Andrew Philpot <philpot(a)ISI.EDU>
;; corrects a bug when reading with double-colon uninterned symbols:
(if (find-package pname)
(if double-colon
(reader::accept 'symbol (intern sname pname))
(multiple-value-bind (sym where) (find-symbol sname pname)
(if (eq where :external)
(reader::accept 'symbol sym)
(reader::reject t "There is no external symbol named ~S in ~
the package named ~S" sname pname))))
(reader::reject t "There is no package with name ~S" pname)))
;; no colon in token, let's see if it's an import.
(loop
:with sname = (reader::token-text token)
:for (package symbols) :in *imports*
:do (when (member sname symbols :test (function string=))
(reader::accept 'symbol (intern sname package)))
:finally (reader::accept 'symbol (intern sname *package*))))))


(defun parse-token/importing-symbols-from (token)
"
RETURN: okp ; the parsed lisp object if okp, or an error message if (not okp)
"
(let ((message nil))
(macrolet
((rom (&body body)
"Result Or Message"
(if (null body)
'nil
(let ((vals (gensym)))
`(let ((,vals (multiple-value-list ,(car body))))
(if (first ,vals)
(values-list ,vals)
(progn
(when (second ,vals)
(setf message (third ,vals)))
(rom ,@(cdr body)))))))))
(multiple-value-bind (ok type object)
(rom (READER::parse-decimal-integer-token token)
(READER::parse-integer-token token)
(READER::parse-ratio-token token)
(READER::parse-float-1-token token)
(READER::parse-float-2-token token)
(parse-symbol-token token))
(declare (ignorable type))
(values ok (if ok object message))))))




(defun locally-importing-from (stream)
(let ((READER:*readtable* (READER:copy-readtable nil)))
(setf (READER:readtable-parse-token READER:*readtable*)
(function parse-token/symbol-as-string)) ; to read the imports
(let ((*imports* (READER:READ stream)))
(setf (READER:readtable-parse-token READER:*readtable*)
(function parse-token/importing-symbols-from)) ; to read the body
`(progn ,@(READER:READ-DELIMITED-LIST #\} stream)))))




(in-package :cl-user)
(set-macro-character #\{ (function brm:brace-reader-macro))

;;;------------------------------------------------------------------------

CL-USER> {LOCALLY-IMPORTING-FROM ((P1 (S11 S12))
(P2 (S21 S22)))
'(:s11 s11 cl-user::s12 s12 s21 s22 )}
(:S11 P1::S11 S12 P1::S12 P2::S21 P2::S22)


--
__Pascal Bourguignon__ http://www.informatimago.com/
 | 
Pages: 1
Prev: Emacs Form Feed (^L) Display Suggestion and Tips
Next: graph breadth first search