Commit 72e422f1 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

cleanup: remove hierarchical packages interface

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.
parent 9fa54cc6
......@@ -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)
......
......@@ -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, ...)
{
......
......@@ -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
......
......@@ -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;
}
......
......@@ -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},
......
......@@ -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},
......
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 */
......
......@@ -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)))
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment