diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor index 6d1c752273..24697e2367 100644 --- a/extra/modern/modern.factor +++ b/extra/modern/modern.factor @@ -59,7 +59,7 @@ MACRO:: read-double-matched ( open-ch -- quot: ( string n tag ch -- string n' se ch { { char: = [ tag 1 cut-slice* drop tag! ! tag of (=( is ( here, fix it - string n openstr1 slice-til-separator-inclusive [ -1 modify-from ] dip :> ( string' n' opening ch ) + string n openstr1 slice-until-include [ -1 modify-from ] dip :> ( string' n' opening ch ) ch open-ch = [ tag openstr2 string n ch long-opening-mismatch ] unless opening matching-delimiter-string :> needle @@ -133,7 +133,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) ) ch dup matching-delimiter { [ drop "=" swap prefix ] [ nip 1string ] - } 2cleave :> ( openstreq closestr1 ) ! [= ] + } 2cleave :> ( openstreq closestr1 ) ! [= ] |[ string n tag | string n tag 2over nth-check-eof { @@ -142,7 +142,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) ) drop dup '[ _ matching-delimiter-string closestr1 2array members lex-until ] dip swap unclip-last 3array ] } ! ( foo ) - [ drop [ slice-til-whitespace drop ] dip span-slices ] ! (foo) + [ drop [ slice-til-whitespace drop ] dip span-slices ] ! (foo) } cond ] ; @@ -151,7 +151,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) ) : read-paren ( string n slice -- string n' slice' ) char: \( read-matched ; : read-string-payload ( string n -- string n' ) dup [ - { char: \\ char: \" } slice-til-separator-inclusive { + { char: \\ char: \" } slice-until-include { { f [ drop ] } { char: \" [ drop ] } { char: \\ [ drop next-char-from drop read-string-payload ] } @@ -423,7 +423,7 @@ DEFER: lex-factor-top* { char: \" [ read-string ] } { char: \! [ read-exclamation ] } { char: > [ - [ [ char: > = not ] slice-until ] dip merge-slices + [ [ char: > = not ] slice-until-exclude drop ] dip merge-slices dup section-close? [ [ slice-til-whitespace drop ] dip ?span-slices ] unless diff --git a/extra/modern/slices/slices.factor b/extra/modern/slices/slices.factor index 4cad3dc16f..c87916ba78 100644 --- a/extra/modern/slices/slices.factor +++ b/extra/modern/slices/slices.factor @@ -24,17 +24,22 @@ IN: modern.slices rest ">" append ] if ; +: slice-between ( slice1 slice2 -- slice ) + ! ensure-same-underlying + slice-order-by-from + [ to>> ] + [ [ from>> 2dup < [ swap ] unless ] [ seq>> ] bi ] bi* ; + +: slice-before ( slice -- slice' ) + [ drop 0 ] [ from>> ] [ seq>> ] tri ; + ERROR: unexpected-end string n ; : nth-check-eof ( string n -- nth ) 2dup ?nth-of [ 2nip ] [ unexpected-end ] if* ; ! Allow eof : next-char-from ( string n/f -- string n'/f ch/f ) - dup [ - 2dup ?nth-of dup [ [ 1 + ] dip ] when - ] [ - f - ] if ; + dup [ 2dup ?nth-of dup [ [ 1 + ] dip ] when ] [ f ] if ; : find-from' ( ... seq n quot: ( ... elt -- ... ? ) -- ... i elt ) swapd find-from ; inline @@ -46,72 +51,46 @@ ERROR: unexpected-end string n ; : find-from*' ( ... seq n quot: ( ... elt -- ... ? ) -- ... i elt ? ) swapd find-from* ; inline -:: (slice-until) ( string n quot -- string n' slice/f ch/f ) - string n quot find-from' :> ( n' ch ) - string n' - n n' string ? - ch ; inline +: slice-until-exclude ( string n quot -- string n' slice/f ch/f ) + [ drop ] + [ find-from' ] 3bi ! ( string n n' ch ) + [ drop nip ] + [ [ rot ? ] dip ] 4bi ; inline -: slice-until ( string n quot -- string n' slice/f ) - (slice-until) drop ; inline - -! Don't include the whitespace in the slice -:: slice-til-quot ( string n quot -- string n'/f slice/f ch/f ) - n [ - ! BUG: (slice-until) is broken here?! - string n quot find-from' :> ( n' ch ) - string n' - n n' string ? - ch - ] [ - string f f f - ] if ; inline +: slice-until-include ( string n tokens -- string n' slice/f ch/f ) + '[ _ member? ] + [ drop ] + [ find-from' [ ?1+ ] dip ] 3bi ! ( string n n' ch ) + [ drop nip ] + [ [ rot ? ] dip ] 4bi ; inline : slice-til-whitespace ( string n -- string n' slice/f ch/f ) - [ "\s\r\n" member? ] slice-til-quot ; inline + [ "\s\r\n" member? ] slice-until-exclude ; inline : slice-til-not-whitespace ( string n -- string n' slice/f ch/f ) - [ "\s\r\n" member? not ] slice-til-quot ; inline + [ "\s\r\n" member? not ] slice-until-exclude ; inline : skip-whitespace ( string n/f -- string n'/f ) slice-til-not-whitespace 2drop ; -: empty-slice-end ( seq -- slice ) - [ length dup ] [ ] bi ; inline +: slice-til-eol ( string n -- string n' slice/f ch/f ) + [ "\r\n" member? ] slice-until-exclude ; inline -:: slice-til-eol ( string n -- string n' slice/f ch/f ) - n [ - string n '[ "\r\n" member? ] find-from' :> ( n' ch ) - string n' - n n' string ? - ch - ] [ - string n - string empty-slice-end - f - ] if ; inline - -: merge-slice-til-whitespace ( string n slice -- string n' slice' ) +: merge-slice-til-whitespace ( string n slice -- string n' slice' ) over [ [ slice-til-whitespace drop ] dip merge-slices ] when ; -: merge-slice-til-not-whitespace ( string n slice -- string n' slice' ) +: merge-slice-til-not-whitespace ( string n slice -- string n' slice' ) over [ [ slice-til-not-whitespace drop ] dip merge-slices ] when ; -:: slice-til-separator-inclusive ( string n tokens -- string n' slice/f ch/f ) - string n '[ tokens member? ] find-from' [ ?1+ ] dip :> ( n' ch ) - string - n' - n n' string ? - ch ; inline ! Takes at least one character if not whitespace :: slice-til-either ( string n tokens -- string n'/f slice/f ch/f ) n [ - string n '[ tokens member? ] find-from' + string n [ tokens member? ] find-from' dup "\s\r\n" member? [ [ ?1+ ] dip ] unless :> ( n' ch ) string n' @@ -123,7 +102,7 @@ ERROR: unexpected-end string n ; ERROR: subseq-expected-but-got-eof string n expected ; -:: slice-til-string ( string n search -- string n'/f payload end-string ) +:: slice-til-string ( string n search -- string n'/f payload end-string ) search string n subseq-start-from :> n' n' [ string n search subseq-expected-but-got-eof ] unless string