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 (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))))
(- end start))) (- 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 ;;> Raw output - displays str to the formatter output port and updates
;;> row and col. ;;> row and col.
(define (output-default str) (define (output-default str)
(fn (port (r row) (c col) string-width) (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) (write-string str port)
(if (string-cursor>? nl-index (string-cursor-start str)) (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)))) (col (string-width str (string-cursor->index str nl-index))))
(with! (col (+ c (string-width str)))))))) (with! (col (+ c (string-width str))))))))

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

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

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

@ -7,7 +7,8 @@
(srfi 117) (srfi 117)
(srfi 130) (srfi 130)
(srfi 166 base) (srfi 166 base)
(chibi optional) (chibi optional))
) (export
(export-all) columnar tabular wrapped wrapped/list wrapped/char
justified from-file line-numbers show-columns)
(include "column.scm")) (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-space n) (make-string n #\space))
(define (make-nl-space n) (string-append "\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) (define (joined/shares fmt ls shares . o)
(let ((sep (displayed (if (pair? o) (car o) " ")))) (let ((sep (displayed (if (pair? o) (car o) " "))))
(fn () (fn ()
@ -40,7 +47,7 @@
(define (string-find/index str pred i) (define (string-find/index str pred i)
(string-cursor->index (string-cursor->index
str str
(string-find str pred (string-index->cursor str i)))) (string-index str pred (string-index->cursor str i))))
(define (write-to-string x) (define (write-to-string x)
(call-with-output-string (lambda (out) (write x out)))) (call-with-output-string (lambda (out) (write x out))))

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

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

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

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