[COMMIT] Move further trivial predicates from data.c to subr.el

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1524689356 -3600 # Wed Apr 25 21:49:16 2018 +0100 # Node ID 06e4b596dc40844bb53645fbf12cffa40d7922a7 # Parent 262dc5a418f5aed7f0284e8d63e39ba6a529166c Move further trivial predicates from data.c to subr.el lisp/ChangeLog addition: 2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net&gt; * subr.el (not): New. * subr.el (null): New. * subr.el (atom): New. * subr.el (listp): New. * subr.el (nlistp): New. * subr.el (bitp): New. * subr.el (zerop): New. * subr.el (true-list-p): New. Move all these functions from C, they're not loop hotspots, they're easily implemented in Lisp, and implementing them in C costs less memory with NEWGC. * bytecomp.el (byte-compile-throw): #'null is no longer in C, don't include its code in byte-compile-checks-on-load. * dumped-lisp.el: * dumped-lisp.el (preloaded-file-list): * loadup.el (gc-cons-threshold): * loadup.el (really-early-error-handler): * loadup.el (fboundp): * make-docfile.el (done): * make-docfile.el (process-args): * make-docfile.el (preloaded-file-list): * make-docfile.el (site-file-list): * packages.el (packages-add-suffix): * packages.el (packages-list-autoloads-path): * update-elc.el: * update-elc.el (preloaded-file-list): * update-elc.el (or): * update-elc.el (featurep): * update-elc.el (do-autoload-commands): Don't use those functions when running a bare-metal XEmacs binary. src/ChangeLog addition: 2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net&gt; * data.c (Fatom, Flistp, Fnlistp, Fbitp, Fzerop, Ftrue_list_p): Move all these functions to Lisp, since they are easily implemented in Lisp, and having them in C necessitates extra space in the dumped executable with NEWGC. * data.c (Flistp): * data.c (syms_of_data): Remove various DEFSUBRs from here. * data.c (Fnonnegativep): Document that this returns t if OBJECT is a nonnegative rational, rather than a number in general. * data.c (Fnumberp): Document that this returns t if OBJECT is a floating point or a rational, rather than just an integer. * data.c: * lisp.h: * tooltalk.c (tooltalk_message_callback): Use Ffunctionp() here rather than re-implementing it. tests/ChangeLog addition: 2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: Test various of the simple predicates just moved to subr.el from data.c. diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/ChangeLog --- a/lisp/ChangeLog Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/ChangeLog Wed Apr 25 21:49:16 2018 +0100 ＠＠ -1,3 +1,37 ＠＠ +2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * subr.el (not): New. + * subr.el (null): New. + * subr.el (atom): New. + * subr.el (listp): New. + * subr.el (nlistp): New. + * subr.el (bitp): New. + * subr.el (zerop): New. + * subr.el (true-list-p): New. + Move all these functions from C, they're not loop hotspots, + they're easily implemented in Lisp, and implementing them in C + costs less memory with NEWGC. + * bytecomp.el (byte-compile-throw): + #'null is no longer in C, don't include its code in + byte-compile-checks-on-load. + * dumped-lisp.el: + * dumped-lisp.el (preloaded-file-list): + * loadup.el (gc-cons-threshold): + * loadup.el (really-early-error-handler): + * loadup.el (fboundp): + * make-docfile.el (done): + * make-docfile.el (process-args): + * make-docfile.el (preloaded-file-list): + * make-docfile.el (site-file-list): + * packages.el (packages-add-suffix): + * packages.el (packages-list-autoloads-path): + * update-elc.el: + * update-elc.el (preloaded-file-list): + * update-elc.el (or): + * update-elc.el (featurep): + * update-elc.el (do-autoload-commands): + Don't use those functions when running a bare-metal XEmacs binary. + 2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net&gt; * make-docfile.el (docfile-out-of-date): diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/bytecomp.el --- a/lisp/bytecomp.el Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/bytecomp.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -4645,7 +4645,7 ＠＠ block)))) (mapc 'byte-compile-form (cdr form)) ;; Push the arguments (byte-compile-out (get (car form) 'byte-opcode) 0) - (pushnew '(null (function-max-args 'throw)) byte-compile-checks-on-load + (pushnew '(eq (function-max-args 'throw) nil) byte-compile-checks-on-load :test #'equal)))  ;;; top-level forms elsewhere diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/dumped-lisp.el --- a/lisp/dumped-lisp.el Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/dumped-lisp.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -318,4 +318,7 ＠＠ )) (setq preloaded-file-list - (mapcan #'(lambda (x) (if (listp x) x (list x))) preloaded-file-list)) + (mapcan #'(lambda (x) (if (or (consp x) (eq x nil)) x (list x))) + preloaded-file-list)) + +;; dumped-lisp.el ends here diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/loadup.el --- a/lisp/loadup.el Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/loadup.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -85,7 +85,7 ＠＠ ;; setting it low makes loadup incredibly fucking slow. ;; no need to do it when not dumping. (if (and purify-flag - (not (memq 'quick-build internal-error-checking))) + (eq (memq 'quick-build internal-error-checking) nil)) 30000 3000000))) ;; really-early-error-handler outputs a stack trace so let's not do it ＠＠ -156,7 +156,7 ＠＠ (external-debugging-output "Fatal error during load, aborting") (kill-emacs 1)) (setq files (cdr files))) - (when (not (featurep 'toolbar)) + (unless (featurep 'toolbar) ;; else still define a few functions. (defun toolbar-button-p (obj) "No toolbar support." nil) (defun toolbar-specifier-p (obj) "No toolbar support." nil)) ＠＠ -289,7 +289,7 ＠＠ ;; this file must be loaded each time Emacs is run. ;; So run the startup code now. -(when (not (fboundp 'dump-emacs)) +(unless (fboundp 'dump-emacs) ;; Avoid loading loadup.el a second time! (setq command-line-args (cdr (cdr command-line-args))) (eval top-level)) diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/make-docfile.el --- a/lisp/make-docfile.el Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/make-docfile.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -58,7 +58,7 ＠＠ ;; First gather up the command line options. (let (done) - (while (and (null done) command-line-args) + (while (and (eq done nil) command-line-args) (let ((arg (car command-line-args))) (cond ((or (string-equal arg "-o") ; Specify DOC file name (string-equal arg "-a") ; Append to DOC file ＠＠ -70,7 +70,7 ＠＠ ((string-equal arg "-i") ; Set site files to scan (setq site-file-list (car (cdr command-line-args)))) (t (setq done t))) - (if (null done) + (if (eq done nil) (setq command-line-args (cdr (cdr command-line-args))))))) (setq options (nreverse options)) ＠＠ -114,8 +114,8 ＠＠ (process-args (read buf))) ;; remove NEEDTODUMP and make-docfile.exe, convert .obj files into ;; .c files in the source directory. - (when (and (not (string-match "\\(NEEDTODUMP\\|\\.exe$\\)" arg)) - (not (member arg processed))) + (when (and (eq (string-match "\\(NEEDTODUMP\\|\\.exe$\\)" arg) nil) + (eq (member arg processed) nil)) (when (string-match "\\(.*\\)\\.obj$" arg) (setq arg (expand-file-name (concatenate ＠＠ -125,7 +125,7 ＠＠ (subseq arg (match-beginning 1) (match-end 1))) ".c") source-src))) - (if (and (null docfile-out-of-date) + (if (and (eq docfile-out-of-date nil) (file-newer-than-file-p arg docfile)) (setq docfile-out-of-date t)) (setq processed (cons arg processed)))) ＠＠ -163,7 +163,7 ＠＠ (setq arg0 (packages-add-suffix (car preloaded-file-list)) arg (locate-library arg0) absolute arg) - (if (null arg) + (if (eq arg nil) (progn (message "Error: dumped file %s does not exist" arg0) ;; Uncomment in case of difficulties ＠＠ -182,9 +182,9 ＠＠ ;; Use relative paths where possible, since this makes file lookup ;; in an installed XEmacs easier: (setq arg arg0)) - (if (null (member arg processed)) + (if (eq (member arg processed) nil) (progn - (if (and (null docfile-out-of-date) + (if (and (eq docfile-out-of-date nil) ;; We need to check the absolute path here: (file-newer-than-file-p absolute docfile)) (setq docfile-out-of-date t)) ＠＠ -197,9 +197,9 ＠＠ (load site-file-list t t) (while site-load-packages (let ((arg (car site-load-packages))) - (if (null (member arg processed)) + (if (eq (member arg processed) nil) (progn - (if (and (null docfile-out-of-date) + (if (and (eq docfile-out-of-date nil) (file-newer-than-file-p arg docfile)) (setq docfile-out-of-date t)) (setq processed (cons arg processed))))) ＠＠ -254,7 +254,7 ＠＠ (write-sequence (buffer-substring nil nil standard-error) 'external-debugging-output) (message "Spawning make-docfile ... %s" - (if (zerop numeric-status) "done" status)) + (if (equal 0 numeric-status) "done" status)) (kill-emacs numeric-status))) (kill-emacs) diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/packages.el --- a/lisp/packages.el Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/packages.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -178,10 +178,10 ＠＠ (message "No library %s in search path" library))) result)) -(defun packages-add-suffix (str) - (if (null (string-match "\\.el\\'" str)) - (concatenate 'string str ".elc") - str)) +(defun packages-add-suffix (string) + (if (string-match-p "\\.el\\'" string) + string + (concatenate 'string string ".elc"))) (defun packages-list-autoloads-path () "List autoloads from precomputed load-path." diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/subr.el --- a/lisp/subr.el Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/subr.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -230,6 +230,40 ＠＠ ;; XEmacs; move these non-basic predicates that can be easily implemented in ;; Lisp from data.c. +(defun null (object) + "Return t if OBJECT is nil." + (eq object nil)) + +(defalias 'not #'null) + +(defun atom (object) + "Return t if OBJECT is not a cons cell. `nil' is not a cons cell. + +See the documentation for `cons' or the Lisp manual for more details on what +a cons cell is." + (not (consp object))) + +(defun listp (object) + "Return t if OBJECT is a list. `nil' is a list. + +A list is either the Lisp object nil (a symbol), interpreted as the empty +list in this context, or a cons cell whose CDR refers to either nil or a +cons cell. + +A \"proper list\" contains no cycles. A \"true list\" is a proper list +which has `nil' as the CDR of its last cons cell. See `true-list-p', an +alternative, more expensive function, if these features are important for +your use case." + (or (consp object) (eq object nil))) + +(defun nlistp (object) + "Return t if OBJECT is not a list. `nil' is a list." + (not (or (consp object) (eq object nil)))) + +(defun bitp (object) + "Return t if OBJECT is a bit (0 or 1)." + (or (eql object 0) (eql object 1))) + (defun char-int-p (object) "Return t if OBJECT is an integer that can be converted into a character. See `char-int'." ＠＠ -268,7 +302,19 ＠＠ "Return t if OBJECT is a number, character or a marker." (or (numberp object) (characterp object) (markerp object))) -;; Also previously in data.c. Replaced in most uses by #'list-length. +(defun zerop (number) + "Return t if NUMBER is zero." + (= number 0)) + +(defun true-list-p (object) + "Return t if OBJECT is an acyclic, nil-terminated list." + (let ((hare object) (tortoise object) (length 0)) + (while (and (consp hare) (or (not (eq hare tortoise)) (eql length 0))) + (if (eql (logand length 1) 1) (setq tortoise (cdr tortoise))) + (setq hare (cdr hare) + length (1+ length))) + (eq hare nil))) + (defun safe-length (list) "Return the length of a list, but avoid error or infinite loop. This function never gets an error. If LIST is not really a list, diff -r 262dc5a418f5 -r 06e4b596dc40 lisp/update-elc.el --- a/lisp/update-elc.el Wed Apr 25 08:14:02 2018 +0100 +++ b/lisp/update-elc.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -70,7 +70,7 ＠＠ ; (if (file-newer-than-file-p src x) ; (progn ; (and (file-exists-p x) -; (null (file-writable-p x)) +; (eq (file-writable-p x) nil) ; (set-file-modes x (logior (file-modes x) 128))) ; src)))))) ; ;; -batch gets filtered out. ＠＠ -164,7 +164,7 ＠＠ (setq exe-target "src/temacs.exe" dump-target "src/xemacs.exe")) ;; #### need better ways of getting config params - ((not (memq 'pdump (emacs-run-status))) + ((eq (memq 'pdump (emacs-run-status)) nil) (setq exe-target "src/temacs" dump-target "src/xemacs")) (t ＠＠ -176,9 +176,9 ＠＠ ;; Not currently used. ; (setq dump-target-out-of-date-wrt-exe-target -; (cond ((not dump-target) t) +; (cond ((eq dump-target nil) t) ; (temacs-exe (file-newer-than-file-p temacs-exe dump-target)) -; ((not data-file) t) +; ((eq data-file nil) t) ; (t (file-newer-than-file-p dump-target data-file)))) ; (setq dump-target-exists (or (and temacs-exe dump-target) ; (and data-file dump-target)))) ＠＠ -229,7 +229,7 ＠＠ (arg-sans-extension (update-elc-chop-extension arg)) (full-arg (locate-library arg-sans-extension)) (full-arg-sans-extension - (if (null full-arg) + (if (eq full-arg nil) (progn (print (format "Error: Library file %s not found" arg)) (backtrace) ＠＠ -255,11 +255,11 ＠＠ (file-newer-than-file-p full-arg-elc dump-target))) (setq dump-target-out-of-date-wrt-dump-files t)) - (if (and (not (member (file-name-nondirectory arg) - unbytecompiled-lisp-files)) - (not (member (file-name-nondirectory arg) - additional-dump-dependencies)) - (not (member full-arg-el processed)) + (if (and (eq (member (file-name-nondirectory arg) + unbytecompiled-lisp-files) nil) + (eq (member (file-name-nondirectory arg) + additional-dump-dependencies) nil) + (eq (member full-arg-el processed) nil) ;; no need to check for existence of either of the files ;; because of the definition of file-newer-than-file-p. (file-newer-than-file-p full-arg-el full-arg-elc)) ＠＠ -281,11 +281,12 ＠＠ (let* ((full-arg (car all-files-in-dir))) ;; custom-load.el always gets regenerated so don't let that ;; trigger us. - (when (and (not + (when (and (eq (member (file-name-nondirectory full-arg) lisp-files-ignored-when-checking-for-autoload-updating - )) + ) + nil) (file-newer-than-file-p full-arg autoload-file)) (if autoload-is-mule (setq need-to-rebuild-mule-autoloads t) ＠＠ -306,7 +307,7 ＠＠ ;; doesn't exist, need-to-rebuild-autoloads gets set above. but ;; it's only one call, so it won't slow things down much and it keeps ;; the logic cleaner. - (not (file-exists-p aa-lisp)) + (eq (file-exists-p aa-lisp) nil) ;; no need to check for file-exists of .elc due to definition ;; of file-newer-than-file-p (file-newer-than-file-p aa-lisp aac-lisp)) ＠＠ -314,13 +315,13 ＠＠ (when (or need-to-rebuild-mule-autoloads ;; not necessary but ... see comment above. - (not (file-exists-p aa-lisp-mule)) + (eq (file-exists-p aa-lisp-mule) nil) ;; no need to check for file-exists of .elc due to definition ;; of file-newer-than-file-p (file-newer-than-file-p aa-lisp-mule aac-lisp-mule)) (setq need-to-recompile-mule-autoloads t)) -(when (not (featurep 'mule)) +(unless (featurep 'mule) ;; sorry charlie. (setq need-to-rebuild-mule-autoloads nil need-to-recompile-mule-autoloads nil)) ＠＠ -350,14 +351,14 ＠＠ (condition-case nil (delete-file (expand-file-name "src/REBUILD_AUTOLOADS" build-directory)) (file-error nil)) - (cond ((and (not update-elc-files-to-compile) - (not need-to-rebuild-autoloads) - (not need-to-rebuild-mule-autoloads) - (not need-to-recompile-autoloads) - (not need-to-recompile-mule-autoloads)) + (cond ((and (eq update-elc-files-to-compile nil) + (eq need-to-rebuild-autoloads nil) + (eq need-to-rebuild-mule-autoloads nil) + (eq need-to-recompile-autoloads nil) + (eq need-to-recompile-mule-autoloads nil)) ;; (1) Nothing to do at all. ) - ((not update-elc-files-to-compile) + ((eq update-elc-files-to-compile nil) ;; (2) We have no files to byte-compile, but we do need to ;; regenerate and compile the auto-autoloads file, so signal ;; update-elc-2 to do it. This is much faster than loading diff -r 262dc5a418f5 -r 06e4b596dc40 src/ChangeLog --- a/src/ChangeLog Wed Apr 25 08:14:02 2018 +0100 +++ b/src/ChangeLog Wed Apr 25 21:49:16 2018 +0100 ＠＠ -1,3 +1,25 ＠＠ +2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * data.c (Fatom, Flistp, Fnlistp, Fbitp, Fzerop, Ftrue_list_p): + Move all these functions to Lisp, since they are easily + implemented in Lisp, and having them in C necessitates extra space + in the dumped executable with NEWGC. + * data.c (Flistp): + * data.c (syms_of_data): + Remove various DEFSUBRs from here. + + * data.c (Fnonnegativep): + Document that this returns t if OBJECT is a nonnegative rational, + rather than a number in general. + * data.c (Fnumberp): + Document that this returns t if OBJECT is a floating point or a + rational, rather than just an integer. + * data.c: + + * lisp.h: + * tooltalk.c (tooltalk_message_callback): + Use Ffunctionp() here rather than re-implementing it. + 2018-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * abbrev.c (Fexpand_abbrev): diff -r 262dc5a418f5 -r 06e4b596dc40 src/data.c --- a/src/data.c Wed Apr 25 08:14:02 2018 +0100 +++ b/src/data.c Wed Apr 25 21:49:16 2018 +0100 ＠＠ -57,7 +57,7 ＠＠ Lisp_Object Qarith_error, Qrange_error, Qdomain_error; Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error; Lisp_Object Qintegerp, Qnatnump, Qnonnegativep, Qsymbolp; -Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp; +Lisp_Object Qlistp, Qweak_listp; Lisp_Object Qconsp, Qsubrp; Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp; Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp; ＠＠ -188,15 +188,7 ＠＠ { return EQ_WITH_EBOLA_NOTICE (object1, object2) ? Qt : Qnil; } - -DEFUN ("null", Fnull, 1, 1, 0, /* -Return t if OBJECT is nil. -*/ - (object)) -{ - return NILP (object) ? Qt : Qnil; -} - + DEFUN ("consp", Fconsp, 1, 1, 0, /* Return t if OBJECT is a cons cell. `nil' is not a cons cell. ＠＠ -208,45 +200,6 ＠＠ return CONSP (object) ? Qt : Qnil; } -DEFUN ("atom", Fatom, 1, 1, 0, /* -Return t if OBJECT is not a cons cell. `nil' is not a cons cell. - -See the documentation for `cons' or the Lisp manual for more details on what -a cons cell is. -*/ - (object)) -{ - return CONSP (object) ? Qnil : Qt; -} - -DEFUN ("listp", Flistp, 1, 1, 0, /* -Return t if OBJECT is a list. `nil' is a list. - -A list is either the Lisp object nil (a symbol), interpreted as the empty -list in this context, or a cons cell whose CDR refers to either nil or a -cons cell. A "proper list" contains no cycles. -*/ - (object)) -{ - return LISTP (object) ? Qt : Qnil; -} - -DEFUN ("nlistp", Fnlistp, 1, 1, 0, /* -Return t if OBJECT is not a list. `nil' is a list. -*/ - (object)) -{ - return LISTP (object) ? Qnil : Qt; -} - -DEFUN ("true-list-p", Ftrue_list_p, 1, 1, 0, /* -Return t if OBJECT is an acyclic, nil-terminated (ie, not dotted), list. -*/ - (object)) -{ - return TRUE_LIST_P (object) ? Qt : Qnil; -} - DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /* Return t if OBJECT is a symbol. ＠＠ -456,7 +409,7 ＠＠ } DEFUN ("nonnegativep", Fnonnegativep, 1, 1, 0, /* -Return t if OBJECT is a nonnegative number. +Return t if OBJECT is a nonnegative rational. */ (object)) { ＠＠ -470,16 +423,8 ＠＠ ? Qt : Qnil; } -DEFUN ("bitp", Fbitp, 1, 1, 0, /* -Return t if OBJECT is a bit (0 or 1). -*/ - (object)) -{ - return BITP (object) ? Qt : Qnil; -} - DEFUN ("numberp", Fnumberp, 1, 1, 0, /* -Return t if OBJECT is a number (floating point or integer). +Return t if OBJECT is a number (floating point or rational). */ (object)) { ＠＠ -1109,34 +1054,6 ＠＠ #endif /* WITH_NUMBER_TYPES */ } -DEFUN ("zerop", Fzerop, 1, 1, 0, /* -Return t if NUMBER is zero. -*/ - (number)) -{ - retry: - if (FIXNUMP (number)) - return EQ (number, Qzero) ? Qt : Qnil; -#ifdef HAVE_BIGNUM - else if (BIGNUMP (number)) - return bignum_sign (XBIGNUM_DATA (number)) == 0 ? Qt : Qnil; -#endif -#ifdef HAVE_RATIO - else if (RATIOP (number)) - return ratio_sign (XRATIO_DATA (number)) == 0 ? Qt : Qnil; -#endif - else if (FLOATP (number)) - return XFLOAT_DATA (number) == 0.0 ? Qt : Qnil; -#ifdef HAVE_BIGFLOAT - else if (BIGFLOATP (number)) - return bigfloat_sign (XBIGFLOAT_DATA (number)) == 0 ? Qt : Qnil; -#endif - else - { - number = wrong_type_argument (Qnumberp, number); - goto retry; - } -}  /* Convert between an unsigned 32-bit value and some Lisp value that preserves all its bits. Use an integer if the value will fit (that is, if the value ＠＠ -4429,7 +4346,6 ＠＠ DEFSYMBOL (Qlambda); DEFSYMBOL (Qlistp); - DEFSYMBOL (Qtrue_list_p); DEFSYMBOL (Qconsp); DEFSYMBOL (Qsubrp); DEFSYMBOL (Qsymbolp); ＠＠ -4466,13 +4382,7 ＠＠ DEFSUBR (Fdiv); #endif DEFSUBR (Feq); - DEFSUBR (Fnull); - Ffset (intern ("not"), intern ("null")); - DEFSUBR (Flistp); - DEFSUBR (Fnlistp); - DEFSUBR (Ftrue_list_p); DEFSUBR (Fconsp); - DEFSUBR (Fatom); DEFSUBR (Fcharacterp); DEFSUBR (Fchar_to_int); DEFSUBR (Fint_to_char); ＠＠ -4486,7 +4396,6 ＠＠ DEFSUBR (Fkeywordp); DEFSUBR (Fstringp); DEFSUBR (Fvectorp); - DEFSUBR (Fbitp); DEFSUBR (Fbit_vector_p); DEFSUBR (Farrayp); DEFSUBR (Fsequencep); ＠＠ -4517,7 +4426,6 ＠＠ DEFSUBR (Fleq); DEFSUBR (Fgeq); DEFSUBR (Fneq); - DEFSUBR (Fzerop); DEFSUBR (Fplus); DEFSUBR (Fminus); DEFSUBR (Ftimes); diff -r 262dc5a418f5 -r 06e4b596dc40 src/lisp.h --- a/src/lisp.h Wed Apr 25 08:14:02 2018 +0100 +++ b/src/lisp.h Wed Apr 25 21:49:16 2018 +0100 ＠＠ -2646,31 +2646,6 ＠＠ } \ while (0) -/* Return 1 if LIST is properly acyclic and nil-terminated, else 0. */ -DECLARE_INLINE_HEADER ( -int -TRUE_LIST_P (Lisp_Object object) -) -{ - Lisp_Object hare, tortoise; - EMACS_INT len; - - for (hare = tortoise = object, len = 0; - CONSP (hare); - hare = XCDR (hare), len++) - { - if (len < CIRCULAR_LIST_SUSPICION_LENGTH) - continue; - - if (len & 1) - tortoise = XCDR (tortoise); - else if (EQ (hare, tortoise)) - return 0; - } - - return NILP (hare); -} - /* Signal an error if LIST is not properly acyclic and nil-terminated. */ #define CHECK_TRUE_LIST(list) do { \ Lisp_Object CTL_list = (list); \ ＠＠ -4661,7 +4636,6 ＠＠ EXFUN (Fgtr, MANY); EXFUN (Findirect_function, 1); EXFUN (Fleq, MANY); -EXFUN (Flistp, 1); EXFUN (Flss, MANY); EXFUN (Fmax, MANY); EXFUN (Fmin, MANY); ＠＠ -4727,7 +4701,7 ＠＠ extern Lisp_Object Qarrayp, Qbitp, Qchar_or_string_p, Qcharacterp, Qerror_conditions, Qerror_message, Qinteger_char_or_marker_p, Qinteger_or_char_p, Qinteger_or_marker_p, Qlambda, Qlistp, Qnatnump, - Qnonnegativep, Qnumber_char_or_marker_p, Qnumberp, Qquote, Qtrue_list_p; + Qnonnegativep, Qnumber_char_or_marker_p, Qnumberp, Qquote; extern MODULE_API Lisp_Object Qintegerp; extern Lisp_Object Qargs_out_of_range, Qarith_error, Qbeginning_of_buffer, diff -r 262dc5a418f5 -r 06e4b596dc40 src/tooltalk.c --- a/src/tooltalk.c Wed Apr 25 08:14:02 2018 +0100 +++ b/src/tooltalk.c Wed Apr 25 21:49:16 2018 +0100 ＠＠ -362,9 +362,7 ＠＠ va_run_hook_with_args (Qtooltalk_message_handler_hook, 2, message_, pattern); - if ((SYMBOLP (cb) && EQ (Qt, Ffboundp (cb))) || - (CONSP (cb) && EQ (Qlambda, Fcar (cb)) && - !NILP (Flistp (Fcar (Fcdr (cb)))))) + if (!NILP (Ffunctionp (cb))) call2 (cb, message_, pattern); UNGCPRO; diff -r 262dc5a418f5 -r 06e4b596dc40 tests/ChangeLog --- a/tests/ChangeLog Wed Apr 25 08:14:02 2018 +0100 +++ b/tests/ChangeLog Wed Apr 25 21:49:16 2018 +0100 ＠＠ -1,3 +1,9 ＠＠ +2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Test various of the simple predicates just moved to subr.el from + data.c. + 2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/os-tests.el (two-to-the-thirty-second): diff -r 262dc5a418f5 -r 06e4b596dc40 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Wed Apr 25 08:14:02 2018 +0100 +++ b/tests/automated/lisp-tests.el Wed Apr 25 21:49:16 2018 +0100 ＠＠ -4330,4 +4330,59 ＠＠ 'file-name t))))) (define-coding-system-alias 'file-name file-name-alias)))) +;;----------------------------------------------------- +;; Testing some used-to-be-primitives, now in subr.el +;;----------------------------------------------------- + +(Assert (eq (atom nil) t)) +(Assert (eq (atom 0) t)) +(Assert (not (atom '(1 . 0)))) +(Assert (not (atom (make-circular-list 28 'a)))) + +(Assert (eq (listp '(1 . 0)) t)) +(Assert (eq (listp nil) t)) +(Assert (not (listp '#:nil))) +(Assert (not (listp [nil]))) +(Assert (eq (listp (make-circular-list 14 'b)) t)) + +(Assert (bitp 1)) +(Assert (bitp 0)) +(Assert (not (bitp 2))) +(Assert (not (bitp 0.0))) +(Assert (not (bitp 1.0))) + +(Assert (zerop 0)) +(Assert (zerop 0.0)) +(Assert (not (zerop 1))) +(Assert (not (zerop 1.0))) +(Check-Error 'wrong-type-argument (zerop '#:0)) +(Check-Error 'wrong-type-argument (zerop '\0)) +(Check-Error 'wrong-type-argument (zerop [hello])) + +(Assert (char-int-p #x61)) +(Assert (char-int-p #x41)) +(Assert (char-int-p #xff)) +(Assert (not (char-int-p -1))) +(Assert (not (char-int-p (1+ 1073741823)))) +(Assert (not (char-int-p (+ #x61 0.0)))) +(Assert (not (char-int-p "a"))) + +(Assert (char-or-string-p ?A)) +(Assert (char-or-string-p "A")) +(Assert (char-or-string-p "\x00")) +(Assert (char-or-string-p ?\x00)) +(Assert (char-or-string-p #x00)) +(Assert (char-or-string-p (make-string 1024 ?z))) +(Assert (char-or-string-p #x00)) +(Assert (not (char-or-string-p [?a]))) +(Assert (not (char-or-string-p -1))) +(Assert (not (char-or-string-p (1+ 1073741823)))) +(Assert (not (char-or-string-p (+ ?A 0.0)))) + +(Assert (true-list-p nil)) +(Assert (true-list-p '(a b c d))) +(Assert (true-list-p (cons 'a nil))) +(Assert (not (true-list-p []))) +(Assert (not (true-list-p -1))) + ;;; end of lisp-tests.el -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)