From 9096514cff89f007271a278643bd3e2817b6bd78 Mon Sep 17 00:00:00 2001 From: Daniel Kochmanski Date: Thu, 7 Feb 2019 13:07:02 +0100 Subject: [PATCH] extensions: put ext:package-locked-p in core module. --- contrib/package-locks/package-locks.lisp | 8 -------- src/c/package.d | 9 ++++++++- src/c/symbols_list.h | 2 +- src/c/symbols_list2.h | 2 +- src/cmp/proclamations.lsp | 1 + src/doc/help.lsp | 8 ++++++++ src/h/external.h | 1 + 7 files changed, 20 insertions(+), 11 deletions(-) diff --git a/contrib/package-locks/package-locks.lisp b/contrib/package-locks/package-locks.lisp index 43d97a44..f39df204 100644 --- a/contrib/package-locks/package-locks.lisp +++ b/contrib/package-locks/package-locks.lisp @@ -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." diff --git a/src/c/package.d b/src/c/package.d index a2129503..7b95331d 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -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) diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 1df966dd..1f830301 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -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}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 2cf73fc5..bea81ecc 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -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"}, diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 6c261062..1cac7ef0 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -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 diff --git a/src/doc/help.lsp b/src/doc/help.lsp index daf2a54e..464eb5da 100644 --- a/src/doc/help.lsp +++ b/src/doc/help.lsp @@ -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) diff --git a/src/h/external.h b/src/h/external.h index acdff627..d27b3a1a 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -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, ...));