bug#30626: 26.0.91; Crash when traversing a `stream-of-directory-files'

[Noam Postavsky <npostavs@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2457 bytes --]

tags 30626 + patch
quit

Michael Heerdegen <michael_heerdegen@web.de> writes:

>> > - stream-make should use cons instead of list (or maybe a struct?).
>>
>> I think cons would be ok.  Would a struct make things slower?

A struct might be slower, and cons has the advantage that the print
output is more readable for humans too.  E.g., with this code:

(let ((s (stream-range 1 5)))
  (stream-flush s)
  s)

;; Using cons (patch in this message):
(--stream-evald-- 1 --stream-evald-- 2 --stream-evald-- 3 --stream-evald-- 4 --stream-evald--)

;; Using list (previous patch):
(--stream-evald-- (1 --stream-evald-- (2 --stream-evald-- (3 --stream-evald-- (4 --stream-evald-- nil)))))

;; I guess using a struct would look something like this:
#(--stream-evald-- (1 . #(--stream-evald-- (2 . #(--stream-evald-- (3 . #(--stream-evald-- (4 . #(--stream-evald-- nil)))))))))

;; Using list with thunk (current, v2.2.4)
(--stream-- #[256 "\211\203\007\0\303\242\207\303\242\204 \0\304\300\242\305\300\242\302\242\\\301\302\242#B\240\210\303\306\240\210\304\242\207" [(1) 5 (1) (t) ((1 --stream-- #[256 "\211\203\007\0\303\242\207\303\242\204 \0\304\300\242\305\300\242\302\242\\\301\302\242#B\240\210\303\306\240\210\304\242\207" [(2) 5 (1) (t) ((2 --stream-- #[256 "\211\203\007\0\303\242\207\303\242\204 \0\304\300\242\305\300\242\302\242\\\301\302\242#B\240\210\303\306\240\210\304\242\207" [(3) 5 (1) (t) ((3 --stream-- #[256 "\211\203\007\0\303\242\207\303\242\204 \0\304\300\242\305\300\242\302\242\\\301\302\242#B\240\210\303\306\240\210\304\242\207" [(4) 5 (1) (t) ((4 --stream-- #[256 "\211\203\007\0\300\242\207\300\242\204\024\0\301\302\240\210\300\303\240\210\301\242\207" [(t) (nil) nil t] 3 "

(fn &optional CHECK)"])) stream-range t] 7 "

(fn &optional CHECK)"])) stream-range t] 7 "

(fn &optional CHECK)"])) stream-range t] 7 "

(fn &optional CHECK)"])) stream-range t] 7 "

(fn &optional CHECK)"])

>> > - stream-empty should just be a constant.
>>
>> Dunno if there are cases where this would be problematic, but I guess we
>> could do this as well.

I've done this in the patch below.  Passes all the tests, and I can't
see why it would be problematic.

> @Nicolas: Do you want us to care about this or do you want to have a
> look yourself?  I don't want to hurry, I just don't want this to be
> forgotten.  If you say you have time in four months, it's still ok.

Not getting any response; I'll wait another week for comments and then
push.


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 5752 bytes --]

From 7b126616c87bf034c933de711befcd80a7ada3bb Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@users.sourceforge.net>
Date: Wed, 24 Apr 2019 22:51:19 -0400
Subject: [PATCH] Drop forced lambda's from stream (Bug#30626)

Let the stream id distinguish between forced and unforced stream
values.  When the value is forced, replace the lambda with its result.
This lets the lambda and anything it references be garbage collected.

Change the representation of a stream from (--stream-- THUNK)
to (--stream-fresh-- . (lambda () VALUE)) or (--stream-evald .
VALUE).
* packages/stream/stream.el (stream--identifier): Remove.
(stream--fresh-identifier, stream--evald-identifier): New constants to
replace it.
(streamp): Check for new constants.
(stream-make): Use cons and lambda instead of list and thunk-delay.
(stream--force): New function.
(stream-empty-p, stream-first, stream-rest): Use it.
(stream-empty): New constant, return it from the function instead of
creating a new one each time.
* packages/stream/tests/stream-tests.el (stream-to-list): Remove.
(stream-list-test): Use seq-into instead.
---
 packages/stream/stream.el             | 41 +++++++++++++++++++++++++----------
 packages/stream/tests/stream-tests.el | 12 ++--------
 2 files changed, 31 insertions(+), 22 deletions(-)

diff --git a/packages/stream/stream.el b/packages/stream/stream.el
index 3f6bc4b5b..9f73e8b86 100644
--- a/packages/stream/stream.el
+++ b/packages/stream/stream.el
@@ -1,6 +1,6 @@
 ;;; stream.el --- Implementation of streams  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2019 Free Software Foundation, Inc.
 
 ;; Author: Nicolas Petton <nicolas@petton.fr>
 ;; Keywords: stream, laziness, sequences
@@ -41,7 +41,7 @@
 ;; - ...
 ;;
 ;; All functions are prefixed with "stream-".
-;; All functions are tested in test/automated/stream-tests.el
+;; All functions are tested in tests/stream-tests.el
 ;;
 ;; Here is an example implementation of the Fibonacci numbers
 ;; implemented as in infinite stream:
@@ -65,18 +65,30 @@
 
 (eval-when-compile (require 'cl-lib))
 (require 'seq)
-(require 'thunk)
 
 (eval-and-compile
-  (defconst stream--identifier '--stream--
-    "Symbol internally used to identify streams."))
+  (defconst stream--fresh-identifier '--stream-fresh--
+    "Symbol internally used to streams whose head was not evaluated.")
+  (defconst stream--evald-identifier '--stream-evald--
+    "Symbol internally used to streams whose head was evaluated."))
 
 (defmacro stream-make (&rest body)
   "Return a stream built from BODY.
 BODY must return nil or a cons cell whose cdr is itself a
 stream."
   (declare (debug t))
-  `(list ',stream--identifier (thunk-delay ,@body)))
+  `(cons ',stream--fresh-identifier (lambda () ,@body)))
+
+(defun stream--force (stream)
+  "Evaluate and return the first cons cell of STREAM.
+That value is the one passed to `stream-make'."
+  (cond
+   ((eq (car-safe stream) stream--evald-identifier)
+    (cdr stream))
+   ((eq (car-safe stream) stream--fresh-identifier)
+    (setf (car stream) stream--evald-identifier)
+    (setf (cdr stream) (funcall (cdr stream))))
+   (t (signal 'wrong-type-argument (list 'streamp stream)))))
 
 (defmacro stream-cons (first rest)
   "Return a stream built from the cons of FIRST and REST.
@@ -159,24 +171,29 @@ (defun stream-range (&optional start end step)
 
 (defun streamp (stream)
   "Return non-nil if STREAM is a stream, nil otherwise."
-  (eq (car-safe stream) stream--identifier))
+  (let ((car (car-safe stream)))
+    (or (eq car stream--fresh-identifier)
+        (eq car stream--evald-identifier))))
+
+(defconst stream-empty (cons stream--evald-identifier nil)
+  "The empty stream.")
 
 (defun stream-empty ()
-  "Return a new empty stream."
-  (list stream--identifier (thunk-delay nil)))
+  "Return the empty stream."
+  stream-empty)
 
 (defun stream-empty-p (stream)
   "Return non-nil if STREAM is empty, nil otherwise."
-  (null (thunk-force (cadr stream))))
+  (null (cdr (stream--force stream))))
 
 (defun stream-first (stream)
   "Return the first element of STREAM.
 Return nil if STREAM is empty."
-  (car (thunk-force (cadr stream))))
+  (car (stream--force stream)))
 
 (defun stream-rest (stream)
   "Return a stream of all but the first element of STREAM."
-  (or (cdr (thunk-force (cadr stream)))
+  (or (cdr (stream--force stream))
       (stream-empty)))
 
 (defun stream-append (&rest streams)
diff --git a/packages/stream/tests/stream-tests.el b/packages/stream/tests/stream-tests.el
index 021ed65cf..7487ef69b 100644
--- a/packages/stream/tests/stream-tests.el
+++ b/packages/stream/tests/stream-tests.el
@@ -1,6 +1,6 @@
 ;;; stream-tests.el --- Unit tests for stream.el  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2017-2019 Free Software Foundation, Inc.
 
 ;; Author: Nicolas Petton <nicolas@petton.fr>
 
@@ -29,14 +29,6 @@ (require 'stream)
 (require 'generator)
 (require 'cl-lib)
 
-(defun stream-to-list (stream)
-  "Eagerly traverse STREAM and return a list of its elements."
-  (let (result)
-    (seq-do (lambda (elt)
-                 (push elt result))
-               stream)
-    (reverse result)))
-
 (ert-deftest stream-empty-test ()
   (should (streamp (stream-empty)))
   (should (stream-empty-p (stream-empty))))
@@ -240,7 +232,7 @@ (ert-deftest stream-range-test ()
 
 (ert-deftest stream-list-test ()
   (dolist (list '(nil '(1 2 3) '(a . b)))
-    (should (equal list (stream-to-list (stream list))))))
+    (should (equal list (seq-into (stream list) 'list)))))
 
 (ert-deftest stream-seq-subseq-test ()
   (should (stream-empty-p (seq-subseq (stream-range 2 10) 0 0)))
-- 
2.11.0