From 7b126616c87bf034c933de711befcd80a7ada3bb Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 ;; 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 @@ -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