Apply changes from Linus Björnstam.

Author: arthurgleckler

compose.scm

@@ -1,7 +1,10 @@
+;; Fold is as defined in srfi-1. 
+;; for r6rs it can be substituted for fold-left
+
 (define (compose . functions)
   (define (make-chain thunk chain)
     (lambda args
       (call-with-values (lambda () (apply thunk args)) chain)))
   (if (null? functions)
       values
-      (fold-left make-chain (car functions) (cdr functions))))
+      (fold make-chain (car functions) (cdr functions))))

srfi-171.html

@@ -222,35 +222,47 @@ <h3 id="vector-transduce">vector-transduce</h3>
   <br />
   <code>(vector-transduce</code> <em>xform f identity vec</em><code>)</code></p>
 
-<p>Same as <code>transduce</code>, but reduces over a vector instead of a list.</p>
+<p>Same as <code>list-transduce</code>, but reduces over a vector instead of a list.</p>
 
 
 <h3 id="string-transduce">string-transduce</h3>
 <p><code>(string-transduce</code> <em>xform f str</em><code>)</code>
   <br />
   <code>(string-transduce</code> <em>xform f identity str</em><code>)</code></p>
 
-<p>Same as <code>transduce</code>, but for strings.</p>
+<p>Same as <code>list-transduce</code>, but for strings.</p>
 
 
 <h3 id="bytevector-u8-transduce">bytevector-u8-transduce</h3>
 <p><code>(bytevector-u8-transduce</code> <em>xform f bvec</em><code>)</code>
   <br />
   <code>(bytevector-u8-transduce</code> <em>xform f identity bvec</em><code>)</code></p>
 
-<p>Same as transduce, but for u8-bytevectors.</p>
+<p>Same as <code>list-transduce</code>, but for u8-bytevectors.</p>
 
 
 <h3 id="port-transduce">port-transduce</h3>
-<p><code>(port-transduce</code> <em>xform f reader port</em><code>)</code>
-  <br />
-  <code>(port-transduce</code> <em>xform f init reader port</em><code>)</code></p>
-
-<p> Applies <code>(xform f)</code> to every value produced by <code>(reader port)</code> until
-  <code>#eof-object</code> is returned.</p>
+<p><code>(port-transduce</code> <em>xform f reader</em><code>)</code>
+   <br />
+   <code>(port-transduce</code> <em>xform f reader port</em><code>)</code>
+   <br />
+   <code>(port-transduce</code> <em>xform f init reader port</em><code>)</code></p>
+
+<p> If <em>port</em> is provided, it applies <code>(xform f)</code> to every value
+    produced by <code>(reader port)</code> until <code>#eof-object</code> is returned.
+    If <em>port</em> is not provided, it calls <em>reader</em> without arguments until
+    <code>#eof-object</code> is returned.
+</p>
 
 <p><code>(port-transduce (tfilter odd?) rcons read (open-input-string "1 2 3 4"))</code>
-  =&gt; (2 4)</p>
+    =&gt; (2 4)</p>
+
+<h3 id="generator-transduce">generator-transduce</h3>
+<p><code>(generator-transduce</code> <em>xform f gen</em><code>)</code>
+    <br />
+    <code>(generator-transduce</code> <em>xform f init gen</em><code>)</code></p>
+
+<p> Same as list-transduce, but for srfi-158-styled generators</p>
 
 
 <h2 id="reducers">Reducers</h2>
@@ -289,7 +301,7 @@ <h3 id="revery-pred"><code>(revery</code> <em>pred?</em><code>)</code></h3>
 <p>The reducer version of every.  Stops the transduction and returns
   (reduced #f) if any (pred? value) returns #f.  If every (pred? value)
   returns true, it returns the result of the last invocation of (pred?
-  value).</p>
+    value). The identity is <code>#t</code>.</p>
 
 <p><pre>(list-transduce
   (tmap (lambda (x) (+ x 1)))
@@ -329,13 +341,17 @@ <h3 id="tfilter-map-proc"><code>(tfilter-map</code> <em>proc</em><code>)</code><
   Must be stateless.</p>
 
 
-<h3 id="treplace-map"><code>(treplace</code> <em>map</em><code>)</code></h3>
-<p>Returns a transducer which uses any value as a key in
-  <em>map</em>.  If a mapping is found, the value of that mapping is
-  returned, otherwise it just returns the original value.</p>
+<h3 id="treplace-mapping"><code>(treplace</code> <em>mapping</em><code>)</code></h3>
+<p>Returns a transducer which checks for the presence of any value passed through it in
+    <em>mapping</em>.  If a mapping is found, the value of that mapping is
+    returned, otherwise it just returns the original value.</p>
 
-<p>Must not keep any internal state.  Modifying the map after treplace
-  has been instantiated is an error.</p>
+<p><em>mapping</em> is an association list (using equal? to compare keys), a hash-table,
+    a one-argument procedure taking one argument and either producing that same argument
+    or a replacement value, or another implementation-defined mapping object.</p>
+
+<p>Must not keep any internal state.  Modifying the mapping while it's in use by treplace
+    is an error.</p>
 
 
 <h3 id="tdrop-n"><code>(tdrop</code> <em>n</em><code>)</code></h3>
@@ -392,7 +408,7 @@ <h3 id="tflatten"><code>tflatten</code></h3>
 
 
 
-<h3 id="tdelete-neighbor-dupes"><code>(tdelete-neighbour-dupes <em>[equality-predicate]</em>)</code></h3>
+<h3 id="tdelete-neighbor-dupes"><code>(tdelete-neighbor-dupes <em>[equality-predicate]</em>)</code></h3>
 <p>Returns a transducer that removes any directly following duplicate
   elements. The default <em>equality-predicate</em> is <code>equal?</code>.</p>
 
@@ -500,20 +516,25 @@ <h3 id="string-reduce"><code>(string-reduce</code> <em> f identity str</em><code
 <p> The string version of <code>list-reduce</code></p>
 
 
-<h3 id="string-reduce"><code>(port-reduce</code> <em> f identity reader port</em><code>)</code></h3>
+<h3 id="port-reduce"><code>(port-reduce</code> <em> f identity reader port</em><code>)</code></h3>
 <p> The port version of <code>list-reducer</code>.  It reduces over <em>port</em> using
     <em>reader</em> until <em>reader</em> returns <code>#eof-object</code>.</p>
 
 
+<h3 id="generator-reduce"><code>(generator-reduce</code> <em> f identity gen</em><code>)</code></h3>
+<p> The port version of <code>list-reducer</code>.  It reduces over <em>gen</em> until it returns
+
+    <code>#eof-object</code>.</p>
+
 
 <h1 id="sample-implementation">Sample implementation</h1>
 
 <p> The sample implementation is written in Guile, but should be
-   straightforward to port since it uses no guile-specific features
-   apart from guile's hash-table implementation.  In fact, I am quite
-   certain that it is written for clarity instead of speed, but should
-   be plenty fast anyway.  The low-hanging fruit for optimization is to
-   replace the composed transducers (such as <code>tappend-map</code>
+    straightforward to port since it uses no guile-specific features
+    apart from guile's hash-table implementation.  In fact, I am quite
+    certain that it is written for clarity instead of speed, but should
+    be plenty fast anyway.  The low-hanging fruit for optimization is to
+    replace the composed transducers (such as <code>tappend-map</code>
     and <code>tfilter-map</code>) with non-composed implementations.</p>
 
 <p> Another optimization would be to return whether or not a reducer
@@ -523,43 +544,48 @@ <h1 id="sample-implementation">Sample implementation</h1>
 
 <h1 id="acknowledgements">Acknowledgements</h1>
 
-<p>First of all, this would not have been done without Rich Hickey who
-  introduced transducers into Clojure.  His talks were important for me
-  to grasp the basics of transducers.  Then I would like to thank large
-  parts of the Clojure community for also struggling with
-  understanding transducers.  The amount of material produced
-  explaining them in general, and Clojure's implementation
-  specifically, has been instrumental in letting me make this a
+<p> First of all, this would not have been done without Rich Hickey who
+    introduced transducers into Clojure.  His talks were important for me
+    to grasp the basics of transducers.  Then I would like to thank large
+    parts of the Clojure community for also struggling with
+    understanding transducers.  The amount of material produced
+    explaining them in general, and Clojure's implementation
+    specifically, has been instrumental in letting me make this a
     clean-room implementation.</p>
 
-<p>I'd also like to thank Juanpe Bolivar who implemented pure transducers
-    for c++ (in the Atria library) and did a wonderful presentation about them.</p>
+<p> In the same vein I would like to direct a thank you to Juanpe Bolivar who
+    implemented pure transducers for c++ (in the Atria library) and did a
+    wonderful presentation about them.</p>
+
+<p> I would also like to thank John Cowan, Duy Nguyen and Lassi Kortela for
+    their input during the SRFI process. </p>
 
 <p>Lastly I would like to thank Arthur Gleckler who showed interest in
   my implementation of transducers and convinced me to make this SRFI.</p>
 
+
 <h1 id="copyright">Copyright</h1>
 
-<p>Copyright (C) Linus Björnstam (2019).</p>
-
-<p>Permission is hereby granted, free of charge, to any person
-  obtaining a copy of this software and associated documentation files
-  (the “Software”), to deal in the Software without restriction,
-  including without limitation the rights to use, copy, modify, merge,
-  publish, distribute, sublicense, and/or sell copies of the Software,
-  and to permit persons to whom the Software is furnished to do so,
-  subject to the following conditions:</p>
-
-<p>The above copyright notice and this permission notice shall be
-  included in all copies or substantial portions of the Software.</p>
-
-<p>THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
-  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-  NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-  BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-  ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-  SOFTWARE.</p>
+<p> Copyright (C) Linus Björnstam (2019).</p>
+
+<p> Permission is hereby granted, free of charge, to any person
+    obtaining a copy of this software and associated documentation files
+    (the “Software”), to deal in the Software without restriction,
+    including without limitation the rights to use, copy, modify, merge, 
+    publish, distribute, sublicense, and/or sell copies of the Software,
+    and to permit persons to whom the Software is furnished to do so,
+    subject to the following conditions:</p>
+
+<p> The above copyright notice and this permission notice shall be
+   included in all copies or substantial portions of the Software.</p>
+
+<p> THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+    EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+    NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+    BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+    ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+    CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+    SOFTWARE.</p>
 
 <hr> <address>Editor: <a href="mailto:srfi-editors+at+srfi+dot+schemers+dot+org">Arthur A. Gleckler</a></address></body></html>

srfi/171-impl.scm

@@ -39,6 +39,7 @@
 
 
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Reducing functions meant to be used at the end at the transducing
 ;; process.    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -130,13 +131,25 @@
 
 (define port-transduce
   (case-lambda
+    ((xform f by)
+     (generator-transduce xform f by))
     ((xform f by port)
      (port-transduce xform f (f) by port))
     ((xform f init by port)
      (let* ((xf (xform f))
             (result (port-reduce xf init by port)))
        (xf result)))))
 
+(define generator-transduce
+  (case-lambda
+    ((xform f gen)
+     (generator-transduce xform f (f) gen))
+    ((xform f init gen)
+     (let* ((xf (xform f))
+            (result (generator-reduce xf init gen)))
+       (xf result)))))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Transducers!    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -185,7 +198,10 @@
             x))))
    ((hash-table? map)
     (lambda (x)
-      (hash-table-ref map x x)))))
+      (hash-table-ref/default map x x)))
+   ((procedure? map) map)
+   (else
+    (error "Unsupported mapping in treplace" map))))
 
 
 (define (treplace map)
@@ -236,6 +252,7 @@
                result)))))))
 
 
+
 (define ttake-while
   (case-lambda
     ((pred) (ttake-while pred (lambda (result input) result)))

srfi/171.sld

@@ -21,7 +21,7 @@
           (srfi 171 meta))
   (cond-expand
    (gauche (import (only (gauche base) compose reverse!)))
-   (chibi (import (only (srfi 1) reverse!))))
+   (chibi (import (only (srfi 1) fold reverse!))))
   (export rcons reverse-rcons
           rcount
           rany
@@ -32,6 +32,7 @@
           string-transduce
           bytevector-u8-transduce
           port-transduce
+          generator-transduce
 
           tmap
           tfilter
@@ -53,13 +54,15 @@
           tenumerate
           tlog)
 
-  ;; compose.scm uses fold-left, not available in
-  ;; Chibi. This is all we need for this SRFI
   (cond-expand
-   (chibi (begin (define compose
-                   (lambda (f g)
-                     (lambda args
-                       (f (apply g args)))))))
-   (else (begin)))
+    (chibi (begin
+             (define (compose . functions)
+               (define (make-chain thunk chain)
+                 (lambda args
+                   (call-with-values (lambda () (apply thunk args)) chain)))
+               (if (null? functions)
+                   values
+                   (fold make-chain (car functions) (cdr functions))))))
+    (else (begin)))
 
   (include "171-impl.scm"))

srfi/171/meta.sld

@@ -21,7 +21,8 @@
           vector-reduce
           string-reduce
           bytevector-u8-reduce
-          port-reduce)
+          port-reduce
+          generator-reduce)
 
   (include "../srfi-171-meta.scm"))
 

srfi/srfi-171-meta.scm

@@ -83,3 +83,12 @@
           (if (reduced? acc)
               (unreduce acc)
               (loop (reader port) acc))))))
+
+(define (generator-reduce f identity gen)
+  (let loop ((val (gen)) (acc identity))
+    (if (eof-object? val)
+        acc
+        (let ((acc (f acc val)))
+          (if (reduced? acc)
+              (unreduce acc)
+              (loop (gen) acc))))))

srfi/srfi-171.scm

@@ -23,7 +23,13 @@
                   rcount
                   rany
                   revery
-                  list-transduce vector-transduce string-transduce bytevector-u8transduce port-transduce
+                  list-transduce
+                  vector-transduce
+                  string-transduce
+                  bytevector-u8transduce
+                  port-transduce
+                  generator-transduce
+                  
                   tmap
                   tfilter
                   tremove

srfi/srfi-171/meta.scm

@@ -25,7 +25,8 @@
             vector-reduce
             string-reduce
             bytevector-u8-reduce
-            port-reduce))
+            port-reduce
+            generator-reduce))
 
 (include "../srfi-171-meta.scm")
 

tests-r7rs.scm

@@ -4,7 +4,7 @@
 (import (scheme base)
         (scheme char)
         (scheme list)
-	(scheme read)
+        (scheme read)
         (srfi 171))
 (cond-expand
  (gauche (import (only (gauche base) compose)