sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cleanup: remove hierarchical packages interface

Browse source 
It didn't work for some cases and wasn't documented, so I'm removing
it. Freshly written tests are left in tests for someone, who would
like to reimplement them.
This commit is contained in:
Daniel Kochmanski 2017-05-13 18:06:26 +02:00
parent 9fa54cc66a
commit 72e422f1b3
15 changed files with 15 additions and 197 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
msvc/ecl/config.h.msvc6
View file

@ -107,9 +107,6 @@
# define ECL_DYNAMIC_FFI 1
#endif
/* We use hierarchical package names, like in Allegro CL */
#define ECL_RELATIVE_PACKAGE_NAMES 1
/* Use mprotect for fast interrupt dispatch */
/* #undef ECL_USE_MPROTECT */
#if defined(_MSC_VER) || defined(mingw32)

6
src/c/cinit.d
View file

@ -126,12 +126,6 @@ cl_array_dimensions(cl_object array)
return _ecl_funcall2(@'ARRAY-DIMENSIONS', array);
}
extern cl_object
si_find_relative_package(cl_narg narg, cl_object package, ...)
{
@(return ECL_NIL);
}
extern cl_object
si_wrong_type_argument(cl_narg narg, cl_object object, cl_object type, ...)
{

3
src/c/ecl_features.h
View file

@ -74,9 +74,6 @@ ecl_def_string_array(feature_names,static,const) = {
#ifdef ECL_LONG_FLOAT
ecl_def_string_array_elt("LONG-FLOAT"),
#endif
#ifdef ECL_RELATIVE_PACKAGE_NAMES
ecl_def_string_array_elt("RELATIVE-PACKAGE-NAMES"),
#endif
#ifdef ecl_uint16_t
ecl_def_string_array_elt("UINT16-T"),
#endif

8
src/c/package.d
View file

@ -335,14 +335,6 @@ ecl_find_package_nolock(cl_object name)
if (member_string_eq(name, p->pack.nicknames))
return p;
} end_loop_for_on_unsafe(l);
#ifdef ECL_RELATIVE_PACKAGE_NAMES
/* Note that this function may actually be called _before_ symbols are set up
* are bound! */
if (ecl_option_values[ECL_OPT_BOOTED] &&
ECL_SYM_VAL(ecl_process_env(), @'si::*relative-package-names*') != ECL_NIL) {
return si_find_relative_package(1, name);
}
#endif
return ECL_NIL;
}

18
src/c/symbols_list.h
View file

@ -11,11 +11,6 @@
#else
# define ECL_NAME(x) NULL
#endif
#ifdef ECL_RELATIVE_PACKAGE_NAMES
# define RELATIVE_PACKAGES_P ECL_T
#else
# define RELATIVE_PACKAGES_P ECL_NIL
#endif
#ifdef DPP
#define CLOS_ "CLOS::"
#define EXT_ "EXT::"
@ -57,11 +52,6 @@ typedef struct {
#else
# define IF_PROFILE(x) NULL
#endif
#ifdef ECL_RELATIVE_PACKAGE_NAMES
# define IF_RELPACK(x) x
#else
# define IF_RELPACK(x) NULL
#endif
#ifndef ECL_CLOS_STREAMS
# undef GRAY_
# define GRAY_ SYS_
@ -1782,14 +1772,6 @@ cl_symbols[] = {
{EXT_ "GET-FINALIZER", EXT_ORDINARY, si_get_finalizer, 1, OBJNULL},
{EXT_ "SET-FINALIZER", EXT_ORDINARY, si_set_finalizer, 2, OBJNULL},
/* #ifdef ECL_RELATIVE_PACKAGE_NAMES */
{SYS_ "*RELATIVE-PACKAGE-NAMES*", SI_SPECIAL, NULL, -1, RELATIVE_PACKAGES_P},
{KEY_ "RELATIVE-PACKAGE-NAMES", KEYWORD, NULL, -1, OBJNULL},
{SYS_ "FIND-RELATIVE-PACKAGE", SI_ORDINARY, IF_RELPACK(si_find_relative_package), -1, OBJNULL},
{SYS_ "PACKAGE-PARENT", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "PACKAGE-CHILDREN", SI_ORDINARY, NULL, -1, OBJNULL},
/* #endif ECL_RELATIVE_PACKAGE_NAMES */
{SYS_ "WRONG-TYPE-ARGUMENT", SI_ORDINARY, si_wrong_type_argument, -1, OBJNULL},
{SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, OBJNULL},

18
src/c/symbols_list2.h
View file

@ -11,11 +11,6 @@
#else
# define ECL_NAME(x) NULL
#endif
#ifdef ECL_RELATIVE_PACKAGE_NAMES
# define RELATIVE_PACKAGES_P ECL_T
#else
# define RELATIVE_PACKAGES_P ECL_NIL
#endif
#ifdef DPP
#define CLOS_ "CLOS::"
#define EXT_ "EXT::"
@ -57,11 +52,6 @@ typedef struct {
#else
# define IF_PROFILE(x) NULL
#endif
#ifdef ECL_RELATIVE_PACKAGE_NAMES
# define IF_RELPACK(x) x
#else
# define IF_RELPACK(x) NULL
#endif
#ifndef ECL_CLOS_STREAMS
# undef GRAY_
# define GRAY_ SYS_
@ -1782,14 +1772,6 @@ cl_symbols[] = {
{EXT_ "GET-FINALIZER","si_get_finalizer"},
{EXT_ "SET-FINALIZER","si_set_finalizer"},
/* #ifdef ECL_RELATIVE_PACKAGE_NAMES */
{SYS_ "*RELATIVE-PACKAGE-NAMES*",NULL},
{KEY_ "RELATIVE-PACKAGE-NAMES",NULL},
{SYS_ "FIND-RELATIVE-PACKAGE",IF_RELPACK("si_find_relative_package")},
{SYS_ "PACKAGE-PARENT",NULL},
{SYS_ "PACKAGE-CHILDREN",NULL},
/* #endif ECL_RELATIVE_PACKAGE_NAMES */
{SYS_ "WRONG-TYPE-ARGUMENT","si_wrong_type_argument"},
{SYS_ "*CURRENT-FORM*",NULL},

1
src/cmp/sysfun.lsp
View file

@ -920,7 +920,6 @@
deposit-field
;; packlib.lsp
find-all-symbols apropos apropos-list
find-relative-package package-parent package-children
;; predlib.lsp
upgraded-array-element-type upgraded-complex-part-type typep subtypep coerce
do-deftype si::ratiop si::single-float-p si::short-float-p si::double-float-p

30
src/configure vendored
View file

@ -737,6 +737,7 @@ infodir
docdir
oldincludedir
includedir
runstatedir
localstatedir
sharedstatedir
sysconfdir
@ -801,7 +802,6 @@ with_sse
enable_unicode
enable_longdouble
enable_c99complex
enable_hpack
enable_asmapply
enable_smallcons
enable_gengc
@ -867,6 +867,7 @@ datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
runstatedir='${localstatedir}/run'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
@ -1119,6 +1120,15 @@ do
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
-runstatedir | --runstatedir | --runstatedi | --runstated \
| --runstate | --runstat | --runsta | --runst | --runs \
| --run | --ru | --r)
ac_prev=runstatedir ;;
-runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
| --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
| --run=* | --ru=* | --r=*)
runstatedir=$ac_optarg ;;
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@ -1256,7 +1266,7 @@ fi
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
libdir localedir mandir
libdir localedir mandir runstatedir
do
eval ac_val=\$$ac_var
# Remove trailing slashes.
@ -1409,6 +1419,7 @@ Fine tuning of the installation directories:
--sysconfdir=DIR read-only single-machine data [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
--localstatedir=DIR modifiable single-machine data [PREFIX/var]
--runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run]
--libdir=DIR object code libraries [EPREFIX/lib]
--includedir=DIR C header files [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc [/usr/include]
@ -1466,7 +1477,6 @@ Optional Features:
--enable-longdouble include support for long double (yes|no|auto,
default=AUTO)
--enable-c99complex include support for C complex type (default=NO)
--enable-hpack hierarchical package names (default=YES)
--enable-asmapply enable optimizations written in assembler,
EXPERIMENTAL (default=NO)
--enable-smallcons use small (2 words) cons types. Requires
@ -2949,14 +2959,6 @@ else
fi
# Check whether --enable-hpack was given.
if test "${enable_hpack+set}" = set; then :
enableval=$enable_hpack; enable_hpack=${enableval}
else
enable_hpack=yes
fi
# Check whether --enable-asmapply was given.
if test "${enable_asmapply+set}" = set; then :
enableval=$enable_asmapply; enable_asmapply=${enableval}
@ -9808,12 +9810,6 @@ else
ECL_INIT_FORM="${with_init_form}"
fi
if test "${enable_hpack}" = "yes"; then
$as_echo "#define ECL_RELATIVE_PACKAGE_NAMES 1" >>confdefs.h
fi
ac_config_files="$ac_config_files bare.lsp lsp/load.lsp clos/load.lsp cmp/load.lsp ../Makefile Makefile c/Makefile doc/Makefile doc/ecl.man doc/ecl-config.man ecl/configpre.h:h/config.h.in ecl/configpre-int.h:h/config-internal.h.in bin/ecl-config.pre:util/ecl-config lsp/config.lsp:lsp/config.lsp.in compile.pre:compile.lsp.in cmp/cmpdefs.pre:cmp/cmpdefs.lsp tests/config.lsp tests/Makefile"

10
src/configure.ac
View file

@ -253,12 +253,6 @@ AC_ARG_ENABLE(c99complex,
[(default=NO)]),
[enable_c99complex=${enableval}], [enable_c99complex=no])
AC_ARG_ENABLE(hpack,
AS_HELP_STRING( [--enable-hpack],
[hierarchical package names]
[(default=YES)]),
[enable_hpack=${enableval}], [enable_hpack=yes])
AC_ARG_ENABLE(asmapply,
AS_HELP_STRING( [--enable-asmapply],
[enable optimizations written in assembler, EXPERIMENTAL]
@ -938,10 +932,6 @@ else
ECL_INIT_FORM="${with_init_form}"
fi
if test "${enable_hpack}" = "yes"; then
AC_DEFINE([ECL_RELATIVE_PACKAGE_NAMES], [1], [Hierarchical package names])
fi
AC_CONFIG_FILES([
bare.lsp
lsp/load.lsp

3
src/ecl/configpre.h
View file

@ -39,9 +39,6 @@
/* Define if your newline is CRLF */
#undef ECL_NEWLINE_IS_CRLF
/* Hierarchical package names */
#undef ECL_RELATIVE_PACKAGE_NAMES
/* ECL_RWLOCK */
#undef ECL_RWLOCK

3
src/h/config.h.in
View file

@ -115,9 +115,6 @@
/* We have libffi and can use it */
#undef HAVE_LIBFFI
/* We use hierarchical package names, like in Allegro CL */
#undef ECL_RELATIVE_PACKAGE_NAMES
/* Use mprotect for fast interrupt dispatch */
#ifndef NACL
#undef ECL_USE_MPROTECT

1
src/h/external.h
View file

@ -2055,7 +2055,6 @@ extern ECL_API cl_object cl_deposit_field(cl_object V1, cl_object V2, cl_object
extern ECL_API cl_object cl_find_all_symbols(cl_object V1);
extern ECL_API cl_object cl_apropos _ECL_ARGS((cl_narg arg, cl_object V1, ...));
extern ECL_API cl_object cl_apropos_list _ECL_ARGS((cl_narg arg, cl_object V1, ...));
extern ECL_API cl_object si_find_relative_package _ECL_ARGS((cl_narg narg, cl_object pack_name, ...));
/* predlib.lsp */

4
src/lsp/cmdline.lsp
View file

@ -23,7 +23,7 @@
(defparameter *help-message* "
Usage: ecl [-? | --help]
[--dir dir] [--load file] [--shell file] [--eval expr] [--rc | --norc] [--hp | --nohp]
[--dir dir] [--load file] [--shell file] [--eval expr] [--rc | --norc]
[--c-stack size] [--lisp-stack size] [--heap-size size] [--frame-stack size]
[[-o ofile] [-c [cfile]] [-h [hfile]] [--data [datafile]] [-s] [-q]
--compile file]
@ -117,8 +117,6 @@ appeared after a '--'.")
("-h" &optional (setq h-file 1))
(("-data" "--data") 1 (setq data-file 1))
(("-q" "--quiet") 0 (setq verbose nil))
(("-hp" "--hp") 0 (setf *relative-package-names* t))
(("-nohp" "--nohp") 0 (setf *relative-package-names* nil))
("-s" 0 (setq system-p t))
("--" 1 (setf ext:*unprocessed-ecl-command-args* (rest 1)) :stop)))

102
src/lsp/packlib.lsp
View file

@ -183,108 +183,6 @@ If PACKAGE is non-NIL, then only the specified PACKAGE is searched."
(setq list (cons symbol list))))))
list))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; HIERARCHICAL PACKAGE NAMES
;;
;; Code provided by Franz Inc. to the public domain and adapted for ECL.
;;
(defun find-relative-package (name)
;; Given a package name, a string, do a relative package name lookup.
;;
(declare (optimize speed))
(flet ((relative-to (package name)
(if (zerop (length name))
package
(find-package (concatenate 'simple-string (package-name package) "." name))))
(find-non-dot (name)
(do* ((len (length name))
(i 0 (1+ i)))
((= i len) nil)
(declare (fixnum len i))
(when (char/= #\. (char name i)) (return i)))))
(when (and (stringp name)
(plusp (length name))
(char= #\. (char name 0)))
(let* ((last-dot-position (or (find-non-dot name) (length name)))
(n-dots (truly-the fixnum last-dot-position))
(name (subseq name last-dot-position)))
;; relative to our (- n-dots 1)'th parent
(let ((p *package*))
(dotimes (i (1- n-dots))
(declare (fixnum i))
(let ((tmp (package-parent p)))
(unless tmp
(error "The parent of ~a does not exist." p))
(setq p tmp)))
(relative-to p name))))))
(defun package-parent (package-specifier)
;; Given package-specifier, a package, symbol or string, return the
;; parent package. If there is not a parent, signal an error.
;;
;; Because this function is called via the reader, we want it to be as
;; fast as possible.
(declare (optimize speed))
(flet ((find-last-dot (name)
(do* ((len (1- (length name)))
(i len (1- i)))
((= i -1) nil)
(declare (fixnum len i))
(when (char= #\. (char name i)) (return i)))))
(let* ((child (cond ((packagep package-specifier)
(package-name package-specifier))
((symbolp package-specifier)
(symbol-name package-specifier))
((stringp package-specifier) package-specifier)
(t (error "Illegal package specifier: ~s."
package-specifier))))
(dot-position (find-last-dot child)))
(if dot-position
(let ((parent (subseq child 0 dot-position)))
(or (find-package parent)
(error "The parent of ~a does not exist." child))))
(error "There is no parent of ~a." child))))
(defun package-children (package-specifier &key (recurse t))
;; Given package-specifier, a package, symbol or string, return all the
;; packages which are in the hierarchy "under" the given package. If
;; :recurse is nil, then only return the immediate children of the
;; package.
;;
;; While this function is not called via the reader, we do want it to be
;; fast.
(declare (optimize speed))
(let* ((res ())
(parent (cond ((packagep package-specifier)
(package-name package-specifier))
((symbolp package-specifier)
(symbol-name package-specifier))
((stringp package-specifier) package-specifier)
(t (error "Illegal package specifier: ~s." package-specifier))))
(parent-prefix (concatenate 'simple-string parent ".")))
(labels
((string-prefix-p (prefix string)
;; Return length of `prefix' if `string' starts with `prefix'.
;; We don't use `search' because it does much more than we need
;; and this version is about 10x faster than calling `search'.
(let ((prefix-len (length prefix))
(seq-len (length string)))
(declare (fixnum prefix-len seq-len))
(when (>= prefix-len seq-len)
(return-from string-prefix-p nil))
(do* ((i 0 (1+ i)))
((= i prefix-len) prefix-len)
(declare (fixnum i))
(when (not (char= (char prefix i) (char string i)))
(return nil))))))
(dolist (package (list-all-packages))
(let* ((package-name (package-name package))
(prefix (string-prefix-p parent-prefix package-name)))
(when (and prefix (or recurse (not (find #\. package-name :start prefix))))
(pushnew package res)))))))
;; Package local nicknames
(defun add-package-local-nickname (local-nickname nicknamed-package

2
src/tests/normal-tests/package-extensions.lsp
View file

@ -153,7 +153,7 @@
;;; relative-package-names
#+(and relative-package-names test-known-fails)
#+relative-package-names
(test relative-package-names
(defpackage eu)
(defpackage eu.turtleware)