Love for collectors (dylan-lang#1627)

Author: cgay

documentation/source/library-reference/collections/collectors.rst

@@ -5,21 +5,111 @@ The collectors Module
 .. current-library:: collections
 .. current-module:: collectors
 
+.. macro:: collecting
+   :statement:
+
+   Collect values into a named or unnamed collector.  A collector may be, for example, a
+   :drm:`<collection>`, a number into which values are accumulated, etc.
+
+   :macrocall:
+     .. parsed-literal:: 
+
+        collecting ([`name`] [as `type`])
+          [ `body` ]
+        end [ collecting ]
+
+   :parameter name: A Dylan variable-name *BNF*. If omitted, the collection is returned
+      from the :macro:`collecting` macro call. If supplied, the caller is responsible for
+      calling ``collected(name)`` to retrieve the collection before the call to
+      `collecting` terminates.
+   :parameter type: A Dylan type. The default value is :drm:`<list>`.
+   :parameter body: A Dylan body *BNF*.
+
+   :description:
+
+      Binds *name* (or a default variable name if *name* is not supplied) to a collector
+      that can efficiently collect new values into the collection when :macro:`collect`
+      or the related ``collect-*`` macros are called.
+
+   :example:
+
+      .. code-block:: dylan
+
+         collecting () collect(1); collect(2) end;
+         // => #(1, 2)
+
+         collecting () collect(1); collect-first(2) end;
+         // => #(2, 1)
+
+         collecting (as <integer>) collect(1); collect(2) end;
+         // => 3
+
+         collecting (a, b, c)
+           collect-into(a, 1);
+           collect-into(b, 2);
+           collect-into(c, 3);
+           values(collected(a), collected(b), collected(c)
+         end;
+         // => #(1), #(2), #(3)
+
 .. macro:: collect
 
+   :description: Collect a value at the end of the unnamed collector: ``collect(100)``
+      May only be used when ``collecting () ... end`` was called with no arguments.
+
+   :seealso: :macro:`collecting`
+
 .. macro:: collect-first
 
-.. macro:: collect-first-into
+   :description: Collect a value at the beginning of the unnamed collector:
+      ``collect-first(100)`` May only be used when ``collecting () ... end`` was called
+      with no arguments.
 
-.. macro:: collect-into
+   :seealso: :macro:`collecting`
 
 .. macro:: collect-last
 
+   :description: Collect a value at the end of the unnamed collector:
+      ``collect-last(100)`` May only be used when ``collecting () ... end`` was called
+      with no arguments.
+
+   :seealso: :macro:`collecting`
+
+.. macro:: collect-into
+
+   :description: Collect a value at the end of a named collector: ``collect-into(c,
+      100)`` May only be used when ``collecting (c) ... end`` was called with arguments.
+
+   :seealso: :macro:`collecting`
+
+.. macro:: collect-first-into
+
+   :description: Collect a value at the beginning of a named collector:
+      ``collect-first-into(c, 100)`` May only be used when ``collecting (c) ... end`` was
+      called with arguments.
+
+   :seealso: :macro:`collecting`
+
 .. macro:: collect-last-into
 
+   :description: Collect a value at the end of a named collector: ``collect-last-into(c,
+      100)`` May only be used when ``collecting (c) ... end`` was called with arguments.
+
+   :seealso: :macro:`collecting`
+
 .. macro:: collected
 
-.. macro:: collecting
+   :description: Retrieve the value of the collection associated with a collector.
+
+   :example:
+
+      .. code-block:: dylan
+
+         collecting () ... map(f, collected()) ... end
+
+         collecting (a, b) ... map(f1, collected(a)); map(f2, collected(b)); ... end
+
+   :seealso: :macro:`collecting`
 
 .. generic-function:: collector-protocol
    :open:
@@ -28,9 +118,13 @@ The collectors Module
 
    :parameter class: An instance of :drm:`<object>`.
    :value new-collector: An instance of :drm:`<object>`.
-   :value add-first: An instance of :drm:`<function>`.
-   :value add-last: An instance of :drm:`<function>`.
-   :value add-sequence-first: An instance of :drm:`<function>`.
-   :value add-sequence-last: An instance of :drm:`<function>`.
-   :value collection: An instance of :drm:`<function>`.
+   :value add-first: A :drm:`<function>` that accepts the collection and a value and adds
+      the value to the beginning of the collection.
+   :value add-last: A :drm:`<function>` that accepts the collection and a value and adds
+      the value to the end of the collection.
+   :value add-sequence-first: An instance of :drm:`<function>`. **Not yet implemented.**
+   :value add-sequence-last: An instance of :drm:`<function>`. **Not yet implemented.**
+   :value collection: A :drm:`<function>` that receives the collector and returns the
+      collection.
 
+   :seealso: :macro:`collecting`

sources/collections/collectors-macros.dylan

@@ -7,7 +7,7 @@ License:      See License.txt in this distribution for details.
 Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND
 
 // Unfortunately, the implicitly generated name for a collecting () call
-// has to be antigygienic so that it can be referred to by name in more
+// has to be unhygienic so that it can be referred to by name in more
 // than one macro.
 
 define macro collecting
@@ -28,6 +28,10 @@ define macro collecting
            ?body;
            collected(?=_collector)
          end }
+  // This variant could have returned values(collected(var1), collected(var2), ...)
+  // to match the way unnamed collections work, but unfortunately that would break
+  // current callers if it were changed now. (The callers I checked in OD would be
+  // trivial to convert.)
   { collecting (?vars) ?:body end }
     => { ?vars;
          ?body }
@@ -84,6 +88,8 @@ define macro collect-into
 end macro;
 
 define macro collected
+  { collected () }
+    => { collected(?=_collector) }
   { collected (?:name) }
     => { ?name ## "-collection"(?name ## "-collector") }
 end macro;

sources/collections/collectors.dylan

@@ -14,7 +14,7 @@ define open generic collector-protocol (class, #key)
       add-sequence-last  :: <function>,
       collection         :: <function>);
 
-//// Default.
+//// By default collect into a <list>.
 
 define inline sealed method collector-protocol
      (class == <object>, #rest options, #key)
@@ -65,12 +65,16 @@ define inline sealed method collector-protocol
       add-sequence-last  :: <function>,
       collection         :: <function>)
   values(begin
-           let head-pair = pair(#f, #());
-	   head(head-pair) := head-pair;
+           let head-pair = pair(#f, #()); // The collector is #(final-pair . collection)
+	   head(head-pair) := head-pair;  // except when the collection is empty.
          end,
          method (collector :: <pair>, value)
-           let new-pair = pair(value, collector.tail);
+           let t = collector.tail;
+           let new-pair = pair(value, t);
            collector.tail := new-pair;
+           if (empty?(t))
+             collector.head := new-pair;
+           end;
            value;
          end,
          method (collector :: <pair>, value)

sources/collections/tests/collections-test-suite-app.dylan

@@ -1,3 +1,3 @@
 module: collections-test-suite-app
 
-run-test-application(collections-test-suite);
+run-test-application();

sources/collections/tests/collections-test-suite.lid

@@ -14,6 +14,7 @@ Files:     library
            bit-count
            bit-set-tests
            table-extensions
+           collectors
            collections-test-suite
 Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
               All rights reserved.

sources/collections/tests/collectors.dylan

@@ -0,0 +1,79 @@
+Module: collections-test-suite
+
+
+define test test-collect ()
+  assert-instance?(<list>, collecting() end, "default collection type is <list>?");
+  assert-equal(#(1, 2, 3),
+               collecting ()
+                 collect(1);
+                 collect(2);
+                 collect(3);
+               end,
+               "items are added at the end by default for lists?");
+  assert-equal(#(2, 1, 3),
+               collecting ()
+                 collect(1);
+                 collect-first(2);
+                 collect-last(3);
+               end,
+               "collect-first adds to the beginning of the collection?");
+  let c = collecting ()
+            collect(1);
+            collect(2);
+            collect-first(3);
+            assert-equal(#(3, 1, 2), collected(),
+                         "collected() works for unnamed collections?");
+            collect(5);
+          end;
+  assert-equal(#(3, 1, 2, 5), c, "collecting returns the collection?");
+end test;
+
+// Note that for named collections the collection isn't automatically returned from the
+// body of `collecting`, unlike for unnamed collections. See comment in the `collecting`
+// macro.
+define test test-collect-into ()
+  assert-equal(#(1, 2, 3),
+               collecting (c)
+                 collect-into(c, 1);
+                 collect-into(c, 2);
+                 collect-into(c, 3);
+                 collected(c)
+               end,
+               "items are added at the end by default?");
+  assert-equal(#(2, 1, 3),
+               collecting (c)
+                 collect-into(c, 1);
+                 collect-first-into(c, 2);
+                 collect-last-into(c, 3);
+                 collected(c)
+               end,
+               "collect-first-into adds to the beginning of the collection?");
+  let cc = collecting (c)
+             collect-first-into(c, 1); // first/last should not matter here
+             assert-equal(#(1), collected(c));
+             collect-last-into(c, 2);
+             assert-equal(#(1, 2), collected(c));
+             collect-first-into(c, 3);
+             assert-equal(#(3, 1, 2), collected(c),
+                          "collected(c) works for named collections?");
+             collect-last-into(c, 5);
+             collected(c)
+           end;
+  assert-equal(#(3, 1, 2, 5), cc, "collecting returns the collection?");
+end test;
+
+define test test-collecting-as ()
+  let c = collecting (as <vector>)
+            collect(1);
+            collect(2);
+          end;
+  assert-instance?(<vector>, c);
+  assert-equal(#[1, 2], c);
+
+  let c = collecting (as <integer>)
+            collect(1);
+            collect(2);
+          end;
+  assert-equal(c, 3);
+end test;
+

sources/lib/source-records/file-source-records-library.dylan

@@ -35,7 +35,6 @@ define module file-source-records-implementation
   use threads;
   use locators;
   // Probably don't need all this, sort it out later
-  // use collectors;
   use byte-vector;
   use set;
   use streams;

sources/lib/source-records/source-records-library.dylan

@@ -82,7 +82,6 @@ define module source-records-implementation
   use common-dylan;
   use threads;
   // Probably don't need all this, sort it out later
-  // use collectors;
   use set;
   use byte-vector;
   use streams;

sources/project-manager/projects/projects-library.dylan

@@ -13,7 +13,6 @@ define library projects
   use release-info;
   use dood;        //---*** andrewa: just for with-walk-progress
   // Probably don't need all this, sort it out later...
-  use collections;
   use io;
   use system;
 
@@ -150,8 +149,6 @@ define module projects-implementation
     import: { \with-walk-progress };
 
   // Probably don't need all this, sort it out later...
-  use collectors;
-  use set;
   use locators;
   use streams;
   use format;

sources/project-manager/registry-projects/registry-projects-library.dylan

@@ -8,7 +8,6 @@ Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND
 define library registry-projects
   use dylan;
   // Probably don't need all this, sort it out later...
-  use collections;
   use io;
   use system;
   use build-system;
@@ -26,8 +25,6 @@ define module registry-projects-internal
   use dylan-extensions;
   use simple-debugging;
   // Probably don't need all this, sort it out later...
-  use collectors;
-  use set;
   use streams;
   use locators;
   use format;