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

replace (chibi string) with (srfi 130) in (srfi 166)

Browse source
This commit is contained in:
Alex Shinn 2020-06-18 00:00:45 +09:00
parent 402e3c8fb1
commit afb4a432c9
6 changed files with 39 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
lib/srfi/166/base.scm
View file

@ -17,14 +17,21 @@
(end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))))
(- end start)))
(define (call-with-output-string proc)
(let ((out (open-output-string)))
(proc out)
(let ((res (get-output-string out)))
(close-output-port out)
res)))
;;> Raw output - displays str to the formatter output port and updates
;;> row and col.
(define (output-default str)
(fn (port (r row) (c col) string-width)
(let ((nl-index (string-find-right str #\newline)))
(let ((nl-index (string-index-right str #\newline)))
(write-string str port)
(if (string-cursor>? nl-index (string-cursor-start str))
(with! (row (+ r (string-count str #\newline)))
(with! (row (+ r (string-count str (lambda (ch) (eqv? ch #\newline)))))
(col (string-width str (string-cursor->index str nl-index))))
(with! (col (+ c (string-width str))))))))

7
lib/srfi/166/base.sld
View file

@ -7,13 +7,12 @@
(scheme inexact)
(srfi 1)
(srfi 69)
(chibi show shared)
(chibi string)
(srfi 130)
(rename (srfi 165)
(computation-each sequence)
(computation-with! with!)
(computation-forked forked)
))
(computation-forked forked))
(chibi show shared))
(cond-expand
(chibi
(import (only (chibi) let-optionals*)))

7
lib/srfi/166/columnar.sld
View file

@ -7,7 +7,8 @@
(srfi 117)
(srfi 130)
(srfi 166 base)
(chibi optional)
)
(export-all)
(chibi optional))
(export
columnar tabular wrapped wrapped/list wrapped/char
justified from-file line-numbers show-columns)
(include "column.scm"))

9
lib/srfi/166/pretty.scm
View file

@ -18,6 +18,13 @@
(define (make-space n) (make-string n #\space))
(define (make-nl-space n) (string-append "\n" (make-string n #\space)))
(define (call-with-output-string proc)
(let ((out (open-output-string)))
(proc out)
(let ((res (get-output-string out)))
(close-output-port out)
res)))
(define (joined/shares fmt ls shares . o)
(let ((sep (displayed (if (pair? o) (car o) " "))))
(fn ()
@ -40,7 +47,7 @@
(define (string-find/index str pred i)
(string-cursor->index
str
(string-find str pred (string-index->cursor str i))))
(string-index str pred (string-index->cursor str i))))
(define (write-to-string x)
(call-with-output-string (lambda (out) (write x out))))

2
lib/srfi/166/pretty.sld
View file

@ -4,9 +4,9 @@
(scheme char)
(scheme write)
(chibi show shared)
(chibi string)
(srfi 1)
(srfi 69)
(srfi 130)
(srfi 166 base))
(export pretty pretty-shared pretty-simply pretty-color)
(include "pretty.scm"))

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

@ -24,10 +24,10 @@
(let* ((offset (if (pair? rule) (car rule) rule))
(i2 (if offset (string-cursor-back str i offset) start)))
(if (string-cursor<=? i2 start)
(apply string-append (cons (substring-cursor str start i) res))
(apply string-append (cons (substring/cursors str start i) res))
(lp i2
(if (and (pair? rule) (not (null? (cdr rule)))) (cdr rule) rule)
(cons sep (cons (substring-cursor str i2 i) res))))))))
(cons sep (cons (substring/cursors str i2 i) res))))))))
;;> Outputs the string str, escaping any quote or escape characters.
;;> If esc-ch, which defaults to #\\, is #f, escapes only the
@ -49,10 +49,10 @@
(end (string-cursor-end str)))
(let lp ((i start) (j start))
(define (collect)
(if (eq? i j) "" (substring-cursor str i j)))
(if (eq? i j) "" (substring/cursors str i j)))
(if (string-cursor>=? j end)
(orig-output (collect))
(let ((c (string-cursor-ref str j))
(let ((c (string-ref/cursor str j))
(j2 (string-cursor-next str j)))
(cond
((or (eqv? c quot) (eqv? c esc))
@ -84,7 +84,7 @@
(call-with-output
fmt
(lambda (str)
(if (string-cursor<? (string-find str esc?) (string-cursor-end str))
(if (string-cursor<? (string-index str esc?) (string-cursor-end str))
(each quot (escaped str quot esc rename) quot)
(displayed str))))))
@ -215,11 +215,11 @@
((and (eqv? radix 10) (or (integer? n) (inexact? n)))
(let* ((s (number->string n))
(end (string-cursor-end s))
(dec (string-find s #\.))
(dec (string-index s #\.))
(digits (- (string-cursor->index s end)
(string-cursor->index s dec))))
(cond
((string-cursor<? (string-find s #\e) end)
((string-cursor<? (string-index s #\e) end)
(gen-general n))
((string-cursor=? dec end)
(string-append s (if (char? dec-sep) (string dec-sep) dec-sep)
@ -229,15 +229,15 @@
(else
(let* ((last
(string-cursor-back s end (- digits precision 1)))
(res (substring-cursor s (string-cursor-start s) last)))
(res (substring/cursors s (string-cursor-start s) last)))
(if (and
(string-cursor<? last end)
(let ((next (digit-value (string-cursor-ref s last))))
(let ((next (digit-value (string-ref/cursor s last))))
(or (> next 5)
(and (= next 5)
(string-cursor>? last (string-cursor-start s))
(memv (digit-value
(string-cursor-ref
(string-ref/cursor
s (string-cursor-prev s last)))
'(1 3 5 7 9))))))
(list->string
@ -262,9 +262,9 @@
(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))
(string-index str dec-sep)))
(left (substring/cursors str (string-cursor-start str) dec-pos))
(right (string-copy/cursors str dec-pos))
(sep (cond ((char? comma-sep) (string comma-sep))
((string? comma-sep) comma-sep)
((eqv? #\, dec-sep) ".")
@ -326,7 +326,7 @@
(string-cursor->index
s
(if (char? dec-sep)
(string-find s dec-sep)
(string-index s dec-sep)
(or (string-contains s dec-sep)
(string-cursor-end s))))
0))