mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

extensions: put ext:package-locked-p in core module.

Browse source
This commit is contained in:
Daniel Kochmanski 2019-02-07 13:07:02 +01:00
parent 2190974312
commit 9096514cff
7 changed files with 20 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

8
contrib/package-locks/package-locks.lisp
View file

@ -26,14 +26,6 @@
:one-liner t)
T)
(defun package-locked-p (package &aux (package (si:coerce-to-package package)))
"Returns T when PACKAGE is locked, NIL otherwise. Signals an error
if PACKAGE doesn't designate a valid package."
(ffi:c-inline (package) (:object) :object
"(#0)->pack.locked ? ECL_T : ECL_NIL"
:side-effects nil
:one-liner t))
(defmacro without-package-locks (&body body)
"Ignores all runtime package lock violations during the execution of
body. Body can begin with declarations."

9
src/c/package.d
View file

@ -563,7 +563,7 @@ void
cl_export2(cl_object s, cl_object p)
{
int intern_flag, error;
cl_object other_p, name = ecl_symbol_name(s);
cl_object other_p = ECL_NIL, name = ecl_symbol_name(s);
p = si_coerce_to_package(p);
if (p->pack.locked
&& ECL_SYM_VAL(ecl_process_env(),
@ -966,6 +966,13 @@ si_package_lock(cl_object p, cl_object t)
@(return (previous? ECL_T : ECL_NIL));
}
cl_object
si_package_locked_p (cl_object p)
{
p = si_coerce_to_package(p);
@return (p->pack.locked ? ECL_T : ECL_NIL);
}
/* --- local nicknames ---------------------------------------------------- */
cl_object
si_package_local_nicknames(cl_object p)

2
src/c/symbols_list.h
View file

@ -1207,9 +1207,9 @@ cl_symbols[] = {
/* package extensions */
{SYS_ "*IGNORE-PACKAGE-LOCKS*", SI_SPECIAL, NULL, -1, ECL_NIL},
{EXT_ "PACKAGE-LOCK", EXT_ORDINARY, si_package_lock, 2, OBJNULL},
{EXT_ "PACKAGE-LOCKED-P", EXT_ORDINARY, si_package_locked_p, 1, OBJNULL},
{SYS_ "LOCK-PACKAGE", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "UNLOCK-PACKAGE", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "PACKAGE-LOCKED-P", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "WITHOUT-PACKAGE-LOCKS", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "WITH-UNLOCKED-PACKAGES", EXT_ORDINARY, NULL, 1, OBJNULL},
{EXT_ "PACKAGE-LOCAL-NICKNAMES", EXT_ORDINARY, si_package_local_nicknames, 1, OBJNULL},

2
src/c/symbols_list2.h
View file

@ -1207,9 +1207,9 @@ cl_symbols[] = {
/* package extensions */
{SYS_ "*IGNORE-PACKAGE-LOCKS*",NULL},
{EXT_ "PACKAGE-LOCK","si_package_lock"},
{EXT_ "PACKAGE-LOCKED-P","si_package_locked_p"},
{SYS_ "LOCK-PACKAGE",NULL},
{SYS_ "UNLOCK-PACKAGE",NULL},
{SYS_ "PACKAGE-LOCKED-P",NULL},
{SYS_ "WITHOUT-PACKAGE-LOCKS",NULL},
{SYS_ "WITH-UNLOCKED-PACKAGES",NULL},
{EXT_ "PACKAGE-LOCAL-NICKNAMES","si_package_local_nicknames"},

1
src/cmp/proclamations.lsp
View file

@ -453,6 +453,7 @@
(proclamation si:package-hash-tables (package-designator)
(values hash-table hash-table list) :reader)
(proclamation ext:package-lock (package-designator gen-bool) package)
(proclamation ext:package-locked-p (package-designator) boolean :no-side-effects)
(proclamation ext:package-local-nicknames
(package-designator) list :no-side-effects)
(proclamation ext:package-locally-nicknamed-by-list

8
src/doc/help.lsp
View file

@ -2295,6 +2295,14 @@ built-in packages:
system system internal symbols. Has nicknames SYS and SI.
compiler system internal symbols for the ECL compiler.")
(docfun ext:package-lock function
(package-designator lock) "
Sets package's lock to LOCK. Returns previous lock value.")
(docfun ext:package-locked-p function
(package-designator) "
Returns T when PACKAGE is locked, NIL otherwise.")
(docfun ext:package-local-nicknames function
(package-designator) "
Returns an alist of (LOCAL-NICKNAME . ACTUAL-PACKAGE)

1
src/h/external.h
View file

@ -1313,6 +1313,7 @@ extern ECL_API cl_object si_remove_package_local_nickname(cl_object n, cl_object
extern ECL_API cl_object cl_list_all_packages(void);
extern ECL_API cl_object si_package_hash_tables(cl_object p);
extern ECL_API cl_object si_package_lock(cl_object p, cl_object t);
extern ECL_API cl_object si_package_locked_p(cl_object p);
extern ECL_API cl_object cl_delete_package(cl_object p);
extern ECL_API cl_object cl_make_package _ECL_ARGS((cl_narg narg, cl_object pack_name, ...));
extern ECL_API cl_object cl_intern _ECL_ARGS((cl_narg narg, cl_object strng, ...));