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

allow proper list for comma-rule

Browse source
This commit is contained in:
Alex Shinn 2019-03-11 23:51:42 +08:00
parent bd78ebeed7
commit 956e7ba761
2 changed files with 14 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lib/chibi/show-test.sld
View file

@ -136,7 +136,7 @@
(test "299792458" (show #f (with ((comma-rule 3)) 299792458))) (test "299792458" (show #f (with ((comma-rule 3)) 299792458)))
(test "299,792,458" (show #f (with ((comma-rule 3)) (numeric 299792458)))) (test "299,792,458" (show #f (with ((comma-rule 3)) (numeric 299792458))))
(test "-29,97,92,458" (test "-29,97,92,458"
(show #f (with ((comma-rule '(3 . 2))) (numeric -299792458)))) (show #f (with ((comma-rule '(3 2))) (numeric -299792458))))
(test "299.792.458" (test "299.792.458"
(show #f (with ((comma-rule 3) (comma-sep #\.)) (numeric 299792458)))) (show #f (with ((comma-rule 3) (comma-sep #\.)) (numeric 299792458))))
(test "299.792.458,0" (test "299.792.458,0"
@ -231,6 +231,7 @@
(test "1,234,567" (show #f (numeric 1234567 10 #f #f 3))) (test "1,234,567" (show #f (numeric 1234567 10 #f #f 3)))
(test "567" (show #f (numeric 567 10 #f #f 3))) (test "567" (show #f (numeric 567 10 #f #f 3)))
(test "1,23,45,67" (show #f (numeric 1234567 10 #f #f 2))) (test "1,23,45,67" (show #f (numeric 1234567 10 #f #f 2)))
(test "12,34,567" (show #f (numeric 1234567 10 #f #f '(3 2))))
;; comma-sep ;; comma-sep
(test "1|234|567" (show #f (numeric 1234567 10 #f #f 3 #\|))) (test "1|234|567" (show #f (numeric 1234567 10 #f #f 3 #\|)))

23
lib/chibi/show/write.scm
View file

@ -1,5 +1,5 @@
;; write.scm - written formatting, the default displayed for non-string/chars ;; write.scm - written formatting, the default displayed for non-string/chars
;; Copyright (c) 2006-2013 Alex Shinn. All rights reserved. ;; Copyright (c) 2006-2019 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt ;; BSD-style license: http://synthcode.com/license.txt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -19,16 +19,17 @@
(get-output-string out))) (get-output-string out)))
(define (string-intersperse-right str sep rule) (define (string-intersperse-right str sep rule)
(let lp ((i (string-length str)) (let ((start (string-cursor-start str)))
(rule rule) (let lp ((i (string-cursor-end str))
(res '())) (rule rule)
(let* ((offset (if (pair? rule) (car rule) rule)) (res '()))
(i2 (if offset (- i offset) 0))) (let* ((offset (if (pair? rule) (car rule) rule))
(if (<= i2 0) (i2 (if offset (string-cursor-back str i offset) start)))
(apply string-append (cons (substring str 0 i) res)) (if (string-cursor<=? i2 start)
(lp i2 (apply string-append (cons (substring-cursor str start i) res))
(if (pair? rule) (cdr rule) rule) (lp i2
(cons sep (cons (substring str i2 i) res))))))) (if (and (pair? rule) (not (null? (cdr rule)))) (cdr rule) rule)
(cons sep (cons (substring-cursor str i2 i) res))))))))
;;> Outputs the string str, escaping any quote or escape characters. ;;> Outputs the string str, escaping any quote or escape characters.
;;> If esc-ch, which defaults to #\\, is #f, escapes only the ;;> If esc-ch, which defaults to #\\, is #f, escapes only the