From b530453f8e0331955b40c741a3b5dcb4bf6084d8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 11 Nov 2016 22:57:26 -0800
Subject: New :use-from clause in defpackage.
* share/txr/stdlib/package.tl (defpackage): Implemented
new :use-from clause.
* txr.1: Documented :use-from and made some improvements
to the defpackage documentation.
---
share/txr/stdlib/package.tl | 24 +++++++++++++++++++++++-
txr.1 | 28 +++++++++++++++++++++++++---
2 files changed, 48 insertions(+), 4 deletions(-)
diff --git a/share/txr/stdlib/package.tl b/share/txr/stdlib/package.tl
index 4c423145..1827628f 100644
--- a/share/txr/stdlib/package.tl
+++ b/share/txr/stdlib/package.tl
@@ -37,6 +37,23 @@
(name-str (sys:name-str 'package name))
(exp-clauses (append-each ((c clauses))
(tree-case c
+ ((keyword package . rest)
+ (caseql keyword
+ (:use-from
+ ^((let ((p (find-package ',package)))
+ (unless p
+ (throwf 'eval-error
+ "~s: no such package: ~s"
+ 'defpackage ',package))
+ (each ((n ',(mapcar (op sys:name-str 'symbol)
+ rest)))
+ (let ((s (intern n p)))
+ (unless (eq (symbol-package s) p)
+ (throwf 'eval-error
+ "~s: won't use non-local ~s from ~s"
+ 'defpackage s p))
+ (use-sym s ,pkg))))))
+ (t :)))
((keyword . rest)
(caseql keyword
(:use
@@ -50,7 +67,12 @@
(let ((s (intern n ,pkg)))
(unless (eq (symbol-package s) ,pkg)
(unuse-sym s ,pkg)
- (intern n ,pkg))))))))
+ (intern n ,pkg))))))
+ (:use-from
+ (throwf 'eval-error
+ "~s: :use-from clause needs package argument"
+ 'defpackage))
+ (t :)))
(atom
(throwf 'eval-error "~s: invalid clause: ~s"
'defpackage atom))))))
diff --git a/txr.1 b/txr.1
index a7831d2e..1e6013ed 100644
--- a/txr.1
+++ b/txr.1
@@ -39459,7 +39459,10 @@ If a package called
already exists, then
.code defpackage
selects that package for further operations. Otherwise, a new,
-empty package is created.
+empty package is created. In either case, this package is referred
+to as the
+.I "present package"
+in the following descriptions.
The
.code name
@@ -39477,7 +39480,7 @@ The supported clauses are as follows:
The
.code :use
clause specifies packages whose local symbols are to be interned
-into the package as foreign symbols. Each
+into the present package as foreign symbols. Each
.meta package-name
may be a string or symbol naming an existing package.
The list of package names is processed as if by a call to
@@ -39485,8 +39488,27 @@ The list of package names is processed as if by a call to
.meIP (:use-syms << symbol *)
The
.code :use-syms
-clause specifies individual symbols to be interned in the new package.
+clause specifies individual symbols to be interned in the present package.
The arguments are symbols.
+.meIP (:use-from < package-name << symbol-name *)
+The
+.code :use-from
+clause specifies the names of local symbols in a package denoted by
+.meta package-name
+to be used in the present package. All arguments of
+.code :use-from
+are either strings or symbols which are reduced to strings by mapping
+to their names. Each
+.meta symbol-name
+is interned in the package identified by
+.metn package-name ,
+which may have the effect of creating that symbol.
+This symbol is expected to be a local symbol of that package. If
+that is so, the symbol is brought into the present package via
+.codn use-symbol .
+Otherwise if the symbol is foreign to package identified by
+.metn package-name ,
+then an error exception is thrown.
.meIP (:local << symbol-name *)
The
.code :local
--
cgit v1.2.3