carbon2-commit: Remove all support for InfoDock.
14 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5284:5efbd1253905
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Jun 07 18:42:10 2010 +0100
files: ChangeLog configure configure.ac lisp/ChangeLog lisp/dumped-lisp.el lisp/loadup.el lisp/packages.el lisp/simple.el lisp/startup.el lisp/toolbar.el lisp/version.el src/ChangeLog src/config.h.in src/device-gtk.c src/device-x.c src/emacs.c src/lread.c tests/ChangeLog tests/gtk/gtk-test.el version.sh.in
description:
Remove all support for InfoDock.
src/…
[View More]ChangeLog addition:
2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
* lread.c (vars_of_lread):
* emacs.c:
(shut_down_emacs, vars_of_emacs, complex_vars_of_emacs):
* device-x.c (get_device_from_display)
(have_xemacs_resources_in_xrdb):
* device-gtk.c (Fgtk_init):
* config.h.in:
Remove all checks for InfoDock.
lisp/ChangeLog addition:
2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
* version.el:
(emacs-version):
* startup.el (command-line):
* simple.el (display-warning, emacs-name):
* packages.el (packages-package-hierarchy-directory-names):
* loadup.el (Dumping):
* dumped-lisp.el (preloaded-file-list):
Remove all InfoDock-specific code.
diff -r fbd1485af104 -r 5efbd1253905 ChangeLog
--- a/ChangeLog Sun Jun 06 13:24:31 2010 +0100
+++ b/ChangeLog Mon Jun 07 18:42:10 2010 +0100
＠＠ -1,3 +1,9 ＠＠
+2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * version.sh.in:
+ * configure.ac (XE_COMPLEX_ARG, XE_EXPAND_VARIABLE):
+ Remove conditionals and information for InfoDock.
+
2010-04-09 Ben Wing <ben(a)xemacs.org>
* CHANGES-beta:
diff -r fbd1485af104 -r 5efbd1253905 configure
--- a/configure Sun Jun 06 13:24:31 2010 +0100
+++ b/configure Mon Jun 07 18:42:10 2010 +0100
＠＠ -1005,8 +1005,6 ＠＠
with_workshop
enable_sparcworks
with_sparcworks
-enable_infodock
-with_infodock
enable_debug
with_debug
enable_error_checking
＠＠ -1952,8 +1950,6 ＠＠
--with-workshop Support the Sun WorkShop (formerly Sparcworks)
development environment.
--with-sparcworks Alias for --with-workshop
- --with-infodock Support the Infodock version of XEmacs. Infodock is
- a SourceForge project).
Debugging options
-----------------
＠＠ -5190,22 +5186,6 ＠＠
withval="$with_sparcworks"
fi;
-# If --with-infodock or --without-infodock were given then copy the value to the
-# equivalent enable_infodock variable.
-if test "${with_infodock+set}" = set; then
- enable_infodock="$with_infodock"
-fi;
-# If -enable-infodock or --disable-infodock were given then copy the value to the
-# equivalent with_infodock variable.
-if test "${enable_infodock+set}" = set; then
- with_infodock="$enable_infodock"
-fi;
-# Check whether --with-infodock or --without-infodock was given.
-if test "${with_infodock+set}" = set; then
- enableval="$with_infodock"
- withval="$with_infodock"
-
-fi;
# If --with-debug or --without-debug were given then copy the value to the
# equivalent enable_debug variable.
＠＠ -5716,34 +5696,8 ＠＠
_ACEOF
-if test "$with_infodock" = "yes"; then
- if test ! -f ../../ID-INSTALL; then
- echo "Cannot build InfoDock without InfoDock sources"
- with_infodock=no
- fi
-fi
-
-if test "$with_infodock" = "yes"; then
- cat >>confdefs.h <<_ACEOF
-#define INFODOCK_MAJOR_VERSION $infodock_major_version
-_ACEOF
-
- cat >>confdefs.h <<_ACEOF
-#define INFODOCK_MINOR_VERSION $infodock_minor_version
-_ACEOF
-
- cat >>confdefs.h <<_ACEOF
-#define INFODOCK_BUILD_VERSION $infodock_build_version
-_ACEOF
-
- version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version}
- PROGNAME=infodock
- SHEBANG_PROGNAME=infodock-script
- CPPFLAGS="$CPPFLAGS -DINFODOCK"
-else
- PROGNAME=xemacs
- SHEBANG_PROGNAME=xemacs-script
-fi
+PROGNAME=xemacs
+SHEBANG_PROGNAME=xemacs-script
diff -r fbd1485af104 -r 5efbd1253905 configure.ac
--- a/configure.ac Sun Jun 06 13:24:31 2010 +0100
+++ b/configure.ac Mon Jun 07 18:42:10 2010 +0100
＠＠ -977,9 +977,6 ＠＠
XE_MERGED_ARG([sparcworks],
AS_HELP_STRING([--with-sparcworks],[Alias for --with-workshop]),
[], [])
-XE_MERGED_ARG([infodock],
- AS_HELP_STRING([--with-infodock],[Support the Infodock version of XEmacs. Infodock is a SourceForge project).]),
- [], [])
dnl
XE_HELP_SUBSECTION([Debugging options])
XE_MERGED_ARG([debug],
＠＠ -1228,27 +1225,8 ＠＠
fi
AC_DEFINE_UNQUOTED(EMACS_VERSION, "$version")
-if test "$with_infodock" = "yes"; then
- if test ! -f ../../ID-INSTALL; then
- echo "Cannot build InfoDock without InfoDock sources"
- with_infodock=no
- fi
-fi
-
-if test "$with_infodock" = "yes"; then
- dnl InfoDock version numbers. XEmacs will use the same style of numbering
- dnl after the release of XEmacs 21.0.
- AC_DEFINE_UNQUOTED(INFODOCK_MAJOR_VERSION, $infodock_major_version)
- AC_DEFINE_UNQUOTED(INFODOCK_MINOR_VERSION, $infodock_minor_version)
- AC_DEFINE_UNQUOTED(INFODOCK_BUILD_VERSION, $infodock_build_version)
- version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version}
- PROGNAME=infodock
- SHEBANG_PROGNAME=infodock-script
- CPPFLAGS="$CPPFLAGS -DINFODOCK"
-else
- PROGNAME=xemacs
- SHEBANG_PROGNAME=xemacs-script
-fi
+PROGNAME=xemacs
+SHEBANG_PROGNAME=xemacs-script
AC_SUBST(SHEBANG_PROGNAME)
diff -r fbd1485af104 -r 5efbd1253905 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/ChangeLog Mon Jun 07 18:42:10 2010 +0100
＠＠ -11,6 +11,17 ＠＠
specified by CL. For discussion; the compiler macro may be a
little too aggressive about taking the compile time argument lists
of the functions it is inverting.
+
+2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * version.el:
+ (emacs-version):
+ * startup.el (command-line):
+ * simple.el (display-warning, emacs-name):
+ * packages.el (packages-package-hierarchy-directory-names):
+ * loadup.el (Dumping):
+ * dumped-lisp.el (preloaded-file-list):
+ Remove all InfoDock-specific code.
2010-05-31 Aidan Kehoe <kehoea(a)parhasard.net>
diff -r fbd1485af104 -r 5efbd1253905 lisp/dumped-lisp.el
--- a/lisp/dumped-lisp.el Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/dumped-lisp.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -148,10 +148,10 ＠＠
;; should just be able to assume that, if (featurep 'menubar),
;; the menubar should work and if items are added, they can be
;; seen clearly and usefully.
- (when (featurep '(and (not infodock) menubar)) "menubar-items")
- (when (featurep '(and gutter)) "gutter-items")
- (when (featurep '(and (not infodock) toolbar)) "toolbar-items")
- (when (featurep '(and (not infodock) dialog)) "dialog-items")
+ (when (featurep 'menubar) "menubar-items")
+ (when (featurep 'gutter) "gutter-items")
+ (when (featurep 'toolbar) "toolbar-items")
+ (when (featurep 'dialog) "dialog-items")
;;;;;;;;;;;;;;;;;; Coding-system support
"coding"
＠＠ -234,12 +234,6 ＠＠
;;; mule-load.el ends here
-;; preload InfoDock stuff. should almost certainly not be here if
-;; id-menus is not here. infodock needs to figure out a clever way to
-;; advise this stuff or we need to export a clean way for infodock or
-;; others to control this programmatically.
- (when (featurep '(and infodock (or x mswindows gtk) menubar))
- "id-menus")
;; preload the X code.
(when (featurep '(and x scrollbar)) "x-scrollbar")
(when (featurep 'x)
diff -r fbd1485af104 -r 5efbd1253905 lisp/loadup.el
--- a/lisp/loadup.el Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/loadup.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -264,12 +264,7 ＠＠
load-always-display-messages nil
debug-on-error nil)
(dump-emacs
- (cond
- ((featurep 'infodock) "infodock")
- ;; #### BILL!!!
- ;; If we want to dump under a name other than `xemacs', do that here!
- ;; ((featurep 'gtk) "xemacs-gtk")
- (t "xemacs"))
+ "xemacs"
"temacs")
(kill-emacs))
diff -r fbd1485af104 -r 5efbd1253905 lisp/packages.el
--- a/lisp/packages.el Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/packages.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -107,7 +107,6 ＠＠
These are the valid immediate directory names of package
directories, directories with higher priority first"
(delq nil `("site-packages"
- ,(when (featurep 'infodock) "infodock-packages")
,(when (featurep 'mule) "mule-packages")
"xemacs-packages")))
diff -r fbd1485af104 -r 5efbd1253905 lisp/simple.el
--- a/lisp/simple.el Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/simple.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -4681,8 +4681,7 ＠＠
(or level (setq level 'warning))
(or (listp class) (setq class (list class)))
(check-argument-type 'warning-level-p level)
- (if (and (not (featurep 'infodock))
- (not init-file-loaded))
+ (if (not init-file-loaded)
(push (list class message level) before-init-deferred-warnings)
(catch 'ignored
(let ((display-p t)
＠＠ -4772,8 +4771,7 ＠＠
(defun emacs-name ()
"Return the printable name of this instance of Emacs."
- (cond ((featurep 'infodock) "InfoDock")
- ((featurep 'xemacs) "XEmacs")
+ (cond ((featurep 'xemacs) "XEmacs")
(t "Emacs")))
(defun debug-print-1 (&rest args)
diff -r fbd1485af104 -r 5efbd1253905 lisp/startup.el
--- a/lisp/startup.el Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/startup.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -722,9 +722,7 ＠＠
(declare-fboundp (init-mule-at-startup)))
(if (featurep 'toolbar)
- (if (featurep 'infodock)
- (require 'id-x-toolbar)
- (init-toolbar)))
+ (init-toolbar))
;; Create the initial device (which may be the already-created stdio
;; device, if we're noninteractive).
diff -r fbd1485af104 -r 5efbd1253905 lisp/toolbar.el
--- a/lisp/toolbar.el Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/toolbar.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -117,7 +117,6 ＠＠
;; called from toolbar.c during device and frame initialization
(defun init-toolbar-from-resources (locale)
(if (and (featurep 'x)
- (not (featurep 'infodock))
(or (eq locale 'global)
(eq 'x (device-or-frame-type locale))))
(declare-fboundp (x-init-toolbar-from-resources locale))))
diff -r fbd1485af104 -r 5efbd1253905 lisp/version.el
--- a/lisp/version.el Sun Jun 06 13:24:31 2010 +0100
+++ b/lisp/version.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -56,9 +56,6 ＠＠
" XEmacs Lucid")
"Version numbers of this version of XEmacs.")
-(if (featurep 'infodock)
- (require 'id-vers))
-
;; Moved to C code as of XEmacs 20.3
;(defconst emacs-major-version
; (progn (or (string-match "^[0-9]+" emacs-version)
＠＠ -95,9 +92,7 ＠＠
(format
"XEmacs %s %s(%s%s) of %s %s on %s"
(substring emacs-version 0 (string-match " XEmacs" emacs-version))
- (if (not (featurep 'infodock))
- "[Lucid] "
- "")
+ "[Lucid] "
system-configuration
(cond ((or (and (fboundp 'featurep)
(featurep 'mule))
diff -r fbd1485af104 -r 5efbd1253905 src/ChangeLog
--- a/src/ChangeLog Sun Jun 06 13:24:31 2010 +0100
+++ b/src/ChangeLog Mon Jun 07 18:42:10 2010 +0100
＠＠ -6,6 +6,17 ＠＠
applicable passes, with the exception that the
ALLOW-OTHER-KEYS-NIL Common Lisp issue (functions with &key must
*always* accept :allow-other-keys nil) hasn't been implemented.
+
+2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lread.c (vars_of_lread):
+ * emacs.c:
+ (shut_down_emacs, vars_of_emacs, complex_vars_of_emacs):
+ * device-x.c (get_device_from_display)
+ (have_xemacs_resources_in_xrdb):
+ * device-gtk.c (Fgtk_init):
+ * config.h.in:
+ Remove all checks for InfoDock.
2010-06-01 Aidan Kehoe <kehoea(a)parhasard.net>
diff -r fbd1485af104 -r 5efbd1253905 src/config.h.in
--- a/src/config.h.in Sun Jun 06 13:24:31 2010 +0100
+++ b/src/config.h.in Mon Jun 07 18:42:10 2010 +0100
＠＠ -114,10 +114,6 ＠＠
#undef XEMACS_CODENAME
#undef XEMACS_EXTRA_NAME
#undef XEMACS_RELEASE_DATE
-/* InfoDock versions, not used with XEmacs */
-#undef INFODOCK_MAJOR_VERSION
-#undef INFODOCK_MINOR_VERSION
-#undef INFODOCK_BUILD_VERSION
/* Make functions from IEEE Stds 1003.[123] available. */
#undef _POSIX_C_SOURCE
diff -r fbd1485af104 -r 5efbd1253905 src/device-gtk.c
--- a/src/device-gtk.c Sun Jun 06 13:24:31 2010 +0100
+++ b/src/device-gtk.c Mon Jun 07 18:42:10 2010 +0100
＠＠ -184,11 +184,7 ＠＠
slow_down_interrupts ();
#ifdef HAVE_GNOME
-#ifdef INFODOCK
- gnome_init ("InfoDock", EMACS_VERSION, argc, argv);
-#else
gnome_init ("XEmacs", EMACS_VERSION, argc, argv);
-#endif /* INFODOCK */
#else
gtk_init (&argc, &argv);
#endif
diff -r fbd1485af104 -r 5efbd1253905 src/device-x.c
--- a/src/device-x.c Sun Jun 06 13:24:31 2010 +0100
+++ b/src/device-x.c Mon Jun 07 18:42:10 2010 +0100
＠＠ -149,13 +149,8 ＠＠
struct device *
get_device_from_display (Display *dpy)
{
+#define FALLBACK_RESOURCE_NAME "xemacs"
struct device *d = get_device_from_display_1 (dpy);
-
-#if !defined(INFODOCK)
-# define FALLBACK_RESOURCE_NAME "xemacs"
-# else
-# define FALLBACK_RESOURCE_NAME "infodock"
-#endif
if (!d)
{
＠＠ -344,11 +339,7 ＠＠
const char *xdefs, *key;
int len;
-#ifdef INFODOCK
- key = "InfoDock";
-#else
key = "XEmacs";
-#endif
len = strlen (key);
if (!dpy)
＠＠ -653,11 +644,7 ＠＠
{
app_class = (NILP (Vx_emacs_application_class) &&
have_xemacs_resources_in_xrdb (dpy))
-#ifdef INFODOCK
- ? "InfoDock"
-#else
? "XEmacs"
-#endif
: "Emacs";
}
else
diff -r fbd1485af104 -r 5efbd1253905 src/emacs.c
--- a/src/emacs.c Sun Jun 06 13:24:31 2010 +0100
+++ b/src/emacs.c Mon Jun 07 18:42:10 2010 +0100
＠＠ -512,11 +512,6 ＠＠
Lisp_Object Vxemacs_codename;
Lisp_Object Vxemacs_extra_name;
Lisp_Object Vxemacs_release_date;
-#ifdef INFODOCK
-Lisp_Object Vinfodock_major_version;
-Lisp_Object Vinfodock_minor_version;
-Lisp_Object Vinfodock_build_version;
-#endif
/* The path under which XEmacs was invoked. */
Lisp_Object Vinvocation_path;
＠＠ -3636,15 +3631,9 ＠＠
"Your version of XEmacs was distributed with a PROBLEMS file that may describe\n"
"your crash, and with luck a workaround. Please check it first, but do report\n"
"the crash anyway.\n\n"
-#ifdef INFODOCK
-"Please report this bug by selecting `Report-Bug' in the InfoDock menu, or\n"
-"(last resort) by emailing `xemacs-beta(a)xemacs.org' -- note that this is for\n"
-"XEmacs in general, not just Infodock."
-#else
"Please report this bug by invoking M-x report-emacs-bug, or by selecting\n"
"`Send Bug Report' from the Help menu. If that won't work, send ordinary\n"
"email to `xemacs-beta(a)xemacs.org'."
-#endif
" *MAKE SURE* to include this entire\n"
"output from this crash, especially including the Lisp backtrace, as well as\n"
"the XEmacs configuration from M-x describe-installation (or equivalently,\n"
＠＠ -4343,22 +4332,6 ＠＠
Vemacs_beta_version = Qnil;
#endif
-#ifdef INFODOCK
- DEFVAR_LISP ("infodock-major-version", &Vinfodock_major_version /*
-Major version number of this InfoDock release.
-*/ );
- Vinfodock_major_version = make_int (INFODOCK_MAJOR_VERSION);
-
- DEFVAR_LISP ("infodock-minor-version", &Vinfodock_minor_version /*
-Minor version number of this InfoDock release.
-*/ );
- Vinfodock_minor_version = make_int (INFODOCK_MINOR_VERSION);
-
- DEFVAR_LISP ("infodock-build-version", &Vinfodock_build_version /*
-Build version of this InfoDock release.
-*/ );
- Vinfodock_build_version = make_int (INFODOCK_BUILD_VERSION);
-#endif
DEFVAR_LISP ("xemacs-codename", &Vxemacs_codename /*
Codename of this version of Emacs (a string).
＠＠ -4557,7 +4530,6 ＠＠
DEFVAR_LISP ("emacs-program-name", &Vemacs_program_name /*
*Name of the Emacs variant.
-For example, this may be \"xemacs\" or \"infodock\".
This is mainly meant for use in path searching.
*/ );
Vemacs_program_name = build_extstring (PATH_PROGNAME, Qfile_name);
diff -r fbd1485af104 -r 5efbd1253905 src/lread.c
--- a/src/lread.c Sun Jun 06 13:24:31 2010 +0100
+++ b/src/lread.c Mon Jun 07 18:42:10 2010 +0100
＠＠ -3460,9 +3460,6 ＠＠
#ifdef FEATUREP_SYNTAX
DEFSYMBOL (Qfeaturep);
Fprovide (intern ("xemacs"));
-#ifdef INFODOCK
- Fprovide (intern ("infodock"));
-#endif /* INFODOCK */
#endif /* FEATUREP_SYNTAX */
#ifdef LISP_BACKQUOTES
diff -r fbd1485af104 -r 5efbd1253905 tests/ChangeLog
--- a/tests/ChangeLog Sun Jun 06 13:24:31 2010 +0100
+++ b/tests/ChangeLog Mon Jun 07 18:42:10 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * gtk/gtk-test.el (gtk-test):
+ Remove a conditional for InfoDock.
+
2010-04-05 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/hash-table-tests.el:
diff -r fbd1485af104 -r 5efbd1253905 tests/gtk/gtk-test.el
--- a/tests/gtk/gtk-test.el Sun Jun 06 13:24:31 2010 +0100
+++ b/tests/gtk/gtk-test.el Mon Jun 07 18:42:10 2010 +0100
＠＠ -1976,7 +1976,7 ＠＠
close-button (gtk-button-new-with-label "Quit"))
(gtk-window-set-title window
(format "%s/GTK %d.%d.%d"
- (if (featurep 'infodock) "InfoDock" "XEmacs")
+ "XEmacs"
emacs-major-version emacs-minor-version
(or emacs-patch-level emacs-beta-version)))
diff -r fbd1485af104 -r 5efbd1253905 version.sh.in
--- a/version.sh.in Sun Jun 06 13:24:31 2010 +0100
+++ b/version.sh.in Mon Jun 07 18:42:10 2010 +0100
＠＠ -5,8 +5,5 ＠＠
emacs_beta_version=29
xemacs_codename="garbanzo"
emacs_kit_version=
-infodock_major_version=4
-infodock_minor_version=0
-infodock_build_version=8
xemacs_release_date="2009-05-18"
xemacs_extra_name=
\ No newline at end of file
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments
carbon2-commit: Move #'reduce to fns.c from cl-seq.el.
14 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5283:fbd1485af104
parent: 5280:7789ae555c45
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Jun 06 13:24:31 2010 +0100
files: lisp/ChangeLog lisp/cl-seq.el src/ChangeLog src/fns.c
description:
Move #'reduce to fns.c from cl-seq.el.
src/ChangeLog addition:
2010-06-06 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Freduce):
Move this here from cl-seq.el, avoiding the need to cons. This
has been tested using Paul Dietz' test suite, and …
[View More]everything
applicable passes, with the exception that the
ALLOW-OTHER-KEYS-NIL Common Lisp issue (functions with &key must
*always* accept :allow-other-keys nil) hasn't been implemented.
lisp/ChangeLog addition:
2010-06-06 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-seq.el (reduce):
Move this to fns.c.
diff -r 7789ae555c45 -r fbd1485af104 lisp/ChangeLog
--- a/lisp/ChangeLog Wed Jun 02 16:18:50 2010 +0100
+++ b/lisp/ChangeLog Sun Jun 06 13:24:31 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-06-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-seq.el (reduce):
+ Move this to fns.c.
+
2010-06-02 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (complement):
diff -r 7789ae555c45 -r fbd1485af104 lisp/cl-seq.el
--- a/lisp/cl-seq.el Wed Jun 02 16:18:50 2010 +0100
+++ b/lisp/cl-seq.el Sun Jun 06 13:24:31 2010 +0100
＠＠ -141,36 +141,6 ＠＠
(defvar cl-test) (defvar cl-test-not)
(defvar cl-if) (defvar cl-if-not)
(defvar cl-key)
-
-
-(defun reduce (cl-func cl-seq &rest cl-keys)
- "Combine the elements of sequence using FUNCTION, a binary operation.
-For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
-SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
-in SEQUENCE.
-Keywords supported: :start :end :from-end :initial-value :key
-See `remove*' for the meaning of :start, :end, :from-end and :key.
-:initial-value specifies an element (typically an identity element, such as 0)
-that is conceptually prepended to the sequence (or appended, when :from-end
-is given).
-If the sequence has one element, that element is returned directly.
-If the sequence has no elements, :initial-value is returned if given;
-otherwise, FUNCTION is called with no arguments, and its result returned."
- (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
- (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
- (setq cl-seq (subseq cl-seq cl-start cl-end))
- (if cl-from-end (setq cl-seq (nreverse cl-seq)))
- (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
- (cl-seq (cl-check-key (pop cl-seq)))
- (t (funcall cl-func)))))
- (if cl-from-end
- (while cl-seq
- (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
- cl-accum)))
- (while cl-seq
- (setq cl-accum (funcall cl-func cl-accum
- (cl-check-key (pop cl-seq))))))
- cl-accum)))
(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
"Replace the elements of SEQ1 with the elements of SEQ2.
diff -r 7789ae555c45 -r fbd1485af104 src/ChangeLog
--- a/src/ChangeLog Wed Jun 02 16:18:50 2010 +0100
+++ b/src/ChangeLog Sun Jun 06 13:24:31 2010 +0100
＠＠ -1,3 +1,12 ＠＠
+2010-06-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Freduce):
+ Move this here from cl-seq.el, avoiding the need to cons. This
+ has been tested using Paul Dietz' test suite, and everything
+ applicable passes, with the exception that the
+ ALLOW-OTHER-KEYS-NIL Common Lisp issue (functions with &key must
+ *always* accept :allow-other-keys nil) hasn't been implemented.
+
2010-06-01 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsubstring_no_properties):
diff -r 7789ae555c45 -r fbd1485af104 src/fns.c
--- a/src/fns.c Wed Jun 02 16:18:50 2010 +0100
+++ b/src/fns.c Sun Jun 06 13:24:31 2010 +0100
＠＠ -56,7 +56,7 ＠＠
Lisp_Object Qstring_lessp, Qsort, Qmerge, Qfill;
Lisp_Object Qidentity;
-Lisp_Object Qvector, Qarray, Qbit_vector, QsortX;
+Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Qreduce, Q_from_end, Q_initial_value;
Lisp_Object Qbase64_conversion_error;
＠＠ -2432,22 +2432,17 ＠＠
/* This macro might eventually find a better home than here. */
-#define CHECK_KEY_ARGUMENT(key, c_predicate) \
+#define CHECK_KEY_ARGUMENT(key) \
do { \
if (NILP (key)) \
{ \
key = Qidentity; \
} \
- \
- if (EQ (key, Qidentity)) \
- { \
- c_predicate = c_merge_predicate_nokey; \
- } \
- else \
- { \
- key = indirect_function (key, 1); \
- c_predicate = c_merge_predicate_key; \
- } \
+ \
+ if (!EQ (key, Qidentity)) \
+ { \
+ key = indirect_function (key, 1); \
+ } \
} while (0)
DEFUN ("merge", Fmerge, 4, MANY, 0, /*
＠＠ -2473,7 +2468,10 ＠＠
CHECK_SEQUENCE (sequence_one);
CHECK_SEQUENCE (sequence_two);
- CHECK_KEY_ARGUMENT (key, c_predicate);
+ CHECK_KEY_ARGUMENT (key);
+
+ c_predicate = EQ (key, Qidentity) ?
+ c_merge_predicate_nokey : c_merge_predicate_key;
if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two)))
{
＠＠ -2721,7 +2719,10 ＠＠
CHECK_SEQUENCE (sequence);
- CHECK_KEY_ARGUMENT (key, c_predicate);
+ CHECK_KEY_ARGUMENT (key);
+
+ c_predicate = EQ (key, Qidentity) ?
+ c_merge_predicate_nokey : c_merge_predicate_key;
if (LISTP (sequence))
{
＠＠ -4844,6 +4845,353 ＠＠
/* Extra random functions */
+DEFUN ("reduce", Freduce, 2, MANY, 0, /*
+Combine the elements of sequence using FUNCTION, a binary operation.
+
+For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
+SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
+in SEQUENCE.
+
+Keywords supported: :start :end :from-end :initial-value :key
+See `remove*' for the meaning of :start, :end, :from-end and :key.
+
+:initial-value specifies an element (typically an identity element, such as
+0) that is conceptually prepended to the sequence (or appended, when
+:from-end is given).
+
+If the sequence has one element, that element is returned directly.
+If the sequence has no elements, :initial-value is returned if given;
+otherwise, FUNCTION is called with no arguments, and its result returned.
+
+arguments: (FUNCTION SEQUENCE &key (START 0) (END (length SEQUENCE)) FROM-END INITIAL-VALUE (KEY #'identity))
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
+ Elemcount starting, ending = EMACS_INT_MAX, ii = 0;
+
+ PARSE_KEYWORDS (Qreduce, nargs, args, 2, 5,
+ (start, end, from_end, initial_value, key),
+ (start = Qzero, initial_value = Qunbound), 0);
+
+ CHECK_SEQUENCE (sequence);
+ CHECK_NATNUM (start);
+
+ CHECK_KEY_ARGUMENT (key);
+
+#define KEY(key, item) (EQ (key, Qidentity) ? item : call1 (key, item))
+
+ starting = XINT (start);
+ if (!NILP (end))
+ {
+ CHECK_NATNUM (end);
+ ending = XINT (end);
+ }
+
+ if (VECTORP (sequence))
+ {
+ Lisp_Vector *vv = XVECTOR (sequence);
+ ending = min (ending, vv->size);
+
+ if (!UNBOUNDP (initial_value))
+ {
+ accum = initial_value;
+ }
+ else if (ending - starting && starting < ending)
+ {
+ if (NILP (from_end))
+ {
+ accum = KEY (key, vv->contents[starting]);
+ starting++;
+ }
+ else
+ {
+ accum = KEY (key, vv->contents[ending - 1]);
+ ending--;
+ }
+ }
+
+ if (NILP (from_end))
+ {
+ for (ii = starting; ii < ending; ++ii)
+ {
+ accum = call2 (function, accum, KEY (key, vv->contents[ii]));
+ }
+ }
+ else
+ {
+ for (ii = ending - 1; ii >= starting; --ii)
+ {
+ accum = call2 (function, KEY (key, vv->contents[ii]), accum);
+ }
+ }
+ }
+ else if (BIT_VECTORP (sequence))
+ {
+ Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+
+ ending = min (ending, bv->size);
+
+ if (!UNBOUNDP (initial_value))
+ {
+ accum = initial_value;
+ }
+ else if (ending - starting && starting < ending)
+ {
+ if (NILP (from_end))
+ {
+ accum = KEY (key, make_int (bit_vector_bit (bv, starting)));
+ starting++;
+ }
+ else
+ {
+ accum = KEY (key, make_int (bit_vector_bit (bv, ending - 1)));
+ ending--;
+ }
+ }
+
+ if (NILP (from_end))
+ {
+ for (ii = starting; ii < ending; ++ii)
+ {
+ accum = call2 (function, accum,
+ KEY (key, make_int (bit_vector_bit (bv, ii))));
+ }
+ }
+ else
+ {
+ for (ii = ending - 1; ii >= starting; --ii)
+ {
+ accum = call2 (function, KEY (key,
+ make_int (bit_vector_bit (bv,
+ ii))),
+ accum);
+ }
+ }
+
+ }
+ else if (STRINGP (sequence))
+ {
+ if (NILP (from_end))
+ {
+ Bytecount byte_len = XSTRING_LENGTH (sequence);
+ Bytecount cursor_offset = 0;
+ const Ibyte *startp = XSTRING_DATA (sequence);
+ const Ibyte *cursor = startp;
+
+ for (ii = 0; ii != starting && cursor_offset < byte_len; ++ii)
+ {
+ INC_IBYTEPTR (cursor);
+ cursor_offset = cursor - startp;
+ }
+
+ if (!UNBOUNDP (initial_value))
+ {
+ accum = initial_value;
+ }
+ else if (ending - starting && starting < ending)
+ {
+ accum = KEY (key, make_char (itext_ichar (cursor)));
+ starting++;
+ startp = XSTRING_DATA (sequence);
+ cursor = startp + cursor_offset;
+ INC_IBYTEPTR (cursor);
+ cursor_offset = cursor - startp;
+ }
+
+ while (cursor_offset < byte_len && starting < ending)
+ {
+ if (cursor_offset > XSTRING_LENGTH (sequence))
+ {
+ invalid_state ("sequence modified during reduce", sequence);
+ }
+
+ startp = XSTRING_DATA (sequence);
+ cursor = startp + cursor_offset;
+ accum = call2 (function, accum,
+ KEY (key, make_char (itext_ichar (cursor))));
+ INC_IBYTEPTR (cursor);
+ cursor_offset = cursor - startp;
+ ++starting;
+ }
+ }
+ else
+ {
+ Elemcount len = string_char_length (sequence);
+ Bytecount cursor_offset;
+ const Ibyte *cursor;
+
+ ending = min (ending, len);
+ cursor = string_char_addr (sequence, ending - 1);
+ cursor_offset = cursor - XSTRING_DATA (sequence);
+
+ if (!UNBOUNDP (initial_value))
+ {
+ accum = initial_value;
+ }
+ else if (ending - starting && starting < ending)
+ {
+ accum = KEY (key, make_char (itext_ichar (cursor)));
+ ending--;
+ if (ending > 0)
+ {
+ DEC_IBYTEPTR (cursor);
+ cursor_offset = cursor - XSTRING_DATA (sequence);
+ }
+ }
+
+ for (ii = ending - 1; ii >= starting; --ii)
+ {
+ if (cursor_offset > XSTRING_LENGTH (sequence))
+ {
+ invalid_state ("sequence modified during reduce", sequence);
+ }
+
+ cursor = XSTRING_DATA (sequence) + cursor_offset;
+ accum = call2 (function, KEY (key,
+ make_char (itext_ichar (cursor))),
+ accum);
+ if (ii > 1)
+ {
+ cursor = XSTRING_DATA (sequence) + cursor_offset;
+ DEC_IBYTEPTR (cursor);
+ cursor_offset = cursor - XSTRING_DATA (sequence);
+ }
+ }
+ }
+ }
+ else if (LISTP (sequence))
+ {
+ if (NILP (from_end))
+ {
+ if (!UNBOUNDP (initial_value))
+ {
+ accum = initial_value;
+ }
+ else if (ending - starting && starting < ending)
+ {
+ Elemcount counting = 0;
+ EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+ {
+ if (counting == starting)
+ {
+ accum = KEY (key, elt);
+ starting++;
+ break;
+ }
+ ++counting;
+ }
+ }
+
+ if (ending - starting && starting < ending)
+ {
+ Elemcount counting = 0;
+
+ EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+ {
+ if (counting >= starting)
+ {
+ if (counting < ending)
+ {
+ accum = call2 (function, accum, KEY (key, elt));
+ }
+ else if (counting == ending)
+ {
+ break;
+ }
+ }
+ ++counting;
+ }
+ }
+ }
+ else
+ {
+ Boolint need_accum = 0;
+ Lisp_Object *subsequence = NULL;
+ Elemcount counting = 0, len = 0;
+ struct gcpro gcpro1;
+
+ if (ending - starting && starting < ending && EMACS_INT_MAX == ending)
+ {
+ ending = XINT (Flength (sequence));
+ }
+
+ /* :from-end with a list; make an alloca copy of the relevant list
+ data, attempting to go backwards isn't worth the trouble. */
+ if (!UNBOUNDP (initial_value))
+ {
+ accum = initial_value;
+ if (ending - starting && starting < ending)
+ {
+ subsequence = alloca_array (Lisp_Object, ending - starting);
+ }
+ }
+ else if (ending - starting && starting < ending)
+ {
+ subsequence = alloca_array (Lisp_Object, ending - starting);
+ need_accum = 1;
+ }
+
+ if (ending - starting && starting < ending)
+ {
+ EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+ {
+ if (counting >= starting)
+ {
+ if (counting < ending)
+ {
+ subsequence[ii++] = elt;
+ }
+ else if (counting == ending)
+ {
+ break;
+ }
+ }
+ ++counting;
+ }
+ }
+
+ if (subsequence != NULL)
+ {
+ len = ending - starting;
+ /* If we could be sure that neither FUNCTION nor KEY modify
+ SEQUENCE, this wouldn't be necessary, since all the
+ elements of SUBSEQUENCE would definitely always be
+ reachable via SEQUENCE. */
+ GCPRO1 (subsequence[0]);
+ gcpro1.nvars = len;
+ }
+
+ if (need_accum)
+ {
+ accum = KEY (key, subsequence[len - 1]);
+ --len;
+ }
+
+ for (ii = len; ii != 0;)
+ {
+ --ii;
+ accum = call2 (function, KEY (key, subsequence[ii]), accum);
+ }
+
+ if (subsequence != NULL)
+ {
+ UNGCPRO;
+ }
+ }
+ }
+
+ /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we
+ need to return the result of calling FUNCTION with zero
+ arguments. */
+ if (UNBOUNDP (accum))
+ {
+ accum = call0 (function);
+ }
+
+ return accum;
+}
+
DEFUN ("replace-list", Freplace_list, 2, 2, 0, /*
Destructively replace the list OLD with NEW.
This is like (copy-sequence NEW) except that it reuses the
＠＠ -5528,6 +5876,10 ＠＠
DEFSYMBOL (Qlist);
DEFSYMBOL (Qbit_vector);
defsymbol (&QsortX, "sort*");
+ DEFSYMBOL (Qreduce);
+
+ DEFKEYWORD (Q_from_end);
+ DEFKEYWORD (Q_initial_value);
DEFSYMBOL (Qyes_or_no_p);
＠＠ -5624,6 +5976,7 ＠＠
DEFSUBR (Fmapl);
DEFSUBR (Fmapcon);
+ DEFSUBR (Freduce);
DEFSUBR (Freplace_list);
DEFSUBR (Fload_average);
DEFSUBR (Ffeaturep);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments
[COMMIT] Accept sequences generally, not just lists, #'reverse, #'nreverse.
14 years, 5 months
Aidan Kehoe
Aidan Kehoe
This is something that came up with work I’m doing to get various others of
Paul Dietz’ tests working, and it’s a reasonable change generally. Common
Lisp specifies that both functions take sequences, not just lists.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289078332 0
# Node ID 9f738305f80fcb8039f61664f197f87be61a8960
# Parent 28651c24b3f8db171de88a939777895c737612e8
Accept sequences generally, not …
[View More]just lists, #'reverse, #'nreverse.
src/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is
not a cons in this function.
(Fnreverse, Freverse):
Accept sequences, not just lists, in these functions.
man/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/lists.texi (Rearrangement, Building Lists):
Document that #'nreverse and #'reverse now accept sequences, not
just lists, in this file.
tests/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list-nreverse):
Check that #'reverse and #'nreverse handle non-list sequences
properly.
diff -r 28651c24b3f8 -r 9f738305f80f man/ChangeLog
--- a/man/ChangeLog Sat Nov 06 14:51:13 2010 +0000
+++ b/man/ChangeLog Sat Nov 06 21:18:52 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lispref/lists.texi (Rearrangement, Building Lists):
+ Document that #'nreverse and #'reverse now accept sequences, not
+ just lists, in this file.
+
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/os.texi (Time Conversion):
diff -r 28651c24b3f8 -r 9f738305f80f man/lispref/lists.texi
--- a/man/lispref/lists.texi Sat Nov 06 14:51:13 2010 +0000
+++ b/man/lispref/lists.texi Sat Nov 06 21:18:52 2010 +0000
＠＠ -655,9 +655,9 ＠＠
(＠pxref{String Conversion}).
＠end defun
-＠defun reverse list
-This function creates a new list whose elements are the elements of
-＠var{list}, but in reverse order. The original argument ＠var{list} is
+＠defun reverse sequence
+This function creates a new sequence whose elements are the elements of
+＠var{sequence}, but in reverse order. The original argument ＠var{sequence} is
＠emph{not} altered.
＠example
＠＠ -998,13 +998,14 ＠＠
＠end smallexample
＠end defun
-＠defun nreverse list
+＠defun nreverse sequence
＠cindex reversing a list
- This function reverses the order of the elements of ＠var{list}.
-Unlike ＠code{reverse}, ＠code{nreverse} alters its argument by reversing
-the ＠sc{cdr}s in the cons cells forming the list. The cons cell that
-used to be the last one in ＠var{list} becomes the first cell of the
-value.
+＠cindex reversing a sequence
+ This function reverses the order of the elements of ＠var{sequence}.
+Unlike ＠code{reverse}, ＠code{nreverse} alters its argument. If
+＠var{sequence} is a list, it does this by reversing the ＠sc{cdr}s in the
+cons cells forming the sequence. The cons cell that used to be the last
+one in ＠var{sequence} becomes the first cell of the value.
For example:
＠＠ -1027,7 +1028,7 ＠＠
＠end example
To avoid confusion, we usually store the result of ＠code{nreverse}
-back in the same variable which held the original list:
+back in the same variable which held the original sequence:
＠example
(setq x (nreverse x))
diff -r 28651c24b3f8 -r 9f738305f80f src/ChangeLog
--- a/src/ChangeLog Sat Nov 06 14:51:13 2010 +0000
+++ b/src/ChangeLog Sat Nov 06 21:18:52 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is
+ not a cons in this function.
+ (Fnreverse, Freverse):
+ Accept sequences, not just lists, in these functions.
+
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Flist_length): Error if LIST is dotted in this function;
diff -r 28651c24b3f8 -r 9f738305f80f src/bytecode.c
--- a/src/bytecode.c Sat Nov 06 14:51:13 2010 +0000
+++ b/src/bytecode.c Sat Nov 06 21:18:52 2010 +0000
＠＠ -251,21 +251,28 ＠＠
}
static Lisp_Object
-bytecode_nreverse (Lisp_Object list)
+bytecode_nreverse (Lisp_Object sequence)
{
- REGISTER Lisp_Object prev = Qnil;
- REGISTER Lisp_Object tail = list;
+ if (LISTP (sequence))
+ {
+ REGISTER Lisp_Object prev = Qnil;
+ REGISTER Lisp_Object tail = sequence;
- while (!NILP (tail))
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object next;
+ CHECK_CONS (tail);
+ next = XCDR (tail);
+ XCDR (tail) = prev;
+ prev = tail;
+ tail = next;
+ }
+ return prev;
+ }
+ else
{
- REGISTER Lisp_Object next;
- CHECK_CONS (tail);
- next = XCDR (tail);
- XCDR (tail) = prev;
- prev = tail;
- tail = next;
+ return Fnreverse (sequence);
}
- return prev;
}
diff -r 28651c24b3f8 -r 9f738305f80f src/fns.c
--- a/src/fns.c Sat Nov 06 14:51:13 2010 +0000
+++ b/src/fns.c Sat Nov 06 21:18:52 2010 +0000
＠＠ -2092,43 +2092,161 ＠＠
}
DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
-Reverse LIST by destructively modifying cdr pointers.
-Return the beginning of the reversed list.
-Also see: `reverse'.
-*/
- (list))
-{
- struct gcpro gcpro1, gcpro2;
- Lisp_Object prev = Qnil;
- Lisp_Object tail = list;
-
- /* We gcpro our args; see `nconc' */
- GCPRO2 (prev, tail);
- while (!NILP (tail))
- {
- REGISTER Lisp_Object next;
- CONCHECK_CONS (tail);
- next = XCDR (tail);
- XCDR (tail) = prev;
- prev = tail;
- tail = next;
- }
- UNGCPRO;
- return prev;
+Reverse SEQUENCE, destructively.
+
+Return the beginning of the reversed sequence, which will be a distinct Lisp
+object if SEQUENCE is a list with length greater than one. See also
+`reverse', the non-destructive version of this function.
+*/
+ (sequence))
+{
+ CHECK_SEQUENCE (sequence);
+
+ if (CONSP (sequence))
+ {
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object prev = Qnil;
+ Lisp_Object tail = sequence;
+
+ /* We gcpro our args; see `nconc' */
+ GCPRO2 (prev, tail);
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object next;
+ CONCHECK_CONS (tail);
+ next = XCDR (tail);
+ XCDR (tail) = prev;
+ prev = tail;
+ tail = next;
+ }
+ UNGCPRO;
+ return prev;
+ }
+ else if (VECTORP (sequence))
+ {
+ Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
+ Elemcount half = length / 2;
+ Lisp_Object swap = Qnil;
+
+ while (ii > half)
+ {
+ swap = XVECTOR_DATA (sequence) [length - ii];
+ XVECTOR_DATA (sequence) [length - ii]
+ = XVECTOR_DATA (sequence) [ii - 1];
+ XVECTOR_DATA (sequence) [ii - 1] = swap;
+ --ii;
+ }
+ }
+ else if (STRINGP (sequence))
+ {
+ Elemcount length = XSTRING_LENGTH (sequence);
+ Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
+ Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+
+ while (cursor < endp)
+ {
+ staging_end -= itext_ichar_len (cursor);
+ itext_copy_ichar (cursor, staging_end);
+ INC_IBYTEPTR (cursor);
+ }
+
+ assert (staging == staging_end);
+
+ memcpy (XSTRING_DATA (sequence), staging, length);
+ init_string_ascii_begin (sequence);
+ bump_string_modiff (sequence);
+ sledgehammer_check_ascii_begin (sequence);
+ }
+ else if (BIT_VECTORP (sequence))
+ {
+ Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+ Elemcount length = bit_vector_length (bv), ii = length;
+ Elemcount half = length / 2;
+ int swap = 0;
+
+ while (ii > half)
+ {
+ swap = bit_vector_bit (bv, length - ii);
+ set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
+ set_bit_vector_bit (bv, ii - 1, swap);
+ --ii;
+ }
+ }
+ else
+ {
+ assert (NILP (sequence));
+ }
+
+ return sequence;
}
DEFUN ("reverse", Freverse, 1, 1, 0, /*
-Reverse LIST, copying. Return the beginning of the reversed list.
+Reverse SEQUENCE, copying. Return the reversed sequence.
See also the function `nreverse', which is used more often.
*/
- (list))
-{
- Lisp_Object reversed_list = Qnil;
- EXTERNAL_LIST_LOOP_2 (elt, list)
- {
- reversed_list = Fcons (elt, reversed_list);
- }
- return reversed_list;
+ (sequence))
+{
+ Lisp_Object result = Qnil;
+
+ CHECK_SEQUENCE (sequence);
+
+ if (CONSP (sequence))
+ {
+ EXTERNAL_LIST_LOOP_2 (elt, sequence)
+ {
+ result = Fcons (elt, result);
+ }
+ }
+ else if (VECTORP (sequence))
+ {
+ Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
+ Lisp_Object *staging = alloca_array (Lisp_Object, length);
+
+ while (ii > 0)
+ {
+ staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1];
+ --ii;
+ }
+
+ result = Fvector (length, staging);
+ }
+ else if (STRINGP (sequence))
+ {
+ Elemcount length = XSTRING_LENGTH (sequence);
+ Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
+ Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+
+ while (cursor < endp)
+ {
+ staging_end -= itext_ichar_len (cursor);
+ itext_copy_ichar (cursor, staging_end);
+ INC_IBYTEPTR (cursor);
+ }
+
+ assert (staging == staging_end);
+
+ result = make_string (staging, length);
+ }
+ else if (BIT_VECTORP (sequence))
+ {
+ Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res;
+ Elemcount length = bit_vector_length (bv), ii = length;
+
+ result = make_bit_vector (length, Qzero);
+ res = XBIT_VECTOR (result);
+
+ while (ii > 0)
+ {
+ set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1));
+ --ii;
+ }
+ }
+ else
+ {
+ assert (NILP (sequence));
+ }
+
+ return result;
}
static Lisp_Object
diff -r 28651c24b3f8 -r 9f738305f80f tests/ChangeLog
--- a/tests/ChangeLog Sat Nov 06 14:51:13 2010 +0000
+++ b/tests/ChangeLog Sat Nov 06 21:18:52 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (list-nreverse):
+ Check that #'reverse and #'nreverse handle non-list sequences
+ properly.
+
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (malformed-list): Check that #'mapcar,
diff -r 28651c24b3f8 -r 9f738305f80f tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sat Nov 06 14:51:13 2010 +0000
+++ b/tests/automated/lisp-tests.el Sat Nov 06 21:18:52 2010 +0000
＠＠ -2484,4 +2484,31 ＠＠
(Assert (equal expected (merge 'list list '(1) #'<))
"checking merge's circularity checks are sane"))
+(flet ((list-nreverse (list)
+ (do ((list1 list (cdr list1))
+ (list2 nil (prog1 list1 (setcdr list1 list2))))
+ ((atom list1) list2))))
+ (let* ((integers (loop for i from 0 to 6000 collect i))
+ (characters (mapcan #'(lambda (integer)
+ (if (char-int-p integer)
+ (list (int-char integer)))) integers))
+ (fourth-bit #'(lambda (integer) (ash (logand #x10 integer) -4)))
+ (bits (mapcar fourth-bit integers))
+ (vector (vconcat integers))
+ (string (concat characters))
+ (bit-vector (bvconcat bits)))
+ (Assert (equal (reverse vector)
+ (vconcat (list-nreverse (copy-list integers)))))
+ (Assert (eq vector (nreverse vector)))
+ (Assert (equal vector (vconcat (list-nreverse (copy-list integers)))))
+ (Assert (equal (reverse string)
+ (concat (list-nreverse (copy-list characters)))))
+ (Assert (eq string (nreverse string)))
+ (Assert (equal string (concat (list-nreverse (copy-list characters)))))
+ (Assert (eq bit-vector (nreverse bit-vector)))
+ (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector))
+ (Assert (not (equal bit-vector
+ (mapcar fourth-bit
+ (loop for i from 0 to 6000 collect i)))))))
+
;;; end of lisp-tests.el
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments
commit: Accept sequences generally, not just lists, #'reverse, #'nreverse.
14 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5300:9f738305f80f
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Nov 06 21:18:52 2010 +0000
files: man/ChangeLog man/lispref/lists.texi src/ChangeLog src/bytecode.c src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
description:
Accept sequences generally, not just lists, #'reverse, #'nreverse.
src/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (bytecode_nreverse): Call Fnreverse() …
[View More]if SEQUENCE is
not a cons in this function.
(Fnreverse, Freverse):
Accept sequences, not just lists, in these functions.
man/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/lists.texi (Rearrangement, Building Lists):
Document that #'nreverse and #'reverse now accept sequences, not
just lists, in this file.
tests/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list-nreverse):
Check that #'reverse and #'nreverse handle non-list sequences
properly.
diff -r 28651c24b3f8 -r 9f738305f80f man/ChangeLog
--- a/man/ChangeLog Sat Nov 06 14:51:13 2010 +0000
+++ b/man/ChangeLog Sat Nov 06 21:18:52 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lispref/lists.texi (Rearrangement, Building Lists):
+ Document that #'nreverse and #'reverse now accept sequences, not
+ just lists, in this file.
+
2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/os.texi (Time Conversion):
diff -r 28651c24b3f8 -r 9f738305f80f man/lispref/lists.texi
--- a/man/lispref/lists.texi Sat Nov 06 14:51:13 2010 +0000
+++ b/man/lispref/lists.texi Sat Nov 06 21:18:52 2010 +0000
＠＠ -655,9 +655,9 ＠＠
(＠pxref{String Conversion}).
＠end defun
-＠defun reverse list
-This function creates a new list whose elements are the elements of
-＠var{list}, but in reverse order. The original argument ＠var{list} is
+＠defun reverse sequence
+This function creates a new sequence whose elements are the elements of
+＠var{sequence}, but in reverse order. The original argument ＠var{sequence} is
＠emph{not} altered.
＠example
＠＠ -998,13 +998,14 ＠＠
＠end smallexample
＠end defun
-＠defun nreverse list
+＠defun nreverse sequence
＠cindex reversing a list
- This function reverses the order of the elements of ＠var{list}.
-Unlike ＠code{reverse}, ＠code{nreverse} alters its argument by reversing
-the ＠sc{cdr}s in the cons cells forming the list. The cons cell that
-used to be the last one in ＠var{list} becomes the first cell of the
-value.
+＠cindex reversing a sequence
+ This function reverses the order of the elements of ＠var{sequence}.
+Unlike ＠code{reverse}, ＠code{nreverse} alters its argument. If
+＠var{sequence} is a list, it does this by reversing the ＠sc{cdr}s in the
+cons cells forming the sequence. The cons cell that used to be the last
+one in ＠var{sequence} becomes the first cell of the value.
For example:
＠＠ -1027,7 +1028,7 ＠＠
＠end example
To avoid confusion, we usually store the result of ＠code{nreverse}
-back in the same variable which held the original list:
+back in the same variable which held the original sequence:
＠example
(setq x (nreverse x))
diff -r 28651c24b3f8 -r 9f738305f80f src/ChangeLog
--- a/src/ChangeLog Sat Nov 06 14:51:13 2010 +0000
+++ b/src/ChangeLog Sat Nov 06 21:18:52 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is
+ not a cons in this function.
+ (Fnreverse, Freverse):
+ Accept sequences, not just lists, in these functions.
+
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Flist_length): Error if LIST is dotted in this function;
diff -r 28651c24b3f8 -r 9f738305f80f src/bytecode.c
--- a/src/bytecode.c Sat Nov 06 14:51:13 2010 +0000
+++ b/src/bytecode.c Sat Nov 06 21:18:52 2010 +0000
＠＠ -251,21 +251,28 ＠＠
}
static Lisp_Object
-bytecode_nreverse (Lisp_Object list)
+bytecode_nreverse (Lisp_Object sequence)
{
- REGISTER Lisp_Object prev = Qnil;
- REGISTER Lisp_Object tail = list;
+ if (LISTP (sequence))
+ {
+ REGISTER Lisp_Object prev = Qnil;
+ REGISTER Lisp_Object tail = sequence;
- while (!NILP (tail))
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object next;
+ CHECK_CONS (tail);
+ next = XCDR (tail);
+ XCDR (tail) = prev;
+ prev = tail;
+ tail = next;
+ }
+ return prev;
+ }
+ else
{
- REGISTER Lisp_Object next;
- CHECK_CONS (tail);
- next = XCDR (tail);
- XCDR (tail) = prev;
- prev = tail;
- tail = next;
+ return Fnreverse (sequence);
}
- return prev;
}
diff -r 28651c24b3f8 -r 9f738305f80f src/fns.c
--- a/src/fns.c Sat Nov 06 14:51:13 2010 +0000
+++ b/src/fns.c Sat Nov 06 21:18:52 2010 +0000
＠＠ -2092,43 +2092,161 ＠＠
}
DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
-Reverse LIST by destructively modifying cdr pointers.
-Return the beginning of the reversed list.
-Also see: `reverse'.
-*/
- (list))
-{
- struct gcpro gcpro1, gcpro2;
- Lisp_Object prev = Qnil;
- Lisp_Object tail = list;
-
- /* We gcpro our args; see `nconc' */
- GCPRO2 (prev, tail);
- while (!NILP (tail))
- {
- REGISTER Lisp_Object next;
- CONCHECK_CONS (tail);
- next = XCDR (tail);
- XCDR (tail) = prev;
- prev = tail;
- tail = next;
- }
- UNGCPRO;
- return prev;
+Reverse SEQUENCE, destructively.
+
+Return the beginning of the reversed sequence, which will be a distinct Lisp
+object if SEQUENCE is a list with length greater than one. See also
+`reverse', the non-destructive version of this function.
+*/
+ (sequence))
+{
+ CHECK_SEQUENCE (sequence);
+
+ if (CONSP (sequence))
+ {
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object prev = Qnil;
+ Lisp_Object tail = sequence;
+
+ /* We gcpro our args; see `nconc' */
+ GCPRO2 (prev, tail);
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object next;
+ CONCHECK_CONS (tail);
+ next = XCDR (tail);
+ XCDR (tail) = prev;
+ prev = tail;
+ tail = next;
+ }
+ UNGCPRO;
+ return prev;
+ }
+ else if (VECTORP (sequence))
+ {
+ Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
+ Elemcount half = length / 2;
+ Lisp_Object swap = Qnil;
+
+ while (ii > half)
+ {
+ swap = XVECTOR_DATA (sequence) [length - ii];
+ XVECTOR_DATA (sequence) [length - ii]
+ = XVECTOR_DATA (sequence) [ii - 1];
+ XVECTOR_DATA (sequence) [ii - 1] = swap;
+ --ii;
+ }
+ }
+ else if (STRINGP (sequence))
+ {
+ Elemcount length = XSTRING_LENGTH (sequence);
+ Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
+ Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+
+ while (cursor < endp)
+ {
+ staging_end -= itext_ichar_len (cursor);
+ itext_copy_ichar (cursor, staging_end);
+ INC_IBYTEPTR (cursor);
+ }
+
+ assert (staging == staging_end);
+
+ memcpy (XSTRING_DATA (sequence), staging, length);
+ init_string_ascii_begin (sequence);
+ bump_string_modiff (sequence);
+ sledgehammer_check_ascii_begin (sequence);
+ }
+ else if (BIT_VECTORP (sequence))
+ {
+ Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+ Elemcount length = bit_vector_length (bv), ii = length;
+ Elemcount half = length / 2;
+ int swap = 0;
+
+ while (ii > half)
+ {
+ swap = bit_vector_bit (bv, length - ii);
+ set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
+ set_bit_vector_bit (bv, ii - 1, swap);
+ --ii;
+ }
+ }
+ else
+ {
+ assert (NILP (sequence));
+ }
+
+ return sequence;
}
DEFUN ("reverse", Freverse, 1, 1, 0, /*
-Reverse LIST, copying. Return the beginning of the reversed list.
+Reverse SEQUENCE, copying. Return the reversed sequence.
See also the function `nreverse', which is used more often.
*/
- (list))
-{
- Lisp_Object reversed_list = Qnil;
- EXTERNAL_LIST_LOOP_2 (elt, list)
- {
- reversed_list = Fcons (elt, reversed_list);
- }
- return reversed_list;
+ (sequence))
+{
+ Lisp_Object result = Qnil;
+
+ CHECK_SEQUENCE (sequence);
+
+ if (CONSP (sequence))
+ {
+ EXTERNAL_LIST_LOOP_2 (elt, sequence)
+ {
+ result = Fcons (elt, result);
+ }
+ }
+ else if (VECTORP (sequence))
+ {
+ Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
+ Lisp_Object *staging = alloca_array (Lisp_Object, length);
+
+ while (ii > 0)
+ {
+ staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1];
+ --ii;
+ }
+
+ result = Fvector (length, staging);
+ }
+ else if (STRINGP (sequence))
+ {
+ Elemcount length = XSTRING_LENGTH (sequence);
+ Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
+ Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+
+ while (cursor < endp)
+ {
+ staging_end -= itext_ichar_len (cursor);
+ itext_copy_ichar (cursor, staging_end);
+ INC_IBYTEPTR (cursor);
+ }
+
+ assert (staging == staging_end);
+
+ result = make_string (staging, length);
+ }
+ else if (BIT_VECTORP (sequence))
+ {
+ Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res;
+ Elemcount length = bit_vector_length (bv), ii = length;
+
+ result = make_bit_vector (length, Qzero);
+ res = XBIT_VECTOR (result);
+
+ while (ii > 0)
+ {
+ set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1));
+ --ii;
+ }
+ }
+ else
+ {
+ assert (NILP (sequence));
+ }
+
+ return result;
}
static Lisp_Object
diff -r 28651c24b3f8 -r 9f738305f80f tests/ChangeLog
--- a/tests/ChangeLog Sat Nov 06 14:51:13 2010 +0000
+++ b/tests/ChangeLog Sat Nov 06 21:18:52 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (list-nreverse):
+ Check that #'reverse and #'nreverse handle non-list sequences
+ properly.
+
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (malformed-list): Check that #'mapcar,
diff -r 28651c24b3f8 -r 9f738305f80f tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sat Nov 06 14:51:13 2010 +0000
+++ b/tests/automated/lisp-tests.el Sat Nov 06 21:18:52 2010 +0000
＠＠ -2484,4 +2484,31 ＠＠
(Assert (equal expected (merge 'list list '(1) #'<))
"checking merge's circularity checks are sane"))
+(flet ((list-nreverse (list)
+ (do ((list1 list (cdr list1))
+ (list2 nil (prog1 list1 (setcdr list1 list2))))
+ ((atom list1) list2))))
+ (let* ((integers (loop for i from 0 to 6000 collect i))
+ (characters (mapcan #'(lambda (integer)
+ (if (char-int-p integer)
+ (list (int-char integer)))) integers))
+ (fourth-bit #'(lambda (integer) (ash (logand #x10 integer) -4)))
+ (bits (mapcar fourth-bit integers))
+ (vector (vconcat integers))
+ (string (concat characters))
+ (bit-vector (bvconcat bits)))
+ (Assert (equal (reverse vector)
+ (vconcat (list-nreverse (copy-list integers)))))
+ (Assert (eq vector (nreverse vector)))
+ (Assert (equal vector (vconcat (list-nreverse (copy-list integers)))))
+ (Assert (equal (reverse string)
+ (concat (list-nreverse (copy-list characters)))))
+ (Assert (eq string (nreverse string)))
+ (Assert (equal string (concat (list-nreverse (copy-list characters)))))
+ (Assert (eq bit-vector (nreverse bit-vector)))
+ (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector))
+ (Assert (not (equal bit-vector
+ (mapcar fourth-bit
+ (loop for i from 0 to 6000 collect i)))))))
+
;;; end of lisp-tests.el
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments
[COMMIT] Error in #'list-length if LIST is dotted; check for this error with #'mapcar
14 years, 5 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289055073 0
# Node ID 28651c24b3f8db171de88a939777895c737612e8
# Parent 99006e0b3a84c438445d8b177ccc0060663d3700
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
src/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Flist_length): Error if LIST is dotted in this function;
document this behaviour.
…
[View More]
tests/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (malformed-list): Check that #'mapcar,
#'map and #'list-length throw this error when appropriate.
diff -r 99006e0b3a84 -r 28651c24b3f8 src/ChangeLog
--- a/src/ChangeLog Tue Nov 02 20:19:39 2010 +0100
+++ b/src/ChangeLog Sat Nov 06 14:51:13 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Flist_length): Error if LIST is dotted in this function;
+ document this behaviour.
+
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
* specifier.c (specifier_instance_from_inst_list):
diff -r 99006e0b3a84 -r 28651c24b3f8 src/fns.c
--- a/src/fns.c Tue Nov 02 20:19:39 2010 +0100
+++ b/src/fns.c Sat Nov 06 14:51:13 2010 +0000
＠＠ -345,6 +345,7 ＠＠
DEFUN ("list-length", Flist_length, 1, 1, 0, /*
Return the length of LIST. Return nil if LIST is circular.
+Error if LIST is dotted.
*/
(list))
{
＠＠ -359,6 +360,11 ＠＠
tortoise = XCDR (tortoise);
}
+ if (!LISTP (hare))
+ {
+ signal_malformed_list_error (list);
+ }
+
return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len);
}
diff -r 99006e0b3a84 -r 28651c24b3f8 tests/ChangeLog
--- a/tests/ChangeLog Tue Nov 02 20:19:39 2010 +0100
+++ b/tests/ChangeLog Sat Nov 06 14:51:13 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (malformed-list): Check that #'mapcar,
+ #'map and #'list-length throw this error when appropriate.
+
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r 99006e0b3a84 -r 28651c24b3f8 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Tue Nov 02 20:19:39 2010 +0100
+++ b/tests/automated/lisp-tests.el Sat Nov 06 14:51:13 2010 +0000
＠＠ -1040,6 +1040,12 ＠＠
1)
"checking multiple values are correctly discarded in mapcar")
+(let ((malformed-list '(1 2 3 4 hi there . tail)))
+ (Check-Error malformed-list (mapcar #'identity malformed-list))
+ (Check-Error malformed-list (map nil #'eq [1 2 3 4]
+ malformed-list))
+ (Check-Error malformed-list (list-length malformed-list)))
+
;;-----------------------------------------------------
;; Test vector functions
;;-----------------------------------------------------
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments
commit: Error in #'list-length if LIST is dotted; check for this error with #'mapcar
14 years, 5 months
Aidan Kehoe
Aidan Kehoe
changeset: 5299:28651c24b3f8
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Nov 06 14:51:13 2010 +0000
files: src/ChangeLog src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
description:
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
src/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Flist_length): Error if LIST is dotted in this function;
document this behaviour.
…
[View More]tests/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (malformed-list): Check that #'mapcar,
#'map and #'list-length throw this error when appropriate.
diff -r 99006e0b3a84 -r 28651c24b3f8 src/ChangeLog
--- a/src/ChangeLog Tue Nov 02 20:19:39 2010 +0100
+++ b/src/ChangeLog Sat Nov 06 14:51:13 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Flist_length): Error if LIST is dotted in this function;
+ document this behaviour.
+
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
* specifier.c (specifier_instance_from_inst_list):
diff -r 99006e0b3a84 -r 28651c24b3f8 src/fns.c
--- a/src/fns.c Tue Nov 02 20:19:39 2010 +0100
+++ b/src/fns.c Sat Nov 06 14:51:13 2010 +0000
＠＠ -345,6 +345,7 ＠＠
DEFUN ("list-length", Flist_length, 1, 1, 0, /*
Return the length of LIST. Return nil if LIST is circular.
+Error if LIST is dotted.
*/
(list))
{
＠＠ -357,6 +358,11 ＠＠
{
if (len & 1)
tortoise = XCDR (tortoise);
+ }
+
+ if (!LISTP (hare))
+ {
+ signal_malformed_list_error (list);
}
return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len);
diff -r 99006e0b3a84 -r 28651c24b3f8 tests/ChangeLog
--- a/tests/ChangeLog Tue Nov 02 20:19:39 2010 +0100
+++ b/tests/ChangeLog Sat Nov 06 14:51:13 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (malformed-list): Check that #'mapcar,
+ #'map and #'list-length throw this error when appropriate.
+
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r 99006e0b3a84 -r 28651c24b3f8 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Tue Nov 02 20:19:39 2010 +0100
+++ b/tests/automated/lisp-tests.el Sat Nov 06 14:51:13 2010 +0000
＠＠ -1039,6 +1039,12 ＠＠
(car (mapcar #'(lambda (argument) (floor argument)) (list pi e)))))
1)
"checking multiple values are correctly discarded in mapcar")
+
+(let ((malformed-list '(1 2 3 4 hi there . tail)))
+ (Check-Error malformed-list (mapcar #'identity malformed-list))
+ (Check-Error malformed-list (map nil #'eq [1 2 3 4]
+ malformed-list))
+ (Check-Error malformed-list (list-length malformed-list)))
;;-----------------------------------------------------
;; Test vector functions
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments
[COMMIT] Remove netinstall.
14 years, 5 months
The XEmacs Package Smoketest
The XEmacs Package Smoketest
APPROVE COMMIT
Note: This patch has been commited
# HG changeset patch
# User Mats Lidell <matsl(a)xemacs.org>
# Date 1288725579 -3600
# Node ID 99006e0b3a84c438445d8b177ccc0060663d3700
# Parent 552561a8cac0c7a9d4b1064d56dae1c3a5992d52
Remove netinstall.
diff -r 552561a8cac0 -r 99006e0b3a84 ChangeLog
--- a/ChangeLog Mon Nov 01 22:51:35 2010 +0100
+++ b/ChangeLog Tue Nov 02 20:19:39 2010 +0100
＠＠ -1,3 +1,7 ＠＠
+2010-11-02 Mats Lidell <matsl(a)xemacs.org>
+
+ * netinstall: …
[View More]removed
+
2010-06-14 Stephen J. Turnbull <stephen(a)xemacs.org>
* aclocal.m4: Add standard permission boilerplate.
[...lots of deleted lines removed from the patch. It just reflects
that all files are deleted in the netinstall directory...]
Yours
--
%% Mats
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments
commit: Added tag last-version-with-netinstall for changeset d185fa593d5f
14 years, 5 months
The XEmacs Package Smoketest
The XEmacs Package Smoketest
changeset: 5297:552561a8cac0
user: Mats Lidell <matsl(a)xemacs.org>
date: Mon Nov 01 22:51:35 2010 +0100
files: .hgtags
description:
Added tag last-version-with-netinstall for changeset d185fa593d5f
diff -r d185fa593d5f -r 552561a8cac0 .hgtags
--- a/.hgtags Mon Oct 25 17:57:37 2010 +0100
+++ b/.hgtags Mon Nov 01 22:51:35 2010 +0100
＠＠ -239,3 +239,4 ＠＠
1af222c7586991f690ea06d1b8c75fb5a6a0a352 r21-5-28
5c427ece884b7023a244fba8cad8cf41b37dd5ca r21-5-29
…
[View More]3742ea8250b5fd339d6d797835faf8761f61d0ae ben-lisp-object-final-ws-year-2005
+d185fa593d5fcf818ca0d27e53374348d936d7e8 last-version-with-netinstall
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[View Less]
- 1 participants
- 0 comments