commit 6b0d58be9f6caa2fc4125ed98294e1937ee56d2a (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Fri Apr 8 15:33:22 2016 -0700 Minor improvements for hash function primitives * src/fns.c (hashfn_eql): Define in terms of hashfn_equal and hashfn_eq rather than reaching inside them. (hashtest_eq, hashtest_eql, hashtest_equal): Now constants with initializers. (syms_of_fns): Omit no-longer-needed initialization. * src/lisp.h (LISPSYM_INITIALLY): New macro. (DEFINE_LISP_SYMBOL): Use it. diff --git a/src/fns.c b/src/fns.c index da74b9c..617a8e8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3667,8 +3667,6 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) Low-level Functions ***********************************************************************/ -struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; - /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code HASH2 in hash table H using `eql'. Value is true if KEY1 and KEY2 are the same. */ @@ -3709,7 +3707,6 @@ cmpfn_user_defined (struct hash_table_test *ht, return !NILP (call2 (ht->user_cmp_function, key1, key2)); } - /* Value is a hash code for KEY for use in hash table H which uses `eq' to compare keys. The hash code returned is guaranteed to fit in a Lisp integer. */ @@ -3717,34 +3714,27 @@ cmpfn_user_defined (struct hash_table_test *ht, static EMACS_UINT hashfn_eq (struct hash_table_test *ht, Lisp_Object key) { - EMACS_UINT hash = XHASH (key) ^ XTYPE (key); - return hash; + return XHASH (key) ^ XTYPE (key); } /* Value is a hash code for KEY for use in hash table H which uses - `eql' to compare keys. The hash code returned is guaranteed to fit + `equal' to compare keys. The hash code returned is guaranteed to fit in a Lisp integer. */ static EMACS_UINT -hashfn_eql (struct hash_table_test *ht, Lisp_Object key) +hashfn_equal (struct hash_table_test *ht, Lisp_Object key) { - EMACS_UINT hash; - if (FLOATP (key)) - hash = sxhash (key, 0); - else - hash = XHASH (key) ^ XTYPE (key); - return hash; + return sxhash (key, 0); } /* Value is a hash code for KEY for use in hash table H which uses - `equal' to compare keys. The hash code returned is guaranteed to fit + `eql' to compare keys. The hash code returned is guaranteed to fit in a Lisp integer. */ static EMACS_UINT -hashfn_equal (struct hash_table_test *ht, Lisp_Object key) +hashfn_eql (struct hash_table_test *ht, Lisp_Object key) { - EMACS_UINT hash = sxhash (key, 0); - return hash; + return FLOATP (key) ? hashfn_equal (ht, key) : hashfn_eq (ht, key); } /* Value is a hash code for KEY for use in hash table H which uses as @@ -3758,6 +3748,14 @@ hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key) return hashfn_eq (ht, hash); } +struct hash_table_test const + hashtest_eq = { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil), + LISPSYM_INITIALLY (Qnil), 0, hashfn_eq }, + hashtest_eql = { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil), + LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql }, + hashtest_equal = { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qnil), + LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal }; + /* Allocate basically initialized hash table. */ static struct Lisp_Hash_Table * @@ -4448,33 +4446,29 @@ sxhash (Lisp_Object obj, int depth) ***********************************************************************/ DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0, - doc: /* Compute identity hash code for OBJ and return it as integer. -In other words, hash codes of two non-`eq' lists will be (most likely) -different, even if the lists contain the same elements. */) + doc: /* Return an integer hash code for OBJ suitable for `eq'. +If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). */) (Lisp_Object obj) { return make_number (hashfn_eq (NULL, obj)); } DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, - doc: /* Compute identity hash code for OBJ and return it as integer. -In comparison to `sxhash-eq', it is also guaranteed that hash codes -of equal float numbers will be the same, even if the numbers are not -the same Lisp object. */) + doc: /* Return an integer hash code for OBJ suitable for `eql'. +If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)). */) (Lisp_Object obj) { return make_number (hashfn_eql (NULL, obj)); } DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, - doc: /* Compute a hash code for OBJ and return it as integer. */) + doc: /* Return an integer hash code for OBJ suitable for `equal'. +If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)). */) (Lisp_Object obj) { - EMACS_UINT hash = sxhash (obj, 0); - return make_number (hash); + return make_number (hashfn_equal (NULL, obj)); } - DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, doc: /* Create and return a new hash table. @@ -5220,22 +5214,4 @@ this variable. */); defsubr (&Ssecure_hash); defsubr (&Sbuffer_hash); defsubr (&Slocale_info); - - hashtest_eq.name = Qeq; - hashtest_eq.user_hash_function = Qnil; - hashtest_eq.user_cmp_function = Qnil; - hashtest_eq.cmpfn = 0; - hashtest_eq.hashfn = hashfn_eq; - - hashtest_eql.name = Qeql; - hashtest_eql.user_hash_function = Qnil; - hashtest_eql.user_cmp_function = Qnil; - hashtest_eql.cmpfn = cmpfn_eql; - hashtest_eql.hashfn = hashfn_eql; - - hashtest_equal.name = Qequal; - hashtest_equal.user_hash_function = Qnil; - hashtest_equal.user_cmp_function = Qnil; - hashtest_equal.cmpfn = cmpfn_equal; - hashtest_equal.hashfn = hashfn_equal; } diff --git a/src/lisp.h b/src/lisp.h index 170da67..d111a78 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -721,12 +721,16 @@ struct Lisp_Symbol except the former expands to an integer constant expression. */ #define XLI_BUILTIN_LISPSYM(iname) TAG_SYMOFFSET ((iname) * sizeof *lispsym) +/* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is + designed for use as an initializer, even for a constant initializer. */ +#define LISPSYM_INITIALLY(name) LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name)) + /* Declare extern constants for Lisp symbols. These can be helpful when using a debugger like GDB, on older platforms where the debug format does not represent C macros. */ #define DEFINE_LISP_SYMBOL(name) \ DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \ - DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name))) + DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name)) /* By default, define macros for Qt, etc., as this leads to a bit better performance in the core Emacs interpreter. A plugin can @@ -3441,7 +3445,7 @@ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); -extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; +extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal; extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t *, ptrdiff_t *); extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, commit a4aa94d0cdffb45723786aa798174e942d509774 Author: Paul Pogonyshev Date: Fri Apr 8 14:02:48 2016 -0700 New primitives sxhash-eq, sxhash-eql * doc/lispref/hash.texi (Defining Hash), etc/NEWS: Document this. * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Add sxhash-equal, sxhash-eq, sxhash-eql. * lisp/subr.el (sxhash): Now an alias for sxhash-equal. * src/fns.c (Fsxhash_eq, Fsxhash_eql): New functions.n diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 8389c21..4607bb0 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -268,18 +268,43 @@ under the property @code{hash-table-test}; the property value's form is @code{(@var{test-fn} @var{hash-fn})}. @end defun -@defun sxhash obj +@defun sxhash-equal obj This function returns a hash code for Lisp object @var{obj}. This is an integer which reflects the contents of @var{obj} and the other Lisp objects it points to. -If two objects @var{obj1} and @var{obj2} are equal, then @code{(sxhash -@var{obj1})} and @code{(sxhash @var{obj2})} are the same integer. +If two objects @var{obj1} and @var{obj2} are @code{equal}, then +@code{(sxhash-equal @var{obj1})} and @code{(sxhash-equal @var{obj2})} +are the same integer. -If the two objects are not equal, the values returned by @code{sxhash} -are usually different, but not always; once in a rare while, by luck, -you will encounter two distinct-looking objects that give the same -result from @code{sxhash}. +If the two objects are not @code{equal}, the values returned by +@code{sxhash-equal} are usually different, but not always; once in a +rare while, by luck, you will encounter two distinct-looking objects +that give the same result from @code{sxhash-equal}. + +@b{Common Lisp note:} In Common Lisp a similar function is called +@code{sxhash}. Emacs provides this name as a compatibility alias for +@code{sxhash-equal}. +@end defun + +@defun sxhash-eq obj +This function returns a hash code for Lisp object @var{obj}. Its +result reflects identity of @var{obj}, but not its contents. + +If two objects @var{obj1} and @var{obj2} are @code{eq}, then +@code{(xhash @var{obj1})} and @code{(xhash @var{obj2})} are the same +integer. +@end defun + +@defun sxhash-eql obj +This function returns a hash code for Lisp object @var{obj} suitable +for @code{eql} comparison. I.e. it reflects identity of @var{obj} +except for the case where the object is a float number, in which case +hash code is generated for the value. + +If two objects @var{obj1} and @var{obj2} are @code{eql}, then +@code{(xhash @var{obj1})} and @code{(xhash @var{obj2})} are the same +integer. @end defun This example creates a hash table whose keys are strings that are @@ -289,7 +314,7 @@ compared case-insensitively. (defun case-fold-string= (a b) (eq t (compare-strings a nil nil b nil nil t))) (defun case-fold-string-hash (a) - (sxhash (upcase a))) + (sxhash-equal (upcase a))) (define-hash-table-test 'case-fold 'case-fold-string= 'case-fold-string-hash) @@ -302,7 +327,7 @@ predefined test value @code{equal}. The keys can be any Lisp object, and equal-looking objects are considered the same key. @example -(define-hash-table-test 'contents-hash 'equal 'sxhash) +(define-hash-table-test 'contents-hash 'equal 'sxhash-equal) (make-hash-table :test 'contents-hash) @end example diff --git a/etc/NEWS b/etc/NEWS index d38bc3d..6ec82f8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -217,6 +217,17 @@ outermost parenthesis. ** The function 'redirect-debugging-output' now works on platforms other than GNU/Linux. ++++ +** New functions 'sxhash-eq' and 'sxhash-eql' return hash codes of a +Lisp object suitable for use with 'eq' and 'eql' correspondingly. If +two objects are 'eq' ('eql'), then the result of 'sxhash-eq' +('sxhash-eql') on them will be the same. + ++++ +** Function 'sxhash' has been renamed to 'sxhash-equal' for +consistency with the new functions. For compatibility, 'sxhash' +remains as an alias to 'sxhash-equal'. + * Changes in Emacs 25.2 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b3bf4a5..dbaf2bc 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1209,8 +1209,9 @@ radians-to-degrees rassq rassoc read-from-string regexp-quote region-beginning region-end reverse round sin sqrt string string< string= string-equal string-lessp string-to-char - string-to-int string-to-number substring sxhash symbol-function - symbol-name symbol-plist symbol-value string-make-unibyte + string-to-int string-to-number substring + sxhash sxhash-equal sxhash-eq sxhash-eql + symbol-function symbol-name symbol-plist symbol-value string-make-unibyte string-make-multibyte string-as-multibyte string-as-unibyte string-to-multibyte tan truncate diff --git a/lisp/subr.el b/lisp/subr.el index cad6319..a6d6fa4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -66,6 +66,7 @@ For more information, see Info node `(elisp)Declaring Functions'." ;;;; Basic Lisp macros. (defalias 'not 'null) +(defalias 'sxhash 'sxhash-equal) (defmacro noreturn (form) "Evaluate FORM, expecting it not to return. diff --git a/src/fns.c b/src/fns.c index 1ace3bb..da74b9c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4447,8 +4447,26 @@ sxhash (Lisp_Object obj, int depth) Lisp Interface ***********************************************************************/ +DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0, + doc: /* Compute identity hash code for OBJ and return it as integer. +In other words, hash codes of two non-`eq' lists will be (most likely) +different, even if the lists contain the same elements. */) + (Lisp_Object obj) +{ + return make_number (hashfn_eq (NULL, obj)); +} + +DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, + doc: /* Compute identity hash code for OBJ and return it as integer. +In comparison to `sxhash-eq', it is also guaranteed that hash codes +of equal float numbers will be the same, even if the numbers are not +the same Lisp object. */) + (Lisp_Object obj) +{ + return make_number (hashfn_eql (NULL, obj)); +} -DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0, +DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, doc: /* Compute a hash code for OBJ and return it as integer. */) (Lisp_Object obj) { @@ -5066,7 +5084,9 @@ syms_of_fns (void) DEFSYM (Qkey_or_value, "key-or-value"); DEFSYM (Qkey_and_value, "key-and-value"); - defsubr (&Ssxhash); + defsubr (&Ssxhash_eq); + defsubr (&Ssxhash_eql); + defsubr (&Ssxhash_equal); defsubr (&Smake_hash_table); defsubr (&Scopy_hash_table); defsubr (&Shash_table_count); commit b2746dbf562dc4821bc111488b0e5b6ca5fc6061 Author: Eli Zaretskii Date: Fri Apr 8 17:45:16 2016 +0300 Teach Dired support parallel execution of commands on MS-Windows * lisp/dired-aux.el (dired-shell-stuff-it): Support parallel-in-background execution of commands on MS-Windows. Test 'w32-shell-dos-semantics' instead of the underlying OS when determining whether addition of 'wait' is needed. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 52d3f06..aafceea 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -730,22 +730,34 @@ can be produced by `dired-get-marked-files', for example." (command (if sequentially (substring command 0 (match-beginning 0)) command)) - (parallel-in-background (and in-background (not sequentially))) + (parallel-in-background + (and in-background (not sequentially) (not (eq system-type 'ms-dos)))) + (w32-shell (and (fboundp 'w32-shell-dos-semantics) + (w32-shell-dos-semantics))) + ;; The way to run a command in background in Windows shells + ;; is to use the START command. The /B switch means not to + ;; create a new window for the command. + (cmd-prefix (if w32-shell "start /b " "")) + ;; Windows shells don't support chaining with ";", they use + ;; "&" instead. + (cmd-sep (if (and (not w32-shell) (not parallel-in-background)) + ";" + "&")) (stuff-it (if (or (string-match-p dired-star-subst-regexp command) (string-match-p dired-quark-subst-regexp command)) (lambda (x) - (let ((retval command)) + (let ((retval (concat cmd-prefix command))) (while (string-match "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) (setq retval (replace-match x t t retval 2))) retval)) - (lambda (x) (concat command dired-mark-separator x))))) + (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) (concat (cond (on-each (format "%s%s" (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) - (or (and parallel-in-background "&") ";")) + cmd-sep) ;; POSIX shells running a list of commands in the background ;; (LIST = cmd_1 & [cmd_2 & ... cmd_i & ... cmd_N &]) ;; return once cmd_N ends, i.e., the shell does not @@ -754,8 +766,7 @@ can be produced by `dired-get-marked-files', for example." ;; the output of all the commands (Bug#23206). ;; Add 'wait' to force those POSIX shells to wait until ;; all commands finish. - (or (and parallel-in-background - (not (memq system-type '(ms-dos windows-nt))) + (or (and parallel-in-background (not w32-shell) "&wait") ""))) (t commit 102b643a00333ce70fbd7e1cee33de57fff40535 Author: Eli Zaretskii Date: Fri Apr 8 17:09:35 2016 +0300 ; * lisp/dired-aux.el (dired-shell-stuff-it): Minor formatting change. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index bbb5693..52d3f06 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -754,7 +754,9 @@ can be produced by `dired-get-marked-files', for example." ;; the output of all the commands (Bug#23206). ;; Add 'wait' to force those POSIX shells to wait until ;; all commands finish. - (or (and parallel-in-background (not (memq system-type '(ms-dos windows-nt))) "&wait") + (or (and parallel-in-background + (not (memq system-type '(ms-dos windows-nt))) + "&wait") ""))) (t (let ((files (mapconcat 'shell-quote-argument commit c4e6dd15244506bdf7b71559774979db0c7ea286 Author: Tino Calancha Date: Fri Apr 8 17:04:08 2016 +0300 Make 'dired-do-shell-command' wait for all background jobs * lisp/dired-aux.el (dired-shell-stuff-it): Force POSIX shells to wait until all background jobs exit. (Bug#23206). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 990bf6a..bbb5693 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -730,6 +730,7 @@ can be produced by `dired-get-marked-files', for example." (command (if sequentially (substring command 0 (match-beginning 0)) command)) + (parallel-in-background (and in-background (not sequentially))) (stuff-it (if (or (string-match-p dired-star-subst-regexp command) (string-match-p dired-quark-subst-regexp command)) @@ -741,15 +742,27 @@ can be produced by `dired-get-marked-files', for example." retval)) (lambda (x) (concat command dired-mark-separator x))))) (concat - (if on-each - (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) - (if (and in-background (not sequentially)) "&" ";")) - (let ((files (mapconcat 'shell-quote-argument - file-list dired-mark-separator))) - (if (> (length file-list) 1) - (setq files (concat dired-mark-prefix files dired-mark-postfix))) - (funcall stuff-it files))) - (if in-background "&" "")))) + (cond (on-each + (format "%s%s" + (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) + (or (and parallel-in-background "&") ";")) + ;; POSIX shells running a list of commands in the background + ;; (LIST = cmd_1 & [cmd_2 & ... cmd_i & ... cmd_N &]) + ;; return once cmd_N ends, i.e., the shell does not + ;; wait for cmd_i to finish before executing cmd_i+1. + ;; That means, running (shell-command LIST) may not show + ;; the output of all the commands (Bug#23206). + ;; Add 'wait' to force those POSIX shells to wait until + ;; all commands finish. + (or (and parallel-in-background (not (memq system-type '(ms-dos windows-nt))) "&wait") + ""))) + (t + (let ((files (mapconcat 'shell-quote-argument + file-list dired-mark-separator))) + (when (cdr file-list) + (setq files (concat dired-mark-prefix files dired-mark-postfix))) + (funcall stuff-it files)))) + (or (and in-background "&") "")))) ;; This is an extra function so that it can be redefined by ange-ftp. ;;;###autoload