mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-23 13:01:42 -08:00
Code Issues Projects Releases Packages Wiki Activity

packages: add local-nicknames to the internal structure

Browse source 
adjust internal functions to accept the argument.
This commit is contained in:
Daniel Kochmanski 2017-04-30 12:35:00 +02:00
parent 82a50e9ce2
commit 9c2aef5599
7 changed files with 60 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

33
src/c/main.d
View file

@ -556,43 +556,54 @@ cl_boot(int argc, char **argv)
cl_core.lisp_package =
ecl_make_package(str_common_lisp,
cl_list(2, str_cl, str_LISP),
ECL_NIL,
ECL_NIL);
cl_core.user_package =
ecl_make_package(str_common_lisp_user,
cl_list(2, str_cl_user, str_user),
ecl_list1(cl_core.lisp_package));
ecl_list1(cl_core.lisp_package),
ECL_NIL);
cl_core.keyword_package =
ecl_make_package(str_keyword, ECL_NIL, ECL_NIL);
ecl_make_package(str_keyword, ECL_NIL, ECL_NIL, ECL_NIL);
cl_core.ext_package =
ecl_make_package(str_ext, ECL_NIL,
ecl_list1(cl_core.lisp_package));
ecl_make_package(str_ext,
ECL_NIL,
ecl_list1(cl_core.lisp_package),
ECL_NIL);
cl_core.system_package =
ecl_make_package(str_si,
cl_list(2,str_system,str_sys),
cl_list(2,cl_core.ext_package,
cl_core.lisp_package));
cl_core.lisp_package),
ECL_NIL);
cl_core.c_package =
ecl_make_package(str_c,
ecl_list1(str_compiler),
ecl_list1(cl_core.lisp_package));
ecl_list1(cl_core.lisp_package),
ECL_NIL);
cl_core.clos_package =
ecl_make_package(str_clos,
ecl_list1(str_mop),
ecl_list1(cl_core.lisp_package));
ecl_list1(cl_core.lisp_package),
ECL_NIL);
cl_core.mp_package =
ecl_make_package(str_mp,
ecl_list1(str_multiprocessing),
ecl_list1(cl_core.lisp_package));
ecl_list1(cl_core.lisp_package),
ECL_NIL);
#ifdef ECL_CLOS_STREAMS
cl_core.gray_package = ecl_make_package(str_gray, ECL_NIL,
CONS(cl_core.lisp_package, ECL_NIL));
cl_core.gray_package = ecl_make_package(str_gray,
ECL_NIL,
ecl_list1(cl_core.lisp_package),
ECL_NIL);
#endif
cl_core.ffi_package =
ecl_make_package(str_ffi,
ECL_NIL,
cl_list(3,cl_core.lisp_package,
cl_core.system_package,
cl_core.ext_package));
cl_core.ext_package),
ECL_NIL);
ECL_NIL_SYMBOL->symbol.hpack = cl_core.lisp_package;
cl_import2(ECL_NIL, cl_core.lisp_package);

36
src/c/package.d
View file

@ -95,11 +95,12 @@ symbol_add_package(cl_object s, cl_object p)
}
/*
ecl_make_package(n, ns, ul) makes a package with name n,
which must be a string or a symbol,
and nicknames ns, which must be a list of strings or symbols,
and uses packages in list ul, which must be a list of packages
or package names i.e. strings or symbols.
ecl_make_package(n, ns, ul, lns) makes a package with name n, which
must be a string or a symbol, and nicknames ns, which must be a list
of strings or symbols, and uses packages in list ul, which must be a
list of packages or package names i.e. strings or symbols. lns is an
alist (local-nickname . package) which is used for having private
nicknames for other packages.
*/
static cl_object
make_package_hashtable()
@ -118,6 +119,7 @@ alloc_package(cl_object name)
p->pack.external = make_package_hashtable();
p->pack.name = name;
p->pack.nicknames = ECL_NIL;
p->pack.local_nicknames = ECL_NIL;
p->pack.shadowings = ECL_NIL;
p->pack.uses = ECL_NIL;
p->pack.usedby = ECL_NIL;
@ -184,8 +186,21 @@ process_package_list(cl_object packages)
return packages;
}
static cl_object
process_local_nicknames_list(cl_object local_nicknames)
{
cl_object l;
local_nicknames = cl_copy_list(local_nicknames);
for (l = local_nicknames; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
ECL_RPLACA(l, si_coerce_to_package(ECL_CONS_CAR(l)));
ECL_RPLACD(l, si_coerce_to_package(ECL_CONS_CDR(l)));
}
return local_nicknames;
}
cl_object
ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
ecl_make_package(cl_object name, cl_object nicknames,
cl_object use_list, cl_object local_nicknames)
{
const cl_env_ptr env = ecl_process_env();
cl_object x, other = ECL_NIL;
@ -195,6 +210,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
name = cl_string(name);
nicknames = process_nicknames(nicknames);
use_list = process_package_list(use_list);
local_nicknames = process_local_nicknames_list(local_nicknames);
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(env) {
/* Find a similarly named package in the list of
@ -223,6 +239,7 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
x->pack.uses = CONS(y, x->pack.uses);
y->pack.usedby = CONS(x, y->pack.usedby);
} end_loop_for_in;
x->pack.local_nicknames = local_nicknames;
/* Finally, add it to the list of packages */
cl_core.packages = CONS(x, cl_core.packages);
OUTPUT:
@ -850,10 +867,13 @@ ecl_unuse_package(cl_object x, cl_object p)
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
}
@(defun make_package (pack_name &key nicknames (use CONS(cl_core.lisp_package, ECL_NIL)))
@(defun make_package (pack_name &key
nicknames
(use CONS(cl_core.lisp_package, ECL_NIL))
local_nicknames)
@
/* INV: ecl_make_package() performs type checking */
@(return ecl_make_package(pack_name, nicknames, use));
@(return ecl_make_package(pack_name, nicknames, use, local_nicknames));
@)
cl_object

1
src/c/symbols_list.h
View file

@ -1388,6 +1388,7 @@ cl_symbols[] = {
{KEY_ "LINK", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "LIST-ALL", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "LOCAL",KEYWORD,NULL,-1,OBJNULL},
{KEY_ "LOCAL-NICKNAMES",KEYWORD,NULL,-1,OBJNULL},
{KEY_ "LOCKABLE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "LOAD-TOPLEVEL", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "MASK", KEYWORD, NULL, -1, OBJNULL},

1
src/c/symbols_list2.h
View file

@ -1388,6 +1388,7 @@ cl_symbols[] = {
{KEY_ "LINK",NULL},
{KEY_ "LIST-ALL",NULL},
{KEY_ "LOCAL",NULL},
{KEY_ "LOCAL-NICKNAMES",NULL},
{KEY_ "LOCKABLE",NULL},
{KEY_ "LOAD-TOPLEVEL",NULL},
{KEY_ "MASK",NULL},

2
src/h/external.h
View file

@ -1300,7 +1300,7 @@ extern ECL_API cl_object cl_shadow _ECL_ARGS((cl_narg narg, cl_object symbols, .
extern ECL_API cl_object cl_use_package _ECL_ARGS((cl_narg narg, cl_object pack, ...));
extern ECL_API cl_object cl_unuse_package _ECL_ARGS((cl_narg narg, cl_object pack, ...));
extern ECL_API cl_object ecl_make_package(cl_object n, cl_object ns, cl_object ul);
extern ECL_API cl_object ecl_make_package(cl_object n, cl_object ns, cl_object ul, cl_object lns);
extern ECL_API cl_object ecl_rename_package(cl_object x, cl_object n, cl_object ns);
extern ECL_API cl_object ecl_find_package_nolock(cl_object n);
extern ECL_API cl_object ecl_find_package(const char *p);

11
src/h/object.h
View file

@ -272,11 +272,12 @@ struct ecl_symbol {
struct ecl_package {
_ECL_HDR1(locked);
cl_object name; /* package name, a string */
cl_object nicknames; /* nicknames, list of strings */
cl_object shadowings; /* shadowing symbol list */
cl_object uses; /* use-list of packages */
cl_object usedby; /* used-by-list of packages */
cl_object name; /* package name, a string */
cl_object nicknames; /* nicknames, list of strings */
cl_object local_nicknames; /* local nicknames, assoc list */
cl_object shadowings; /* shadowing symbol list */
cl_object uses; /* use-list of packages */
cl_object usedby; /* used-by-list of packages */
cl_object internal; /* hashtable for internal symbols */
cl_object external; /* hashtable for external symbols */
};

2
src/lsp/defpackage.lsp
View file

@ -204,7 +204,7 @@
(rename-package name name nicknames))
(when use
(unuse-package (package-use-list (find-package name)) name)))
(make-package name :use nil :nicknames nicknames))
(make-package name :use nil :nicknames nicknames :local-nicknames local-nicknames))
(let ((*package* (find-package name)))
(when documentation
(setf (documentation *package* t) documentation))