modern: Allow [[ [=[ [0[ etc
Fix slice-until to be a more general combinatormodern-harvey3
parent
3f9448bc18
commit
a4a9500be1
|
@ -256,3 +256,7 @@ IN: modern.tests
|
|||
{ t } [ "foo[[ ]]" [ rewrite-string-exact ] keep sequence= ] unit-test
|
||||
{ t } [ "foo[11[ ]11]" [ rewrite-string-exact ] keep sequence= ] unit-test
|
||||
{ t } [ "foo[123[ ]123]" [ rewrite-string-exact ] keep sequence= ] unit-test
|
||||
|
||||
|
||||
{ } [ "[1,b)" string>literals drop ] unit-test
|
||||
{ } [ "[1,b]" string>literals drop ] unit-test
|
|
@ -13,11 +13,17 @@ ERROR: long-opening-mismatch tag open string n ch ;
|
|||
ERROR: unexpected-terminator string n slice ; ! ] } ) ;
|
||||
ERROR: compound-syntax-disallowed seq n obj ;
|
||||
|
||||
ERROR: expected-digits-only str n got ;
|
||||
ERROR: expected-digits-only-or-equals-only str n got ;
|
||||
! Allow [00[ ]00] etc
|
||||
: check-digits ( str n got -- str n digits )
|
||||
dup but-last [ digit? ] all?
|
||||
[ >string but-last expected-digits-only ] unless ;
|
||||
: container-expander-char? ( ch -- ? )
|
||||
{ [ digit? ] [ char: = = ] } 1|| ; inline
|
||||
|
||||
: check-container-expander ( str n got -- str n digits )
|
||||
dup but-last {
|
||||
[ [ digit? ] all? ]
|
||||
[ [ char: = = ] all? ]
|
||||
} 1||
|
||||
[ >string but-last expected-digits-only-or-equals-only ] unless ;
|
||||
|
||||
! (( )) [[ ]] {{ }}
|
||||
MACRO:: read-double-matched ( $open-ch -- quot: ( string n tag ch -- string n' seq ) )
|
||||
|
@ -27,10 +33,10 @@ MACRO:: read-double-matched ( $open-ch -- quot: ( string n tag ch -- string n' s
|
|||
:> ( $openstr2 $openstr1 $closestr2 ) ! "[[" "[" "]]"
|
||||
|[ $string $n $tag! $ch |
|
||||
$ch {
|
||||
{ [ dup digit? ] [
|
||||
{ [ dup container-expander-char? ] [
|
||||
drop $tag 1 cut-slice* drop $tag! ! XXX: $tag of (=( is ( here, fix it (??)
|
||||
$string $n $openstr1 slice-until-include [
|
||||
check-digits ! 000] ok, 00a] bad
|
||||
$string $n $openstr1 slice-until-token-include [
|
||||
check-container-expander ! 000] ok, =] ok, 00=] bad
|
||||
-1 modify-from
|
||||
] dip :> ( $string' $n' $opening $ch )
|
||||
$ch $open-ch = [ $tag $openstr2 $string $n $ch long-opening-mismatch ] unless
|
||||
|
@ -106,12 +112,27 @@ DEFER: lex-factor-nested
|
|||
|
||||
DEFER: lex-factor-fallthrough
|
||||
MACRO:: read-matched ( $ch -- quot: ( string n tag -- string n' slice' ) )
|
||||
{ 48 49 50 51 52 53 54 55 56 57 $ch }
|
||||
$ch matching-delimiter 1string :> ( $openstreq $closestr1 ) ! digits ]
|
||||
{
|
||||
char: 0 char: 1 char: 2 char: 3 char: 4 char: 5
|
||||
char: 6 char: 7 char: 8 char: 9 $ch char: =
|
||||
} :> $openstr-chars
|
||||
|
||||
$ch matching-delimiter 1string :> $closestr1
|
||||
|[ $string $n $tag |
|
||||
$string $n $tag
|
||||
2over nth-check-eof {
|
||||
{ [ dup $openstreq member? ] [ $ch read-double-matched ] } ! (=( or ((
|
||||
{ [
|
||||
dup {
|
||||
[ $openstr-chars member? ]
|
||||
[
|
||||
! check that opening is good form
|
||||
drop
|
||||
$string $n [
|
||||
{ [ $ch = ] [ blank? ] } 1||
|
||||
] t slice-until 3nip $ch =
|
||||
]
|
||||
} 1&&
|
||||
] [ $ch read-double-matched ] } ! (=( or ((
|
||||
{ [ dup blank? ] [
|
||||
drop dup '[ _ matching-delimiter-string $closestr1 2array members lex-until ] dip
|
||||
swap unclip-last 3array $ch <matched>
|
||||
|
@ -128,7 +149,7 @@ MACRO:: read-matched ( $ch -- quot: ( string n tag -- string n' slice' ) )
|
|||
: read-paren ( string n slice -- string n' obj ) char: \( read-matched ;
|
||||
: read-string-payload ( string n -- string n' )
|
||||
dup [
|
||||
{ char: \\ char: \" } slice-until-include {
|
||||
{ char: \\ char: \" } slice-until-token-include {
|
||||
{ f [ drop ] }
|
||||
{ char: \" [ drop ] }
|
||||
{ char: \\ [ drop next-char-from drop read-string-payload ] }
|
||||
|
@ -421,7 +442,7 @@ DEFER: lex-factor-top*
|
|||
{ char: \" [ read-string ] }
|
||||
{ char: \! [ read-exclamation ] }
|
||||
{ char: > [
|
||||
[ [ char: > = not ] slice-until-exclude drop ] dip merge-slices
|
||||
[ [ char: > = not ] f slice-until drop ] dip merge-slices
|
||||
dup section-close-form? [
|
||||
[ slice-til-whitespace drop ] dip ?span-slices
|
||||
] unless
|
||||
|
|
|
@ -27,10 +27,10 @@ IN: modern.slices.tests
|
|||
"foo:" 3 slice-til-whitespace
|
||||
] unit-test
|
||||
|
||||
{ "foo " f T{ slice f 0 4 "foo " } f } [
|
||||
"foo " 0 [ blank? ] slice-until-include
|
||||
{ "foo " 4 T{ slice f 0 4 "foo " } 32 } [
|
||||
"foo " 0 [ blank? ] t slice-until
|
||||
] unit-test
|
||||
|
||||
{ "foo " 3 T{ slice f 0 3 "foo " } 32 } [
|
||||
"foo " 0 [ blank? ] slice-until-exclude
|
||||
"foo " 0 [ blank? ] f slice-until
|
||||
] unit-test
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2016 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs fry kernel locals math sequences
|
||||
sequences.deep sequences.extras strings unicode sequences.private ;
|
||||
sequences.deep sequences.extras strings unicode sequences.private
|
||||
shuffle ;
|
||||
IN: modern.slices
|
||||
|
||||
ERROR: unexpected-eof string n expected ;
|
||||
|
@ -53,38 +54,39 @@ ERROR: unexpected-eof string n expected ;
|
|||
: find-from*' ( ... seq n quot: ( ... elt -- ... ? ) -- ... i elt ? )
|
||||
swapd find-from* ; inline
|
||||
|
||||
: slice-until-exclude ( string n quot -- string n' slice/f ch/f )
|
||||
over [
|
||||
[ drop ]
|
||||
[ find-from' ] 3bi ! ( string n n' ch )
|
||||
[ drop nip ]
|
||||
[ [ rot ?<slice> ] dip ] 4bi
|
||||
: slice-until ( string n quot include? -- string n' slice/f ch/f )
|
||||
pick [
|
||||
'[
|
||||
[ drop ]
|
||||
[ find-from' _ [ [ ?1+ ] dip ] when ] 3bi ! ( string n n' ch )
|
||||
|
||||
[ drop nip ]
|
||||
[ [ rot ?<slice> ] dip ] 4bi
|
||||
] call
|
||||
] [
|
||||
drop f f
|
||||
2drop f f
|
||||
] if ; inline
|
||||
|
||||
: slice-until-include ( string n tokens -- string n' slice/f ch/f )
|
||||
over [
|
||||
'[ _ member? ]
|
||||
[ drop ]
|
||||
[ find-from' [ ?1+ ] dip ] 3bi ! ( string n n' ch )
|
||||
[ drop nip ]
|
||||
[ [ rot ?<slice> ] dip ] 4bi
|
||||
] [
|
||||
drop f f
|
||||
] if ; inline
|
||||
: slice-until-token-exclude ( string n tokens -- string n' slice/f ch/f )
|
||||
'[ _ member? ] f slice-until ; inline
|
||||
|
||||
: slice-until-token-include ( string n tokens -- string n' slice/f ch/f )
|
||||
'[ _ member? ] t slice-until ; inline
|
||||
|
||||
: peek-until ( string n quot include? -- string n slice/f ch/f )
|
||||
'[ _ slice-until 2nipd ] 2keepd 2swap ; inline
|
||||
|
||||
: slice-til-whitespace ( string n -- string n' slice/f ch/f )
|
||||
[ "\s\r\n" member? ] slice-until-exclude ; inline
|
||||
[ "\s\r\n" member? ] f slice-until ; inline
|
||||
|
||||
: slice-til-not-whitespace ( string n -- string n' slice/f ch/f )
|
||||
[ "\s\r\n" member? not ] slice-until-exclude ; inline
|
||||
[ "\s\r\n" member? not ] f slice-until ; inline
|
||||
|
||||
: skip-whitespace ( string n/f -- string n'/f )
|
||||
slice-til-not-whitespace 2drop ;
|
||||
|
||||
: slice-til-eol ( string n -- string n' slice/f ch/f )
|
||||
[ "\r\n" member? ] slice-until-exclude ; inline
|
||||
[ "\r\n" member? ] f slice-until ; inline
|
||||
|
||||
: merge-slice-til-whitespace ( string n slice -- string n' slice' )
|
||||
over [
|
||||
|
|
Loading…
Reference in New Issue