1;; 2;; srfi-130 - Cursor-based string library 3;; 4 5(define-module srfi-130 6 (use srfi-13) 7 (export string-contains 8 string-contains-right 9 string-fold 10 string-fold-right 11 string-for-each-cursor 12 string-index 13 string-index-right 14 string-replicate 15 string-skip 16 string-skip-right 17 string-split 18 19 ;; These are from SRFI-13 20 reverse-list->string 21 string-any 22 string-concatenate 23 string-concatenate-reverse 24 string-count 25 string-drop 26 string-drop-right 27 string-every 28 string-join 29 string-null? 30 string-pad 31 string-pad-right 32 string-prefix-length 33 string-prefix? 34 string-replace 35 string-reverse 36 string-suffix-length 37 string-suffix? 38 string-tabulate 39 string-take 40 string-take-right 41 string-trim 42 string-trim-both 43 string-trim-right 44 string-unfold 45 string-unfold-right 46 string-filter 47 48 ;; Aliases 49 string->list/cursors 50 string->vector/cursors 51 string-copy/cursors 52 string-ref/cursor 53 string-remove 54 substring/cursors 55 56 ;; Gauche supports the following functions natively, but 57 ;; we re-export them so that they will be available by 58 ;; importing srfi-130 into vanilla environment. 59 string-cursor->index 60 string-cursor-back 61 string-cursor-diff 62 string-cursor-end 63 string-cursor-forward 64 string-cursor-next 65 string-cursor-prev 66 string-cursor-start 67 string-cursor<=? 68 string-cursor<? 69 string-cursor=? 70 string-cursor>=? 71 string-cursor>? 72 string-cursor? 73 string-index->cursor 74 )) 75(select-module srfi-130) 76 77(define %maybe-substring (with-module gauche.internal %maybe-substring)) 78 79(define string->list/cursors string->list) 80(define string->vector/cursors string->vector) 81(define string-copy/cursors string-copy) 82(define string-ref/cursor string-ref) 83(define string-remove string-delete) 84(define substring/cursors substring) 85 86(define (string-index . args) 87 (car (apply (with-module srfi-13 %string-index) args))) 88 89(define (string-index-right . args) 90 (car (apply (with-module srfi-13 %string-index-right) args))) 91 92(define (string-skip . args) 93 (car (apply (with-module srfi-13 %string-skip) args))) 94 95(define (string-skip-right . args) 96 (car (apply (with-module srfi-13 %string-skip-right) args))) 97 98(define (string-for-each-cursor proc s :optional 99 (start 0) 100 (end (string-cursor-end s))) 101 (assume-type s <string>) 102 (let ([end (string-index->cursor s end)]) 103 (let loop ([cur (string-index->cursor s start)]) 104 (unless (string-cursor=? cur end) 105 (proc cur) 106 (loop (string-cursor-next s cur)))))) 107 108(define (string-contains s1 s2 :optional (start1 0) end1 start2 end2) 109 (assume-type s1 <string>) 110 (assume-type s2 <string>) 111 (let* ((str1 (%maybe-substring s1 start1 end1)) 112 (str2 (%maybe-substring s2 start2 end2)) 113 (res (string-scan str1 str2 'cursor))) 114 (and res 115 (string-cursor-forward s1 116 (string-index->cursor s1 start1) 117 (string-cursor->index str1 res))))) 118 119(define (string-contains-right s1 s2 :optional (start1 0) end1 start2 end2) 120 (assume-type s1 <string>) 121 (assume-type s2 <string>) 122 (let* ((str1 (%maybe-substring s1 start1 end1)) 123 (str2 (%maybe-substring s2 start2 end2)) 124 (res (string-scan-right str1 str2 'cursor))) 125 (and res 126 (string-cursor-forward s1 127 (string-index->cursor s1 start1) 128 (string-cursor->index str1 res))))) 129 130;; 'to' is not optional in srfi-130 131(define (string-replicate s from to :optional start end) 132 (xsubstring s from to start end)) 133