1 ! Copyright (C) 2016 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs fry kernel locals math sequences
4 sequences.deep sequences.extras strings unicode ;
7 : >strings ( seq -- str )
8 [ dup slice? [ >string ] when ] deep-map ;
10 : matching-delimiter ( ch -- ch' )
19 : matching-delimiter-string ( string -- string' )
20 [ matching-delimiter ] map ;
22 : matching-section-delimiter ( string -- string' )
24 rest but-last ";" ">" surround
29 ERROR: unexpected-end n string ;
30 : nth-check-eof ( n string -- nth )
31 2dup ?nth [ 2nip ] [ unexpected-end ] if* ;
33 : peek-from ( n/f string -- ch )
34 over [ ?nth ] [ 2drop f ] if ;
36 : previous-from ( n/f string -- ch )
37 over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ;
40 : next-char-from ( n/f string -- n'/f string ch/f )
42 2dup ?nth [ [ 1 + ] 2dip ] [ f ] if*
44 [ 2drop f ] [ nip ] 2bi f
47 : prev-char-from-slice-end ( slice -- ch/f )
48 [ to>> 2 - ] [ seq>> ] bi ?nth ;
50 : prev-char-from-slice ( slice -- ch/f )
51 [ from>> 1 - ] [ seq>> ] bi ?nth ;
53 : next-char-from-slice ( slice -- ch/f )
54 [ to>> ] [ seq>> ] bi ?nth ;
56 : char-before-slice ( slice -- ch/f )
57 [ from>> 1 - ] [ seq>> ] bi ?nth ;
59 : char-after-slice ( slice -- ch/f )
60 [ to>> ] [ seq>> ] bi ?nth ;
62 : find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ? )
63 [ find-from ] 2keep drop
64 pick [ drop t ] [ length -rot nip f ] if ; inline
66 : skip-blank-from ( n string -- n' string )
68 [ [ blank? not ] find-from* 2drop ] keep
71 : skip-til-eol-from ( n string -- n' string )
72 [ [ "\r\n" member? ] find-from* 2drop ] keep ; inline
74 ! Don't include the whitespace in the slice
75 :: slice-til-whitespace ( n string -- n' string slice/f ch/f )
77 n string [ "\s\r\n" member? ] find-from :> ( n' ch )
85 :: (slice-until) ( n string quot -- n' string slice/f ch/f )
86 n string quot find-from :> ( n' ch )
91 : slice-until ( n string quot -- n' string slice/f )
92 (slice-until) drop ; inline
94 :: slice-til-not-whitespace ( n string -- n' string slice/f ch/f )
96 n string [ "\s\r\n" member? not ] find-from :> ( n' ch )
104 : skip-whitespace ( n/f string -- n'/f string )
105 slice-til-not-whitespace 2drop ;
107 : empty-slice-end ( seq -- slice )
108 [ length dup ] [ ] bi <slice> ; inline
110 : empty-slice-from ( n seq -- slice )
111 dupd <slice> ; inline
113 :: slice-til-eol ( n string -- n' string slice/f ch/f )
115 n string '[ "\r\n" member? ] find-from :> ( n' ch )
120 n string string empty-slice-end f
123 :: merge-slice-til-eol-slash'' ( n string -- n' string slice/f ch/f )
125 n string '[ "\r\n\\" member? ] find-from :> ( n' ch )
130 n string string empty-slice-end f
133 : merge-slice-til-whitespace ( n string slice -- n' string slice' )
135 [ slice-til-whitespace drop ] dip merge-slices
138 : merge-slice-til-eol ( n string slice -- n' string slice' )
139 [ slice-til-eol drop ] dip merge-slices ;
141 : slice-between ( slice1 slice2 -- slice )
142 ! ensure-same-underlying
145 [ [ from>> 2dup < [ swap ] unless ] [ seq>> ] bi ] bi* <slice> ;
147 : slice-before ( slice -- slice' )
148 [ drop 0 ] [ from>> ] [ seq>> ] tri <slice> ;
150 : (?nth) ( n/f string/f -- obj/f )
151 over [ (?nth) ] [ 2drop f ] if ;
153 :: merge-slice-til-eol-slash' ( n string slice -- n' string slice/f ch/f )
154 n string merge-slice-til-eol-slash'' :> ( n' string' slice' ch' )
156 n' 1 + string' (?nth) "\r\n" member? [
157 n' 2 + string' slice slice' span-slices merge-slice-til-eol-slash'
162 n' string' slice slice' span-slices ch'
165 ! Supports \ at eol (with no space after it)
166 : slice-til-eol-slash ( n string -- n' string slice/f ch/f )
167 2dup empty-slice-from merge-slice-til-eol-slash' ;
169 :: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f )
170 n string '[ tokens member? ] find-from [ dup [ 1 + ] when ] dip :> ( n' ch )
175 : slice-til-separator-exclusive ( n string tokens -- n' string slice/f ch/f )
176 slice-til-separator-inclusive dup [
177 [ [ 1 - ] change-to ] dip
180 ! Takes at least one character if not whitespace
181 :: slice-til-either ( n string tokens -- n'/f string slice/f ch/f )
183 n string '[ tokens member? ] find-from
184 dup "\s\r\n" member? [
190 [ dup [ 1 + ] when ] dip :> ( n' ch )
199 ERROR: subseq-expected-but-got-eof n string expected ;
201 :: slice-til-string ( n string search -- n' string payload end-string )
202 search string n subseq-start-from :> n'
203 n' [ n string search subseq-expected-but-got-eof ] unless
204 n' search length + string
206 n' dup search length + string ?<slice> ;
208 : modify-from ( slice n -- slice' )
209 '[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;
211 : modify-to ( slice n -- slice' )
212 [ [ from>> ] [ to>> ] [ seq>> ] tri ] dip
213 swap [ + ] dip <slice> ;
215 ! { CHAR: \] [ read-closing ] }
216 ! { CHAR: \} [ read-closing ] }
217 ! { CHAR: \) [ read-closing ] }
218 : read-closing ( n string tok -- n string tok )
220 -1 modify-to [ 1 - ] 2dip
223 : rewind-slice ( n string slice -- n' string )
225 length swap [ - ] dip
227 [ nip ] dip [ [ length ] bi@ - ] 2keep drop