Re: Predicate for true lists

["Basil L. Contovounesios" <contovob@tcd.ie>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: 0001-Optimize-byte-compilation-of-proper-list-p.patch --]
[-- Type: text/x-diff, Size: 1888 bytes --]

From 430fcb473608a4501826a982a29efa8c31ed6c5c Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Tue, 9 Apr 2019 16:51:55 +0100
Subject: [PATCH 1/2] Optimize byte-compilation of proper-list-p

* lisp/emacs-lisp/byte-opt.el: Optimize proper-list-p as a
predicate.
* src/fns.c (syms_of_fns): Mark proper-list-p as pure and
side-effect-free.
---
 lisp/emacs-lisp/byte-opt.el | 3 ++-
 src/fns.c                   | 6 ++++++
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 33d4964763..44cca6136c 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -879,7 +879,8 @@ byte-optimize-memq
 (put 'symbolp 'byte-optimizer 'byte-optimize-predicate)
 (put 'stringp 'byte-optimizer 'byte-optimize-predicate)
 (put 'string< 'byte-optimizer 'byte-optimize-predicate)
-(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
+(put 'string-lessp  'byte-optimizer 'byte-optimize-predicate)
+(put 'proper-list-p 'byte-optimizer 'byte-optimize-predicate)
 
 (put 'logand 'byte-optimizer 'byte-optimize-predicate)
 (put 'logior 'byte-optimizer 'byte-optimize-predicate)
diff --git a/src/fns.c b/src/fns.c
index c3202495da..c840019456 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5326,6 +5326,12 @@ syms_of_fns (void)
   DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area");
   DEFSYM (Qwidget_type, "widget-type");
 
+  DEFSYM (Qpure, "pure");
+  DEFSYM (Qside_effect_free, "side-effect-free");
+  DEFSYM (Qproper_list_p, "proper-list-p");
+  Fput (Qproper_list_p, Qpure, Qt);
+  Fput (Qproper_list_p, Qside_effect_free, Qt);
+
   DEFVAR_LISP ("overriding-plist-environment", Voverriding_plist_environment,
                doc: /* An alist that overrides the plists of the symbols which it lists.
 Used by the byte-compiler to apply `define-symbol-prop' during
-- 
2.20.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Move-proper-list-p-tests-to-fns-tests.el.patch --]
[-- Type: text/x-diff, Size: 2750 bytes --]

From 82399337d891f8c078b78f0de013ba240d1fc236 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Tue, 9 Apr 2019 17:05:27 +0100
Subject: [PATCH 2/2] Move proper-list-p tests to fns-tests.el

This follows the move of proper-list-p from lisp/subr.el to
src/fns.c in 2018-07-24T15:58:46-07:00!eggert@cs.ucla.edu.
* test/lisp/subr-tests.el (subr-tests--proper-list-p): Move from
here...
* test/src/fns-tests.el (test-proper-list-p): ...to here.
---
 test/lisp/subr-tests.el | 18 ------------------
 test/src/fns-tests.el   | 18 ++++++++++++++++++
 2 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 7465aac5ea..c458eef2f9 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -318,24 +318,6 @@ subr-test--frames-1
   (should (eq (string-to-char (symbol-name (gensym))) ?g))
   (should (eq (string-to-char (symbol-name (gensym "X"))) ?X)))
 
-(ert-deftest subr-tests--proper-list-p ()
-  "Test `proper-list-p' behavior."
-  (dotimes (length 4)
-    ;; Proper and dotted lists.
-    (let ((list (make-list length 0)))
-      (should (= (proper-list-p list) length))
-      (should (not (proper-list-p (nconc list 0)))))
-    ;; Circular lists.
-    (dotimes (n (1+ length))
-      (let ((circle (make-list (1+ length) 0)))
-        (should (not (proper-list-p (nconc circle (nthcdr n circle))))))))
-  ;; Atoms.
-  (should (not (proper-list-p 0)))
-  (should (not (proper-list-p "")))
-  (should (not (proper-list-p [])))
-  (should (not (proper-list-p (make-bool-vector 0 nil))))
-  (should (not (proper-list-p (make-symbol "a")))))
-
 (ert-deftest subr-tests--assq-delete-all ()
   "Test `assq-delete-all' behavior."
   (cl-flet ((new-list-fn
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index d6cc99e8e3..6ebab4287f 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -648,4 +648,22 @@ dot2
           (should (equal (list (eq a b) n len)
                          (list t n len))))))))
 
+(ert-deftest test-proper-list-p ()
+  "Test `proper-list-p' behavior."
+  (dotimes (length 4)
+    ;; Proper and dotted lists.
+    (let ((list (make-list length 0)))
+      (should (= (proper-list-p list) length))
+      (should (not (proper-list-p (nconc list 0)))))
+    ;; Circular lists.
+    (dotimes (n (1+ length))
+      (let ((circle (make-list (1+ length) 0)))
+        (should (not (proper-list-p (nconc circle (nthcdr n circle))))))))
+  ;; Atoms.
+  (should (not (proper-list-p 0)))
+  (should (not (proper-list-p "")))
+  (should (not (proper-list-p [])))
+  (should (not (proper-list-p (make-bool-vector 0 nil))))
+  (should (not (proper-list-p (make-symbol "a")))))
+
 (provide 'fns-tests)
-- 
2.20.1


[-- Attachment #3: Type: text/plain, Size: 1792 bytes --]


Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> @@ -1160,8 +1161,8 @@ byte-optimize-set
>>  	 make-list make-string make-symbol marker-buffer max member memq min
>>  	 minibuffer-selected-window minibuffer-window
>>  	 mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
>> -	 parse-colon-path plist-get plist-member
>> -	 prefix-numeric-value previous-window prin1-to-string propertize
>> +         parse-colon-path plist-get plist-member prefix-numeric-value
>> +         previous-window prin1-to-string proper-list-p propertize
>>  	 degrees-to-radians
>>  	 radians-to-degrees rassq rassoc read-from-string regexp-quote
>>  	 region-beginning region-end reverse round
>
> I think it'd be better to add a `side-effect-free` property rather than
> add to this list.  We should be moving away from having this list in
> byte-opt.el since that info can also be used when byte-opt is not
> loaded.

Makes sense, how's the attached?  Is there a better place to do this
than in syms_of_fns?  (I followed the example in src/json.c.)

>> diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
>> index 8bbe6292d9..0e953dc96b 100644
>> --- a/lisp/emacs-lisp/bytecomp.el
>> +++ b/lisp/emacs-lisp/bytecomp.el
>> @@ -3566,6 +3566,7 @@ byte-defop-compiler-1
>>  
>>  ;;####(byte-defop-compiler move-to-column	1)
>>  (byte-defop-compiler-1 interactive byte-compile-noop)
>> +(byte-defop-compiler-1 proper-list-p 1)
>
> I don't think this is needed.

Right.  For some reason the byte-compiler wasn't complaining about wrong
numbers of arguments without this compiler-form, but I can no longer
reproduce that.

I also attach a second patch which moves the proper-list-p tests to the
correct file following the function's rewriting in C.  WDYT?

Thanks,

-- 
Basil