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