More tweaks, tests and docs

doc/reference/std/cli/print-exit.md

@@ -0,0 +1,99 @@
+# Print results and Exit
+
+The `:std/cli/print-exit` module helps you write functions that can be
+invoked either from the Scheme REPL or the Unix CLI, and in either case
+will print their computation results after their invocation.
+
+The facilities are named in a way reminiscent of REPL (Read-Eval-Print-Loop),
+except that instead of a form being Read and Eval'ed,
+a function is called or a body is evaluated as in `begin`,
+and after the Print part we Exit rather than Loop.
+
+::: tip usage
+(import :std/cli/print-exit)
+:::
+
+## Interface
+
+### value-printer
+```scheme
+(define value-printer (make-parameter prn))
+```
+This parameter will return a function called on each value received
+by `print-exit` or `print-values`
+(unless there is a single value `(void)` that isn't printed).
+
+Defaults to `prn`. You could instead use `writeln` or `displayln`.
+
+### print-values
+```scheme
+(print-values . vs) => (void)
+```
+Process a list of values `vs` from a previous computation
+(as per `(call-with-values thunk print-values)`), and
+print each of those values (as applicable) using `(value-printer)`,
+unless there is a single value that is `(void)`
+in which case don't print anything
+(also don't print anything if provided no values as per `(values)`).
+
+Any values but `(void)` and `(values)` will thus cause the values to be printed,
+one by one, using `(value-printer)`, similar to how the Scheme REPL works.
+However, the Scheme REPL would use [`writeln`](../misc/ports.md#writeln) as its
+value printer, but the default `(value-printer)` above is
+[`prn`](../misc/repr.md#prn) which we found to be more useful in this situation.
+
+
+### print-exit
+```scheme
+(print-exit . vs) => [exit]
+```
+
+Process a list of values `vs` from a previous computation
+(as per `(call-with-values thunk print-exit)`), and
+(1) print those values using `print-values`, then
+(2) exit with an according exit code.
+
+Any values but `#f` and `(values)` will cause the exit code 0 to be returned,
+which the Unix shell will interpret as success or true.
+The values `#f` and `(values)` will cause the exit code 1 to be returned,
+which the Unix shell will interpret as failure or false.
+
+The value `(void)` will thus indicate a silent success,
+wherein nothing is printed and success is assumed, as is customary in Scheme.
+The value `(values)` meanwhile will thus indicate a silent failure,
+wherein nothing is printed and failure is assumed, of which however
+only the first part (nothing printed) is customary in Scheme, whereas the
+failure assumed is not customary in Scheme (but a false value would be assumed in e.g. CL).
+
+### silent-exit
+```scheme
+(silent-exit success?) => void-or-values
+```
+
+Takes a boolean `success?` and returns a multiple values
+that when passed to `print-exit` will not be printed, yet
+will cause return an error code that the Unix shell will interpret
+as success or true if the boolean is true, and
+failure or false if the boolean is false.
+
+`(void)` is the silent true exit returned if `success?` is true,
+and `(values)` is the silent false exit returned if it is false.
+
+### call-print-exit
+```scheme
+(call-print-exit fun) => [exit]
+```
+Call a function, print the resulting values (if applicable),
+and exit with an according exit code, as per `print-exit`.
+If an error occurs during execution,
+abort with an error code as per `with-abort-on-error`.
+
+### begin-print-exit
+```scheme
+(begin-print-exit body ...) => [exit]
+```
+Evaluates the `body` as in an anonymous function called by `call-print-exit`.
+
+This macro is named in a way reminiscent of REPL (Read-Eval-Print-Loop),
+except instead of a form being Read and Eval'ed, the body is evaluated
+like `begin`, and after the Print part it Exits rather than Loops.

doc/reference/std/misc/string.md

@@ -184,6 +184,109 @@ perform, otherwise an error is signaled.
 ```
 :::
 
+## string-substitute-char-if
+``` scheme
+(string-substitute-char-if string newchar predicate
+  [start: #f]
+  [end: #f]
+  [from-end: #f]
+  [count: #f]
+  [in-place: #f]) => string-with-substitutions
+```
+
+Substitutes/replaces in *string* the characters matching the *predicate*
+with the character *newchar*.
+
+Only substitute characters in the substring
+defined by the *start* index (included, defaults to `0`) and
+the *end* index (excluded, defaults to the length of the string).
+
+The replacement starts *from-end* if specified as true,
+which only matters if *count* is specified, in which case,
+that *count* is a maximum limit on the number of replacements to be done.
+
+If *in-place* is true then the string itself is modified,
+otherwise a modified copy is made.
+
+::: tip Examples:
+``` scheme
+> (string-substitute-char-if "banana" #\o (cut eqv? #\a <>))
+"bonono"
+> (string-substitute-char-if "banana" #\o (cut eqv? #\a <>) start: 3)
+"banono"
+> (string-substitute-char-if "banana" #\o (cut eqv? #\a <>) end: 5)
+"bonona"
+> (string-substitute-char-if "banana" #\o (cut eqv? #\a <>)start: 1 end: 5)
+"bonona"
+> (string-substitute-char-if "banana" #\o (cut eqv? #\a <>) count: 2)
+"bonona"
+> (string-substitute-char-if "banana" #\o (cut eqv? #\a <>) count: 2 from-end: #t)
+"banono"
+> (string-substitute-char-if "banana" #\o (cut char>? #\c <>))
+"oonono"
+> (string-substitute-char-if "banana" #\o (lambda (x) (not (equal? x #\a))))
+"oaoaoa"
+> (string-substitute-char-if "banana" #\o (lambda (x) (equal? (char-upcase x) #\A)))
+"bonono"
+```
+:::
+
+## string-substitute-char
+``` scheme
+(string-substitute-char-if string newchar oldchar
+  [test: #f]
+  [test-not: #f]
+  [key: #f]
+  [start: #f]
+  [end: #f]
+  [from-end: #f]
+  [count: #f]
+  [in-place: #f]) => string-with-substitutions
+```
+
+Substitutes/replaces in *string* the characters matching the *oldchar*
+with the character *newchar*.
+
+A character *char* matches if `(test oldchar (key char))`, where:
+  - for *key*, `#f` designates the `identity` function
+  - if `test` is `#f` and `test-not` isn't, then the test is
+    `(lambda (x y) (not (test-not x y)))`
+  - if both `test` and `test-not` are `#f`, then the test is `equal?`.
+
+Only substitute characters in the substring
+defined by the *start* index (included, defaults to `0`) and
+the *end* index (excluded, defaults to the length of the string).
+
+The replacement starts *from-end* if specified as true,
+which only matters if *count* is specified, in which case,
+that *count* is a maximum limit on the number of replacements to be done.
+
+If *in-place* is true then the string itself is modified,
+otherwise a modified copy is made.
+
+::: tip Examples:
+``` scheme
+> (string-substitute-char "banana" #\o #\a)
+"bonono"
+> (string-substitute-char "banana" #\o #\a start: 3)
+"banono"
+> (string-substitute-char "banana" #\o #\a end: 5)
+"bonona"
+> (string-substitute-char "banana" #\o #\a start: 1 end: 5)
+"bonona"
+> (string-substitute-char "banana" #\o #\a count: 2)
+"bonona"
+> (string-substitute-char "banana" #\o #\a count: 2 from-end: #t)
+"banono"
+> (string-substitute-char "banana" #\o #\c test: char>?)
+"oonono"
+> (string-substitute-char "banana" #\o #\a test-not: equal?)
+"oaoaoa"
+> (string-substitute-char "banana" #\o #\A key: char-upcase)
+"bonono"
+```
+:::
+
 ## string-whitespace?
 ``` scheme
 (string-whitespace? str) -> boolean
@@ -297,3 +400,19 @@ used by the `:std/format` family of procedures. Considers the `:pr`
 ```
 
 Global line ending convenience definitions.
+
+## as-string<?
+``` scheme
+(as-string<? x y) -> bool
+```
+`as-string<?` takes two values that can be converted to strings via `as-string`
+and returns true if once converted the first is `string<?` to the second.
+
+::: tip Examples:
+``` scheme
+> (as-string<? '(foo: 1 bar) #(f #\o "o1" baz))
+#t
+> (as-string<? 'foo "foo")
+#f
+```
+:::

src/std/cli/multicall.ss

@@ -4,7 +4,7 @@
 (export #t)
 
 (import
-  (only-in :std/cli/print-exit eval-print-exit)
+  (only-in :std/cli/print-exit begin-print-exit)
   (only-in :std/cli/shell easy-shell-character?)
   (only-in :std/format format)
   (only-in :std/generic defgeneric)
@@ -92,7 +92,7 @@
        (call-with-processed-command-line getopt args fun)))))
 
 (def (call-entry-point . args)
-  (eval-print-exit
+  (begin-print-exit
    (match args
      ([] (call-entry-point/internal multicall-default []))
      ([command . args] (call-entry-point/internal command args)))))

src/std/cli/print-exit.ss

@@ -13,11 +13,15 @@
 
 (def value-printer (make-parameter prn))
 
-;; Print resulting values, and exit with an according value.
-(def (print-exit . vs)
+(def (print-values . vs)
   (unless (equal? vs [(void)])
     (for-each (value-printer) vs))
   (ignore-errors (force-current-outputs))
+  (void))
+
+;; Print resulting values, and exit with an according value.
+(def (print-exit . vs)
+  (apply print-values vs)
   (exit (if (or (null? vs) (and (length=n? vs 1) (not (car vs)))) 1 0)))
 
 ;; Return a magic value that will be not be printed but will return an error code.
@@ -26,7 +30,7 @@
 (def (silent-exit (bool #t))
   (if bool (void) (values)))
 
-;; Execute a function, print the result (if application), and exit with an according value.
+;; Execute a function, print the result (if applicable), and exit with an according value.
 ;;
 ;; (void) prints nothing and counts as false. #f is printed and counts as false.
 ;; (values) prints nothing and counts as true. All other values are printed and count as true.
@@ -37,4 +41,8 @@
 (def (call-print-exit fun)
   (with-abort-on-error (call/values fun print-exit)))
 
-(defrule (eval-print-exit body ...) (call-print-exit (lambda () body ...)))
+;; Evaluate the body ... as in an anonymous function called by `call-print-exit`
+;; This macro is named in a way reminiscent of REPL (Read-Eval-Print-Loop),
+;; except instead of Read-Eval it evaluates forms like `begin`, and
+;; after the Print part it Exits rather than Loops.
+(defrule (begin-print-exit body ...) (call-print-exit (lambda () body ...)))

src/std/misc/string-test.ss

@@ -2,9 +2,13 @@
 
 (import
   :std/error
-  :std/misc/string :std/srfi/13
-  :std/test
-  :std/pregexp :std/misc/repr :std/sugar :std/format)
+  :std/format
+  :std/misc/repr
+  :std/misc/string
+  :std/pregexp
+  :std/srfi/13
+  :std/sugar
+  :std/test)
 
 (defstruct point (x y))
 (defmethod {:pr point}
@@ -81,14 +85,26 @@
       (check (str #(1 2))             => "(vector 1 2)")
       (check (str (values 1 2))       => "(values 1 2)")
       (check (str (make-point 1 2))   => "(point 1 2)"))
-    (test-case "test string-substitute-char"
-      (check-equal? (string-substitute-char "banana" #\o #\a) "bonono")
-      (check-equal? (string-substitute-char "banana" #\o #\a start: 3) "banono")
-      (check-equal? (string-substitute-char "banana" #\o #\a end: 5) "bonona")
-      (check-equal? (string-substitute-char "banana" #\o #\a start: 1 end: 5) "bonona")
-      (check-equal? (string-substitute-char "banana" #\o #\a count: 2) "bonona")
-      (check-equal? (string-substitute-char "banana" #\o #\a count: 2 from-end: #t) "banono")
-      (check-equal? (string-substitute-char "banana" #\o #\c test: char>?) "oonono")
-      (check-equal? (string-substitute-char "banana" #\o #\a test-not: equal?) "oaoaoa")
-      (check-equal? (string-substitute-char "banana" #\o #\A key: char-upcase) "bonono"))
-    ))
+    (test-case "test string-substitute-char-if, string-substitute-char"
+      (defrule (checks ((args ...) result) ...)
+        (begin (begin (check (string-substitute-char "banana" #\o #\a args ...)
+                             => result)
+                      (check (string-substitute-char-if "banana" #\o (cut eqv? <> #\a) args ...)
+                             => result)) ...))
+      (checks (() "bonono")
+              ((start: 3) "banono")
+              ((end: 5) "bonona")
+              ((start: 1 end: 5) "bonona")
+              ((count: 2) "bonona")
+              ((count: 2 from-end: #t) "banono"))
+      (defrule (checks2 ((args ...) pred result) ...)
+        (begin (begin (check (string-substitute-char "banana" #\o args ...)
+                             => result)
+                      (check (string-substitute-char-if "banana" #\o pred)
+                             => result)) ...))
+      (checks2 ((#\c test: char>?) (cut char>? #\c <>) "oonono")
+               ((#\a test-not: equal?) (lambda (x) (not (equal? x #\a))) "oaoaoa")
+               ((#\A key: char-upcase) (lambda (x) (equal? (char-upcase x) #\A)) "bonono")))
+    (test-case "test as-string<?"
+      (check (as-string<? '(foo: 1 bar) #(f #\o "o1" baz)) => #t)
+      (check (as-string<? 'foo "foo") => #f))))

src/std/misc/string.ss

@@ -10,6 +10,7 @@
   string-trim-eol
   string-subst
   string-substitute-char
+  string-substitute-char-if
   string-whitespace?
   random-string
   str str-format
@@ -18,11 +19,11 @@
 
 (import
   (only-in :gerbil/gambit write-substring write-string random-integer)
-  :std/error
-  :std/srfi/13
-  :std/format
-  :std/iter
-  ./number)
+  (only-in :std/error raise-bad-argument)
+  (only-in :std/srfi/13 string-every string-suffix? string-drop-right string-drop)
+  (only-in :std/format format fprintf)
+  (only-in :std/iter for in-range)
+  (only-in ./number decrement!))
 
 ;; If the string starts with given prefix, return the end of the string after the prefix.
 ;; Otherwise, return the entire string. NB: Only remove the prefix once.
@@ -301,7 +302,7 @@
           (cond
            (test (lambda (x) (test oldchar (key x))))
            (test-not (lambda (x) (not (test-not oldchar (key x)))))
-           (key (lambda (x) (eqv? oldchar (key x))))
+           (key (lambda (x) (equal? oldchar (key x))))
            (else (cut eqv? oldchar <>)))))
     (string-substitute-char-if
      string newchar predicate