Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

comments from adam nelson: fixing numeric/comma arg, wrapped doesn't append final newline

Browse source
This commit is contained in:
Alex Shinn 2020-07-20 17:41:34 +09:00
parent 58f6509c6f
commit bde8a618ec
3 changed files with 17 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lib/srfi/166/column.scm
View file

@ -312,7 +312,7 @@
;; break lines only, don't join short lines or justify
(define (wrapped/char . ls)
(fn ((orig-output output) width string-width)
(fn ((orig-output output) width string-width substring/width)
(define (kons-in-line str)
(fn (col)
(let ((len ((or string-width string-length) str))
@ -326,9 +326,9 @@
(each
;; TODO: when splitting by string-width, substring needs
;; to be provided
(orig-output (substring str 0 space))
(orig-output (substring/width str 0 space))
(orig-output "\n")
(fn () (kons-in-line (substring str space len)))))))))
(fn () (kons-in-line (substring/width str space len)))))))))
(with ((output
(lambda (str)
(let ((end (string-cursor-end str)))
@ -411,7 +411,7 @@
(define (wrapped/list ls)
(fn (width string-width pad-char)
(joined/suffix
(joined
(lambda (ls) (joined displayed ls pad-char))
(reverse
(wrap-fold-words ls '() width (or string-width string-length) cons))

15
lib/srfi/166/test.sld
View file

@ -281,6 +281,8 @@
(test "1.2 µm" (show #f (numeric/si 1.23e-6 1000 " ") "m"))
(test "1,234,567" (show #f (numeric/comma 1234567)))
(test "1,234,567" (show #f (numeric/comma 1234567 3)))
(test "123,4567" (show #f (numeric/comma 1234567 4)))
(test "1.23" (show #f (numeric/fitted 4 1.2345 10 2)))
(test "1.00" (show #f (numeric/fitted 4 1 10 2)))
@ -606,9 +608,9 @@
"abc\ndef\n")
(list displayed "123\n456\n"))))
(test "hello\nworld\n"
(test "hello\nworld"
(show #f (with ((width 8)) (wrapped "hello world"))))
(test "\n" (show #f (wrapped " ")))
(test "" (show #f (wrapped " ")))
(test
"The quick
@ -627,8 +629,7 @@ Applies KONS to each element of
LS and the result of the previous
application, beginning with KNIL.
With KONS as CONS and KNIL as '(),
equivalent to REVERSE.
"
equivalent to REVERSE."
(show #f
(with ((width 36))
(wrapped "The fundamental list iterator. Applies KONS to each element of LS and the result of the previous application, beginning with KNIL. With KONS as CONS and KNIL as '(), equivalent to REVERSE."))))
@ -674,6 +675,12 @@ equivalent to REVERSE.
(with ((width 36))
(wrapped "The fundamental list iterator. Applies KONS to each element of LS and the result of the previous application, beginning with KNIL. With KONS as CONS and KNIL as '(), equivalent to REVERSE."))))))
(test "\n" (show #f (columnar))) ; degenerate case
(test "\n" (show #f (columnar "*"))) ; only infinite columns
(test "*\n" (show #f (columnar (each "*"))))
(test "foo" (show #f (wrapped "foo")))
(test
"(define (fold kons knil ls) ; The fundamental list iterator.
(let lp ((ls ls) (acc knil)) ; Applies KONS to each element of

4
lib/srfi/166/write.scm
View file

@ -408,8 +408,8 @@
(define (numeric/comma n . o)
(fn ((orig-comma-rule comma-rule))
(with ((comma-rule (or orig-comma-rule 3)))
(apply numeric n o))))
(with ((comma-rule (if (pair? o) (car o) (or orig-comma-rule 3))))
(apply numeric n (if (pair? o) (cdr o) '())))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; written