1 ! Copyright (C) 2016 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs combinators.extras kernel math sequences
4 sequences.deep sequences.extras sequences.private strings
8 : >strings ( seq -- str )
9 [ dup slice? [ >string ] when ] deep-map ;
11 : matching-delimiter ( ch -- ch' )
20 : matching-delimiter-string ( string -- string' )
21 [ matching-delimiter ] map ;
23 : matching-section-delimiter ( string -- string' )
25 rest but-last ";" ">" surround
30 : accept1 ( n string quot: ( ch -- ? ) -- n/n' string ch/f )
31 [ 2dup nth ] dip keep swap [ [ 1 + ] 2dip ] [ drop f ] if ; inline
33 ERROR: unexpected-end n string ;
34 : nth-check-eof ( n string -- nth )
35 2dup ?nth [ 2nip ] [ unexpected-end ] if* ;
37 : peek1-from ( n/f string -- ch )
38 over [ ?nth ] [ 2drop f ] if ;
40 : peek-from ( n/f string m -- string )
41 over [ [ swap tail-slice ] dip head-slice ] [ 3drop f ] if ;
43 : previous-from ( n/f string -- ch )
44 over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ;
47 : take-char ( n/f string -- n'/f string ch/f )
49 2dup ?nth [ [ 1 + ] 2dip ] [ f ] if*
54 : find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i/f elt ? )
56 pick [ drop t ] [ length -rot nip f ] if ; inline
58 : skip-blank-from ( n string -- n' string )
60 [ [ blank? not ] find-from* 2drop ] keep
63 : skip-til-eol-from ( n string -- n' string )
64 [ [ "\r\n" member? ] find-from* 2drop ] keep ; inline
66 ERROR: take-slice-error n string count ;
67 :: take-slice ( n string count -- n'/f string slice )
68 n [ n string count take-slice-error ] unless
74 ERROR: expected-sequence-error expected actual ;
75 : check-sequence ( expected actual -- actual/* )
76 2dup sequence= [ nip ] [ expected-sequence-error ] if ;
78 : check-sequence-insensitive ( expected actual -- actual/* )
79 2dup [ >lower ] bi@ sequence= [ nip ] [ expected-sequence-error ] if ;
81 : expect-and-span ( n string slice expected-string -- n' string slice' )
82 dup length '[ _ take-slice ] 2dip-1up check-sequence span-slices ;
84 : expect-and-span-insensitive ( n string slice expected-string -- n' string slice' )
85 dup length '[ _ take-slice ] 2dip-1up check-sequence-insensitive span-slices ;
87 :: split-slice-back ( slice n -- slice1 slice2 )
88 slice [ from>> ] [ to>> ] [ seq>> ] tri :> ( from to seq )
89 from to n - seq <slice>
90 to n - to seq <slice> ;
92 ! Don't include the whitespace in the slice
93 :: slice-til-whitespace ( n string -- n' string slice/f ch/f )
95 n string [ "\s\r\n" member? ] find-from :> ( n' ch )
103 :: (slice-until) ( n string quot -- n' string slice/f ch/f )
104 n string quot find-from :> ( n' ch )
109 : slice-until ( n string quot -- n' string slice/f )
110 (slice-until) drop ; inline
112 :: slice-til-not-whitespace ( n string -- n' string slice/f ch/f )
114 n string [ "\s\r\n\t" member? not ] find-from :> ( n' ch )
122 : skip-whitespace ( n/f string -- n'/f string )
123 slice-til-not-whitespace 2drop ;
125 : empty-slice-end ( seq -- slice )
126 [ length dup ] [ ] bi <slice> ; inline
128 :: slice-til-eol ( n string -- n' string slice/f ch/f )
130 n string '[ "\r\n" member? ] find-from :> ( n' ch )
135 n string string empty-slice-end f
138 : merge-slice-til-whitespace ( n/f string slice -- n'/f string slice' )
140 [ slice-til-whitespace drop ] dip merge-slices
143 : slice-between ( slice1 slice2 -- slice )
144 ! ensure-same-underlying
147 [ [ from>> 2dup < [ swap ] unless ] [ seq>> ] bi ] bi* <slice> ;
149 : slice-before ( slice -- slice' )
150 [ drop 0 ] [ from>> ] [ seq>> ] tri <slice> ;
152 :: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f )
153 n string '[ tokens member? ] find-from [ dup [ 1 + ] when ] dip :> ( n' ch )
158 : slice-til-separator-exclusive ( n string tokens -- n' string slice/f ch/f )
159 slice-til-separator-inclusive dup [
160 [ [ 1 - ] change-to ] dip
163 ! Takes at least one character if not whitespace
164 :: slice-til-either ( n string tokens -- n'/f string slice/f ch/f )
166 n string '[ tokens member? ] find-from
167 dup "\s\r\n" member? [
173 [ dup [ 1 + ] when ] dip :> ( n' ch )
182 ERROR: subseq-expected-but-got-eof n string expected ;
184 :: slice-til-string ( n string search -- n' string payload end-string )
185 search string n subseq-start-from :> n'
186 n' [ n string search subseq-expected-but-got-eof ] unless
187 n' search length + string
189 n' dup search length + string ?<slice> ;
191 : modify-from ( slice n -- slice' )
192 '[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;
194 : modify-to ( slice n -- slice' )
195 [ from>> ] swap '[ to>> _ + ] [ seq>> ] tri <slice> ; inline
197 ! { CHAR: \] [ read-closing ] }
198 ! { CHAR: \} [ read-closing ] }
199 ! { CHAR: \) [ read-closing ] }
200 : read-closing ( n string tok -- n' string tok )
206 : rewind-slice ( n string slice -- n' string )
207 2nip [ from>> ] [ seq>> ] bi ; inline
209 :: take-from? ( n seq subseq -- n'/f seq ? )
210 subseq seq n pick length (subseq-start-from) 2nip [
218 : check-slice? ( from to seq -- from to seq ? )
229 :: take-from-insensitive? ( n seq str -- n'/f seq ? )
230 n str length over + seq check-slice? [
231 subseq str [ >lower ] bi@ sequence= [