allowing strings for decimal-sep; s/fn-fork/forked/g

lib/chibi/show.sld

@@ -1,7 +1,7 @@
 
 (define-library (chibi show)
   (export
-   show fn fn-fork with with! each each-in-list call-with-output
+   show fn forked with with! each each-in-list call-with-output
    displayed written written-shared written-simply
    numeric numeric/comma numeric/si numeric/fitted
    nothing nl fl space-to tab-to escaped maybe-escaped

lib/chibi/show/base.scm

@@ -12,7 +12,7 @@
 (define-environment-monad Show-Env
   (sequence: sequence)
   (bind: %fn)
-  (bind-fork: fn-fork)
+  (bind-fork: forked)
   (local: %with)
   (local!: with!)
   (return: return)
@@ -139,5 +139,5 @@
 ;;> \var{consumer}.
 (define (call-with-output producer consumer)
   (let ((out (open-output-string)))
-    (fn-fork (with ((port out) (output output-default)) producer)
+    (forked (with ((port out) (output output-default)) producer)
-             (fn () (consumer (get-output-string out))))))
+            (fn () (consumer (get-output-string out))))))

lib/chibi/show/base.sld

@@ -1,7 +1,7 @@
 
 (define-library (chibi show base)
   (export
-   show fn fn-fork with with! each each-in-list call-with-output
+   show fn forked with with! each each-in-list call-with-output
    displayed written written-shared written-simply numeric nothing
    escaped maybe-escaped numeric/si numeric/fitted numeric/comma
    ;; internal

lib/chibi/show/column.scm

@@ -48,14 +48,14 @@
         (if (list-queue-empty? queue)
             eof
             (list-queue-remove-front! queue)))
-      (fn-fork (fn () (with ((port out) (output output*))
+      (forked (fn () (with ((port out) (output output*))
-                        (call-with-current-continuation
+                       (call-with-current-continuation
-                         (lambda (cc)
+                        (lambda (cc)
-                           (set! return cc)
+                          (set! return cc)
-                           (each producer
+                          (each producer
-                                 (fn (output)
+                                (fn (output)
-                                   (set! resume #f)
+                                  (set! resume #f)
-                                   (fn () (return nothing) nothing)))))))
+                                  (fn () (return nothing) nothing)))))))
                (consumer generate)))))
 
 (define (call-with-output-generators producers consumer)

lib/chibi/show/pretty.scm

@@ -64,7 +64,7 @@
                          (abort fail))
                         (else
                          (output-default str)))))))))
-         (fn-fork
+         (forked
           (with ((output output*)
                  (port out))
             proc)

lib/chibi/show/write.scm

@@ -14,7 +14,7 @@
 (define (string-replace-all str ch1 ch2)
   (let ((out (open-output-string)))
     (string-for-each
-     (lambda (ch) (write-char (if (eqv? ch ch1) ch2 ch) out))
+     (lambda (ch) (display (if (eqv? ch ch1) ch2 ch) out))
      str)
     (get-output-string out)))
 
@@ -126,7 +126,10 @@
              (comma-rule (default comma comma-rule))
              (comma-sep (default commasep comma-sep))
              (dec-sep (default decsep
-                        (or decimal-sep (if (eqv? comma-sep #\.) #\, #\.)))))
+                        (or decimal-sep (if (eqv? comma-sep #\.) #\, #\.))))
+             (dec-ls (if (char? dec-sep)
+                         (list dec-sep)
+                         (reverse (string->list dec-sep)))))
         ;; General formatting utilities.
         (define (get-scale q)
           (expt radix (- (integer-log q radix) 1)))
@@ -164,7 +167,9 @@
               (let lp ((res res))
                 (cond
                  ((and (pair? res) (eqv? 0 (car res))) (lp (cdr res)))
-                 ((and (pair? res) (eqv? dec-sep (car res)))
+                 ((and (pair? res)
+                       (eqv? (car dec-ls) (car res))
+                       (null? (cdr dec-ls)))
                   (if inexact?
                       (cons 0 res)      ; "1.0"
                       (cdr res)))       ; "1"
@@ -185,7 +190,7 @@
                ;; 15 decimals.
                ((if precision (< i precision) (< i 16))
                 (let ((res (if (zero? i)
-                               (cons dec-sep (if (null? res) (cons 0 res) res))
+                               (append dec-ls (if (null? res) (cons 0 res) res))
                                res))
                       (q (quotient n d)))
                   (cond
@@ -218,7 +223,8 @@
                ((string-cursor<? (string-find s #\e) end)
                 (gen-general n))
                ((string-cursor=? dec end)
-                (string-append s "." (make-string precision #\0)))
+                (string-append s (if (char? dec-sep) (string dec-sep) dec-sep)
+                               (make-string precision #\0)))
                ((<= digits precision)
                 (string-append s (make-string (- precision digits -1) #\0)))
                (else
@@ -258,7 +264,10 @@
             (gen-general n))))
         ;; Insert commas according to the current comma-rule.
         (define (insert-commas str)
-          (let* ((dec-pos (string-find str dec-sep))
+          (let* ((dec-pos (if (string? dec-sep)
+                              (or (string-contains str dec-sep)
+                                  (string-cursor-end str))
+                              (string-find str dec-sep)))
                  (left (substring-cursor str (string-cursor-start str) dec-pos))
                  (right (substring-cursor str dec-pos))
                  (sep (cond ((char? comma-sep) (string comma-sep))
@@ -272,10 +281,10 @@
         ;; and commas as needed.
         (define (wrap-comma n)
           (let* ((s0 (gen-positive-real n))
-                 (s1 (if (and (char? dec-sep)
+                 (s1 (if (or (eqv? #\. dec-sep)
-                              (not (eqv? #\. dec-sep)))
+                             (equal? "." dec-sep))
-                         (string-replace-all s0 #\. dec-sep)
+                         s0
-                         s0)))
+                         (string-replace-all s0 #\. dec-sep))))
             (if comma-rule (insert-commas s1) s1)))
         ;; Wrap the sign of a real number, forcing a + prefix or using
         ;; parentheses (n) for negatives according to sign-rule.
@@ -307,7 +316,12 @@
         (define (format n sign-rule)
           (let ((s (wrap-sign n sign-rule)))
             (let* ((dec-pos (if decimal-align
-                                (string-cursor->index s (string-find s dec-sep))
+                                (string-cursor->index
+                                 s
+                                 (if (char? dec-sep)
+                                     (string-find s dec-sep)
+                                     (or (string-contains s dec-sep)
+                                         (string-cursor-end s))))
                                 0))
                    (diff (- (or decimal-align 0) dec-pos 1)))
               (if (positive? diff)

lib/srfi/159.sld

@@ -4,7 +4,7 @@
           (srfi 159 unicode) (srfi 159 color))
   (export
    ;; base
-   show fn fn-fork with with! each each-in-list call-with-output
+   show fn forked with with! each each-in-list call-with-output
    displayed written written-shared written-simply
    numeric numeric/comma numeric/si numeric/fitted
    nothing nl fl space-to tab-to escaped maybe-escaped

lib/srfi/159/base.sld

@@ -2,7 +2,7 @@
 (define-library (srfi 159 base)
   (import (chibi show))
   (export
-   show fn fn-fork with with! each each-in-list call-with-output
+   show fn forked with with! each each-in-list call-with-output
    displayed written written-shared written-simply
    numeric numeric/comma numeric/si numeric/fitted
    nothing nl fl space-to tab-to escaped maybe-escaped