mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
102 lines
3.9 KiB
Scheme
102 lines
3.9 KiB
Scheme
|
|
;;> A cursor-oriented string library. Provides efficient string
|
|
;;> utilities for implementations with or without fast random-access
|
|
;;> strings.
|
|
|
|
(define-library (chibi string)
|
|
(export
|
|
string-cursor?
|
|
string-cursor-start string-cursor-end string-cursor-ref
|
|
string-cursor<? string-cursor<=? string-cursor>? string-cursor>=?
|
|
string-cursor=? string-cursor-next string-cursor-prev substring-cursor
|
|
string-cursor->index string-index->cursor
|
|
string-cursor-forward string-cursor-back
|
|
string-null? string-every string-any
|
|
string-join string-split string-count
|
|
string-trim string-trim-left string-trim-right
|
|
string-mismatch string-mismatch-right
|
|
string-prefix? string-suffix?
|
|
string-find string-find-right string-find? string-skip string-skip-right
|
|
string-fold string-fold-right string-map string-for-each
|
|
string-contains make-string-searcher
|
|
string-downcase-ascii string-upcase-ascii
|
|
call-with-input-string call-with-output-string)
|
|
(cond-expand
|
|
(chibi
|
|
(import (chibi) (chibi ast) (chibi char-set base))
|
|
(begin
|
|
(define (string-for-each proc str . los)
|
|
(if (null? los)
|
|
(string-fold (lambda (ch a) (proc ch)) #f str)
|
|
(let ((los (cons str los)))
|
|
(let lp ((is (map string-cursor-start los)))
|
|
(cond
|
|
((any (lambda (str i)
|
|
(string-cursor>=? i (string-cursor-end str)))
|
|
los is))
|
|
(else
|
|
(apply proc (map string-cursor-ref los is))
|
|
(lp (map string-cursor-next los is))))))))
|
|
(define (string-map proc str . los)
|
|
(call-with-output-string
|
|
(lambda (out)
|
|
(apply string-for-each
|
|
(lambda args (write-char (apply proc args) out))
|
|
str los))))))
|
|
(else
|
|
(import (scheme base) (scheme char) (srfi 14)
|
|
(except (srfi 1) make-list list-copy))
|
|
(begin
|
|
(define (string-cursor->index str i) i)
|
|
(define (string-index->cursor str i) i)
|
|
(define string-cursor? integer?)
|
|
(define string-cursor<? <)
|
|
(define string-cursor>? >)
|
|
(define string-cursor=? =)
|
|
(define string-cursor<=? <=)
|
|
(define string-cursor>=? >=)
|
|
(define string-cursor-ref string-ref)
|
|
(define (string-cursor-start s) 0)
|
|
(define string-cursor-end string-length)
|
|
(define (string-cursor-next s i) (+ i 1))
|
|
(define (string-cursor-prev s i) (- i 1))
|
|
(define (substring-cursor s start . o)
|
|
(substring s start (if (pair? o) (car o) (string-length s))))
|
|
(define (string-concatenate orig-ls . o)
|
|
(let ((sep (if (pair? o) (car o) ""))
|
|
(out (open-output-string)))
|
|
(let lp ((ls orig-ls))
|
|
(cond
|
|
((pair? ls)
|
|
(if (and sep (not (eq? ls orig-ls)))
|
|
(write-string sep out))
|
|
(write-string (car ls) out)
|
|
(lp (cdr ls)))))
|
|
(get-output-string out)))
|
|
(define string-size string-length)
|
|
(define (call-with-input-string str proc)
|
|
(let* ((in (open-input-string str))
|
|
(res (proc in)))
|
|
(close-input-port in)
|
|
res))
|
|
(define (call-with-output-string proc)
|
|
(let ((out (open-output-string)))
|
|
(proc out)
|
|
(let ((res (get-output-string out)))
|
|
(close-output-port out)
|
|
res))))))
|
|
(cond-expand
|
|
(chibi)
|
|
((library (srfi 13))
|
|
(import (only (srfi 13) string-contains)))
|
|
(else
|
|
(begin
|
|
(define (string-contains a b . o) ; really, stupidly slow
|
|
(let ((alen (string-length a))
|
|
(blen (string-length b)))
|
|
(let lp ((i (if (pair? o) (car o) 0)))
|
|
(and (<= (+ i blen) alen)
|
|
(if (string=? b (substring a i (+ i blen)))
|
|
i
|
|
(lp (+ i 1))))))))))
|
|
(include "string.scm"))
|