Merge pull request #885 from gambiteer/vector-fold

Add vector-fold{-right}, remove string-{any|every}

doc/gambit.txi

@@ -4112,83 +4112,72 @@ For example:
 
 @end deffn
 
-@deffn procedure string-set @var{string} @var{k} @var{char}
+@deffn procedure vector-fold @var{kons} @var{knil} @var{vec1} @var{vec2} @dots{}
 
-The procedure @code{string-set} returns a new copy of the string
-@var{string} with the character at index @var{k} replaced with
-@var{char}.
+The procedure @var{kons} is iterated over each value in all of the vectors, stopping at the end of the shortest; @var{kons} is applied as @code{(@var{kons} state (vector-ref @var{vec1} i) (vector-ref @var{vec2} i) @dots{})} where @code{state} is the current state value---the current state value begins with @var{knil}, and becomes whatever @var{kons} returned on the previous iteration---and @code{i} is the current index.
+The iteration is strictly increasing in the index @code{i}, starting at 0.
 
 For example:
 
 @smallexample
-> @b{(define s1 (string #\a #\b #\c #\d))}
-> @b{(define s2 (string-set s1 2 #\.))}
-> @b{s2}
-"ab.d"
-> @b{(eq? s1 s2)}
-#f
+> @b{(vector-fold (lambda (len str) (max (string-length str) len)) 0 '#("a b c" "ab" "" "cde"))}
+5
+> @b{(vector-fold xcons '() '#(a b c d))}
+(d c b a)
+> @b{(vector-fold (lambda (counter n) (if (even? n) (+ counter 1) counter)) 0 '#(0 1 2 3 4))}
+3
 @end smallexample
 
 @end deffn
 
-@deffn procedure string-swap! @var{string} @var{i} @var{j}
+@deffn procedure vector-fold-right @var{kons} @var{knil} @var{vec1} @var{vec2} @dots{}
 
-The procedure @code{string-swap!} swaps the characters at index @var{i}
-and index @var{j} of the string @var{string}.
+Similar to @code{vector-fold}, but strictly decreasing in the index.
 
 For example:
 
 @smallexample
-> @b{(define s1 (string #\a #\b #\c #\d #\e))}
-> @b{s1}
-"abcde"
-> @b{(string-swap! s1 0 4)}
-> @b{s1}
-"ebcda"
+> @b{(vector-fold-right xcons '() '#(a b c d))}
+(a b c d)
 @end smallexample
 
 @end deffn
 
-@deffn procedure string-any @var{pred} @var{s1} @var{s2} @dots{}
 
-The procedure @code{string-any} returns the first non-false value that
-the predicate @var{pred} returns when applied to the elements of the strings
-@var{s1} @var{s2} @dots{} in order, beginning with index 0 and
-stopping at the length of the shortest
-string argument. It returns @code{#f} if there is no such non-false value.
+
+@deffn procedure string-set @var{string} @var{k} @var{char}
+
+The procedure @code{string-set} returns a new copy of the string
+@var{string} with the character at index @var{k} replaced with
+@var{char}.
 
 For example:
 
 @smallexample
-> @b{(string-any char-ci=? "abc" "1B")}
-#t
-> @b{(string-any char=? "abc" "1B")}
-#f
-> @b{(string-any char-alphabetic? "")}
+> @b{(define s1 (string #\a #\b #\c #\d))}
+> @b{(define s2 (string-set s1 2 #\.))}
+> @b{s2}
+"ab.d"
+> @b{(eq? s1 s2)}
 #f
 @end smallexample
 
 @end deffn
 
-@deffn procedure string-every @var{pred} @var{s1} @var{s2} @dots{}
+@deffn procedure string-swap! @var{string} @var{i} @var{j}
 
-The procedure @code{string-every} applies
-the predicate @var{pred} to the elements of the strings
-@var{s1} @var{s2} @dots{} in order, beginning with index 0 and
-stopping at the length of the shortest
-string argument. If the result of @var{pred} is ever @code{#f}, that is
-returned; if the smallest string is empty, then @code{#t} is returned;
-otherwise, the last value of @var{pred} is returned.
+The procedure @code{string-swap!} swaps the characters at index @var{i}
+and index @var{j} of the string @var{string}.
 
 For example:
 
 @smallexample
-> @b{(string-every char-ci=? "abc" "aB")}
-#t
-> @b{(string-every char=? "abc" "aB")}
-#f
-> @b{(string-every char-alphabetic? "")}
-#t
+> @b{(define s1 (string #\a #\b #\c #\d #\e))}
+> @b{s1}
+"abcde"
+> @b{(string-swap! s1 0 4)}
+> @b{s1}
+"ebcda"
 @end smallexample
 
 @end deffn

lib/gambit#.scm

@@ -904,7 +904,6 @@ started-thread-exception-procedure
 started-thread-exception?
 step
 step-level-set!
-string-any
 string->char-set
 string->char-set!
 string->keyword
@@ -914,7 +913,6 @@ string-ci=?-hash
 string-concatenate
 string-contains
 string-contains-ci
-string-every
 string-prefix-ci?
 string-prefix-length
 string-prefix-length-ci
@@ -1176,6 +1174,8 @@ vector-any
 vector-cas!
 vector-concatenate
 vector-every
+vector-fold
+vector-fold-right
 vector-inc!
 vector-set
 vector-shrink!

lib/gambit/gambit.sld

@@ -1258,12 +1258,10 @@ string->char-set!
 string->keyword
 string->uninterned-keyword
 string->uninterned-symbol
-string-any
 string-ci=?-hash
 string-concatenate
 string-contains
 string-contains-ci
-string-every
 string-prefix-ci?
 string-prefix-length
 string-prefix-length-ci
@@ -1525,6 +1523,8 @@ vector-any
 vector-cas!
 vector-concatenate
 vector-every
+vector-fold
+vector-fold-right
 vector-inc!
 vector-set
 vector-shrink!

tests/unit-tests/07-vector/vector_fold.scm

@@ -0,0 +1,26 @@
+(include "#.scm")
+
+
+(check-equal? (vector-fold (lambda (len str)
+                             (max (string-length str) len))
+                           0
+                           '#("a b c" "ab" "" "cde"))
+              5)
+
+(check-equal? (vector-fold xcons
+                           '()
+                           '#(a b c d))
+              '(d c b a))
+(check-equal? (vector-fold (lambda (counter n)
+                             (if (even? n) (+ counter 1) counter))
+                           0
+                           '#(0 1 2 3 4))
+              3)
+
+(check-tail-exn type-exception? (lambda () (vector-fold 4 4 '#())))
+(check-tail-exn type-exception? (lambda () (vector-fold xcons 4 '())))
+(check-tail-exn type-exception? (lambda () (vector-fold xcons 4 '#()'())))
+
+(check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold)))
+(check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold xcons)))
+(check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold xcons 0)))

tests/unit-tests/07-vector/vector_fold_right.scm

@@ -0,0 +1,14 @@
+(include "#.scm")
+
+(check-equal? (vector-fold-right xcons
+                                 '()
+                                 '#(a b c d))
+              '(a b c d))
+
+(check-tail-exn type-exception? (lambda () (vector-fold-right 4 4 '#())))
+(check-tail-exn type-exception? (lambda () (vector-fold-right xcons 4 '())))
+(check-tail-exn type-exception? (lambda () (vector-fold-right xcons 4 '#()'())))
+
+(check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold-right)))
+(check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold-right xcons)))
+(check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold-right xcons 0)))