Revert "sequences: swap stack arguments for start/start*/subseq?."
This reverts commit 63b0593824
.
char-rename
parent
9dbd70ddd3
commit
baaa06278c
|
@ -1,5 +1,5 @@
|
||||||
USING: alien.libraries.finder sequences tools.test ;
|
USING: alien.libraries.finder sequences tools.test ;
|
||||||
IN: alien.libraries.fidner.linux
|
IN: alien.libraries.fidner.linux
|
||||||
|
|
||||||
{ t } [ "m" find-library "libm.so" subseq? ] unit-test
|
{ t } [ "libm.so" "m" find-library subseq? ] unit-test
|
||||||
{ t } [ "c" find-library "libc.so" subseq? ] unit-test
|
{ t } [ "libc.so" "c" find-library subseq? ] unit-test
|
||||||
|
|
|
@ -44,7 +44,7 @@ IN: alien.libraries.finder.macosx
|
||||||
} [ dyld-find ] map
|
} [ dyld-find ] map
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ t } [ "m" find-library "libm.dylib" subseq? ] unit-test
|
{ t } [ "libm.dylib" "m" find-library subseq? ] unit-test
|
||||||
{ t } [ "c" find-library "libc.dylib" subseq? ] unit-test
|
{ t } [ "libc.dylib" "c" find-library subseq? ] unit-test
|
||||||
{ t } [ "bz2" find-library "libbz2.dylib" subseq? ] unit-test
|
{ t } [ "libbz2.dylib" "bz2" find-library subseq? ] unit-test
|
||||||
{ t } [ "AGL" find-library "AGL.framework" subseq? ] unit-test
|
{ t } [ "AGL.framework" "AGL" find-library subseq? ] unit-test
|
||||||
|
|
|
@ -121,7 +121,7 @@ PRIVATE>
|
||||||
|
|
||||||
: framework-find ( name -- path )
|
: framework-find ( name -- path )
|
||||||
dup dyld-find [ nip ] [
|
dup dyld-find [ nip ] [
|
||||||
dup ".framework" start [
|
".framework" over start [
|
||||||
dupd head
|
dupd head
|
||||||
] [
|
] [
|
||||||
[ ".framework" append ] keep
|
[ ".framework" append ] keep
|
||||||
|
|
|
@ -40,8 +40,9 @@ FUNCTION: void NSBeep ( )
|
||||||
|
|
||||||
: running.app? ( -- ? )
|
: running.app? ( -- ? )
|
||||||
! Test if we're running a .app.
|
! Test if we're running a .app.
|
||||||
|
".app"
|
||||||
NSBundle -> mainBundle -> bundlePath CF>string
|
NSBundle -> mainBundle -> bundlePath CF>string
|
||||||
".app" subseq? ;
|
subseq? ;
|
||||||
|
|
||||||
: assert.app ( message -- )
|
: assert.app ( message -- )
|
||||||
running.app? [
|
running.app? [
|
||||||
|
|
|
@ -259,7 +259,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
|
||||||
"sql-spec" get modifiers>> [ +not-null+ = ] any? not ;
|
"sql-spec" get modifiers>> [ +not-null+ = ] any? not ;
|
||||||
|
|
||||||
: delete-cascade? ( -- ? )
|
: delete-cascade? ( -- ? )
|
||||||
"sql-spec" get modifiers>> { +on-delete+ +cascade+ } subseq? ;
|
"sql-spec" get modifiers>> { +on-delete+ +cascade+ } swap subseq? ;
|
||||||
|
|
||||||
: sqlite-trigger, ( string -- )
|
: sqlite-trigger, ( string -- )
|
||||||
{ } { } <simple-statement> 3, ;
|
{ } { } <simple-statement> 3, ;
|
||||||
|
|
|
@ -338,7 +338,7 @@ M: iokit-game-input-backend get-controllers ( -- sequence )
|
||||||
+controller-states+ get-global keys [ controller boa ] map ;
|
+controller-states+ get-global keys [ controller boa ] map ;
|
||||||
|
|
||||||
: ?join ( pre post sep -- string )
|
: ?join ( pre post sep -- string )
|
||||||
2over swap start [ swap 2nip ] [ [ 2array ] dip join ] if ;
|
2over start [ swap 2nip ] [ [ 2array ] dip join ] if ;
|
||||||
|
|
||||||
M: iokit-game-input-backend product-string ( controller -- string )
|
M: iokit-game-input-backend product-string ( controller -- string )
|
||||||
handle>>
|
handle>>
|
||||||
|
|
|
@ -137,7 +137,7 @@ SYMBOL: vocab-articles
|
||||||
simple-lint-error
|
simple-lint-error
|
||||||
] when
|
] when
|
||||||
] [
|
] [
|
||||||
" " subseq? [
|
" " swap subseq? [
|
||||||
"Paragraph text should not contain double spaces"
|
"Paragraph text should not contain double spaces"
|
||||||
simple-lint-error
|
simple-lint-error
|
||||||
] when
|
] when
|
||||||
|
|
|
@ -38,7 +38,7 @@ MEMO: article-words ( name -- words )
|
||||||
search-words [ { } ] [
|
search-words [ { } ] [
|
||||||
[ all-articles ] dip
|
[ all-articles ] dip
|
||||||
dup length 1 > [
|
dup length 1 > [
|
||||||
'[ article-words _ subseq? ] filter
|
'[ article-words _ swap subseq? ] filter
|
||||||
] [
|
] [
|
||||||
first '[ article-words [ _ head? ] any? ] filter
|
first '[ article-words [ _ head? ] any? ] filter
|
||||||
] if
|
] if
|
||||||
|
|
|
@ -25,7 +25,7 @@ M: template-lexer skip-word
|
||||||
DEFER: <% delimiter
|
DEFER: <% delimiter
|
||||||
|
|
||||||
: check-<% ( lexer -- col )
|
: check-<% ( lexer -- col )
|
||||||
[ line-text>> "<%" ] [ column>> ] bi start ;
|
"<%" swap [ line-text>> ] [ column>> ] bi start* ;
|
||||||
|
|
||||||
: found-<% ( accum lexer col -- accum )
|
: found-<% ( accum lexer col -- accum )
|
||||||
[
|
[
|
||||||
|
|
|
@ -50,8 +50,8 @@ IN: http.client.tests
|
||||||
! hit the velox.ch website.
|
! hit the velox.ch website.
|
||||||
! { t } [
|
! { t } [
|
||||||
! "https://alice.sni.velox.ch" http-get nip
|
! "https://alice.sni.velox.ch" http-get nip
|
||||||
! [ "Great!" subseq? ]
|
! [ "Great!" swap subseq? ]
|
||||||
! [ "TLS SNI Test Site: alice.sni.velox.ch" subseq? ] bi and
|
! [ "TLS SNI Test Site: alice.sni.velox.ch" swap subseq? ] bi and
|
||||||
! ] unit-test
|
! ] unit-test
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
|
|
|
@ -45,7 +45,8 @@ C: <mime-variable> mime-variable
|
||||||
|
|
||||||
: dump-until-separator ( multipart -- multipart )
|
: dump-until-separator ( multipart -- multipart )
|
||||||
dup
|
dup
|
||||||
[ bytes>> ] [ current-separator>> ] bi dupd start [
|
[ current-separator>> ] [ bytes>> ] bi
|
||||||
|
[ nip ] [ start ] 2bi [
|
||||||
cut-slice
|
cut-slice
|
||||||
[ mime-write ]
|
[ mime-write ]
|
||||||
[ over current-separator>> length short tail-slice >>bytes ] bi*
|
[ over current-separator>> length short tail-slice >>bytes ] bi*
|
||||||
|
|
|
@ -7,4 +7,4 @@ IN: models.search
|
||||||
'[ _ curry filter ] <smart-arrow> ; inline
|
'[ _ curry filter ] <smart-arrow> ; inline
|
||||||
|
|
||||||
: <string-search> ( values search quot -- model )
|
: <string-search> ( values search quot -- model )
|
||||||
'[ swap @ [ >case-fold ] bi@ swap subseq? ] <search> ; inline
|
'[ swap @ [ >case-fold ] bi@ subseq? ] <search> ; inline
|
||||||
|
|
|
@ -42,7 +42,7 @@ SYNTAX: STRING:
|
||||||
:: (scan-multiline-string) ( i end lexer -- j )
|
:: (scan-multiline-string) ( i end lexer -- j )
|
||||||
lexer line-text>> :> text
|
lexer line-text>> :> text
|
||||||
lexer still-parsing? [
|
lexer still-parsing? [
|
||||||
text end i start* [| j |
|
end text i start* [| j |
|
||||||
i j text subseq % j end length +
|
i j text subseq % j end length +
|
||||||
] [
|
] [
|
||||||
text i short tail % CHAR: \n ,
|
text i short tail % CHAR: \n ,
|
||||||
|
|
|
@ -23,8 +23,8 @@ and we didn't know hów tö do thât" latin2 encode >quoted ] unit-test
|
||||||
: message ( -- str )
|
: message ( -- str )
|
||||||
55 [ "hello" ] replicate concat ;
|
55 [ "hello" ] replicate concat ;
|
||||||
|
|
||||||
{ f } [ message >quoted "=\r\n" subseq? ] unit-test
|
{ f } [ message >quoted "=\r\n" swap subseq? ] unit-test
|
||||||
{ 1 } [ message >quoted string-lines length ] unit-test
|
{ 1 } [ message >quoted string-lines length ] unit-test
|
||||||
{ t } [ message >quoted-lines "=\r\n" subseq? ] unit-test
|
{ t } [ message >quoted-lines "=\r\n" swap subseq? ] unit-test
|
||||||
{ 4 } [ message >quoted-lines string-lines length ] unit-test
|
{ 4 } [ message >quoted-lines string-lines length ] unit-test
|
||||||
{ "===o" } [ message >quoted-lines string-lines [ last ] "" map-as ] unit-test
|
{ "===o" } [ message >quoted-lines string-lines [ last ] "" map-as ] unit-test
|
||||||
|
|
|
@ -34,13 +34,13 @@ IN: sequences.deep.tests
|
||||||
[ { { 1 2 3 } 4 } { { { 1 2 3 } 4 } 2 } deep-member? ] unit-test
|
[ { { 1 2 3 } 4 } { { { 1 2 3 } 4 } 2 } deep-member? ] unit-test
|
||||||
|
|
||||||
{ f }
|
{ f }
|
||||||
[ { 1 2 3 { 4 } } { 1 2 3 4 } deep-subseq? ] unit-test
|
[ { 1 2 3 4 } { 1 2 3 { 4 } } deep-subseq? ] unit-test
|
||||||
|
|
||||||
{ t }
|
{ t }
|
||||||
[ { 1 2 3 4 } { 1 2 3 4 } deep-subseq? ] unit-test
|
[ { 1 2 3 4 } { 1 2 3 4 } deep-subseq? ] unit-test
|
||||||
|
|
||||||
{ t }
|
{ t }
|
||||||
[ { { 1 2 3 4 } } { 1 2 3 4 } deep-subseq? ] unit-test
|
[ { 1 2 3 4 } { { 1 2 3 4 } } deep-subseq? ] unit-test
|
||||||
|
|
||||||
{ 3 } [
|
{ 3 } [
|
||||||
{ 1 { 2 3 { 4 } } 5 { { 6 } 7 } } 0 [
|
{ 1 { 2 3 { 4 } } 5 { { 6 } 7 } } 0 [
|
||||||
|
|
|
@ -54,9 +54,9 @@ M: object branch? drop f ;
|
||||||
_ swap dup branch? [ member? ] [ 2drop f ] if
|
_ swap dup branch? [ member? ] [ 2drop f ] if
|
||||||
] deep-find >boolean ;
|
] deep-find >boolean ;
|
||||||
|
|
||||||
: deep-subseq? ( seq subseq -- ? )
|
: deep-subseq? ( subseq seq -- ? )
|
||||||
'[
|
swap '[
|
||||||
dup branch? [ _ subseq? ] [ drop f ] if
|
_ swap dup branch? [ subseq? ] [ 2drop f ] if
|
||||||
] deep-find >boolean ;
|
] deep-find >boolean ;
|
||||||
|
|
||||||
: deep-map! ( ... obj quot: ( ... elt -- ... elt' ) -- ... obj )
|
: deep-map! ( ... obj quot: ( ... elt -- ... elt' ) -- ... obj )
|
||||||
|
|
|
@ -20,7 +20,7 @@ ERROR: not-a-vocab-root string ;
|
||||||
trim-tail-separators
|
trim-tail-separators
|
||||||
vocab-roots get member? ;
|
vocab-roots get member? ;
|
||||||
|
|
||||||
: contains-dot? ( string -- ? ) ".." subseq? ;
|
: contains-dot? ( string -- ? ) ".." swap subseq? ;
|
||||||
|
|
||||||
: contains-separator? ( string -- ? ) [ path-separator? ] any? ;
|
: contains-separator? ( string -- ? ) [ path-separator? ] any? ;
|
||||||
|
|
||||||
|
|
|
@ -138,7 +138,7 @@ PRIVATE>
|
||||||
{ [ dup "/" head? ] [ nip ] }
|
{ [ dup "/" head? ] [ nip ] }
|
||||||
{ [ dup empty? ] [ drop ] }
|
{ [ dup empty? ] [ drop ] }
|
||||||
{ [ over "/" tail? ] [ append ] }
|
{ [ over "/" tail? ] [ append ] }
|
||||||
{ [ over "/" start not ] [ nip ] }
|
{ [ "/" pick start not ] [ nip ] }
|
||||||
[ [ "/" split1-last drop "/" ] dip 3append ]
|
[ [ "/" split1-last drop "/" ] dip 3append ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
|
|
|
@ -972,21 +972,20 @@ PRIVATE>
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (start) ( seq subseq n length -- seq subseq ? )
|
: (start) ( subseq seq n length -- subseq seq ? )
|
||||||
[
|
[
|
||||||
[ 3dup ] dip [ + ] keep
|
[ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe =
|
||||||
[ swap nth-unsafe ] bi-curry@ bi* =
|
|
||||||
] all-integers? nip ; inline
|
] all-integers? nip ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: start* ( seq subseq n -- i )
|
: start* ( subseq seq n -- i )
|
||||||
2over [ length ] bi@ [ - 1 + ] keep
|
pick length [ pick length swap - 1 + ] keep
|
||||||
[ (start) ] curry (find-integer) 2nip ;
|
[ (start) ] curry (find-integer) 2nip ;
|
||||||
|
|
||||||
: start ( seq subseq -- i ) 0 start* ; inline
|
: start ( subseq seq -- i ) 0 start* ; inline
|
||||||
|
|
||||||
: subseq? ( seq subseq -- ? ) start >boolean ;
|
: subseq? ( subseq seq -- ? ) start >boolean ;
|
||||||
|
|
||||||
: drop-prefix ( seq1 seq2 -- slice1 slice2 )
|
: drop-prefix ( seq1 seq2 -- slice1 slice2 )
|
||||||
2dup mismatch [ 2dup min-length ] unless*
|
2dup mismatch [ 2dup min-length ] unless*
|
||||||
|
|
|
@ -30,7 +30,7 @@ PRIVATE>
|
||||||
: (split1) ( seq subseq snip-quot -- before after )
|
: (split1) ( seq subseq snip-quot -- before after )
|
||||||
[
|
[
|
||||||
swap [
|
swap [
|
||||||
[ drop length ] [ swap start dup ] 2bi
|
[ drop length ] [ start dup ] 2bi
|
||||||
[ [ nip ] [ + ] 2bi t ]
|
[ [ nip ] [ + ] 2bi t ]
|
||||||
[ 2drop f f f ]
|
[ 2drop f f f ]
|
||||||
if
|
if
|
||||||
|
|
|
@ -12,20 +12,20 @@ vectors ;
|
||||||
{ "abc" } [ "ab" "c" append ] unit-test
|
{ "abc" } [ "ab" "c" append ] unit-test
|
||||||
{ "abc" } [ "a" "b" "c" 3append ] unit-test
|
{ "abc" } [ "a" "b" "c" 3append ] unit-test
|
||||||
|
|
||||||
{ 3 } [ "hola" "a" start ] unit-test
|
{ 3 } [ "a" "hola" start ] unit-test
|
||||||
{ f } [ "hola" "x" start ] unit-test
|
{ f } [ "x" "hola" start ] unit-test
|
||||||
{ 0 } [ "a" "" start ] unit-test
|
{ 0 } [ "" "a" start ] unit-test
|
||||||
{ 0 } [ "" "" start ] unit-test
|
{ 0 } [ "" "" start ] unit-test
|
||||||
{ 0 } [ "hola" "hola" start ] unit-test
|
{ 0 } [ "hola" "hola" start ] unit-test
|
||||||
{ 1 } [ "hola" "ol" start ] unit-test
|
{ 1 } [ "ol" "hola" start ] unit-test
|
||||||
{ f } [ "hola" "amigo" start ] unit-test
|
{ f } [ "amigo" "hola" start ] unit-test
|
||||||
{ f } [ "hola" "holaa" start ] unit-test
|
{ f } [ "holaa" "hola" start ] unit-test
|
||||||
|
|
||||||
{ "Beginning" } [ "Beginning and end" 9 head ] unit-test
|
{ "Beginning" } [ "Beginning and end" 9 head ] unit-test
|
||||||
|
|
||||||
{ f } [ CHAR: I "team" member? ] unit-test
|
{ f } [ CHAR: I "team" member? ] unit-test
|
||||||
{ t } [ "team" "ea" subseq? ] unit-test
|
{ t } [ "ea" "team" subseq? ] unit-test
|
||||||
{ f } [ "Factor" "actore" subseq? ] unit-test
|
{ f } [ "actore" "Factor" subseq? ] unit-test
|
||||||
|
|
||||||
{ "end" } [ "Beginning and end" 14 tail ] unit-test
|
{ "end" } [ "Beginning and end" 14 tail ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -440,8 +440,6 @@ MACRO: fortran-invoke ( return library function parameters -- quot )
|
||||||
return library function parameters return [ c:void ] unless* parse-arglist
|
return library function parameters return [ c:void ] unless* parse-arglist
|
||||||
[ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
|
[ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
|
||||||
|
|
||||||
! TODO: I THINK THIS IS RIGHT FOR SUBSEQ?
|
|
||||||
|
|
||||||
SYNTAX: SUBROUTINE:
|
SYNTAX: SUBROUTINE:
|
||||||
f current-library get scan-token ")" parse-tokens
|
f current-library get scan-token ")" parse-tokens
|
||||||
[ "()" subseq? ] reject define-fortran-function ;
|
[ "()" subseq? ] reject define-fortran-function ;
|
||||||
|
|
|
@ -141,7 +141,7 @@ ERROR: undefined-find-nth m n seq quot ;
|
||||||
[ { [ name>> = ] [ closing?>> not ] } 1&& ] with find-all ;
|
[ { [ name>> = ] [ closing?>> not ] } 1&& ] with find-all ;
|
||||||
|
|
||||||
: href-contains? ( str tag -- ? )
|
: href-contains? ( str tag -- ? )
|
||||||
"href" attribute* [ swap subseq? ] [ 2drop f ] if ;
|
"href" attribute* [ subseq? ] [ 2drop f ] if ;
|
||||||
|
|
||||||
: find-hrefs ( vector -- vector' )
|
: find-hrefs ( vector -- vector' )
|
||||||
[ { [ name>> "a" = ] [ "href" attribute? ] } 1&& ] filter sift
|
[ { [ name>> "a" = ] [ "href" attribute? ] } 1&& ] filter sift
|
||||||
|
|
|
@ -17,7 +17,7 @@ default-8bit-encoding [ latin1 ] initialize
|
||||||
|
|
||||||
: prolog-encoding ( string -- iana-encoding )
|
: prolog-encoding ( string -- iana-encoding )
|
||||||
'[
|
'[
|
||||||
_ dup "encoding=" start
|
_ "encoding=" over start
|
||||||
10 + swap [ [ 1 - ] dip nth ] [ index-from ] [ swapd subseq ] 2tri
|
10 + swap [ [ 1 - ] dip nth ] [ index-from ] [ swapd subseq ] 2tri
|
||||||
] [ drop "UTF-8" ] recover ;
|
] [ drop "UTF-8" ] recover ;
|
||||||
|
|
||||||
|
|
|
@ -246,7 +246,7 @@ GENERIC: lint ( obj -- seq )
|
||||||
M: object lint ( obj -- seq ) drop f ;
|
M: object lint ( obj -- seq ) drop f ;
|
||||||
|
|
||||||
M: callable lint ( quot -- seq )
|
M: callable lint ( quot -- seq )
|
||||||
lint-definitions-keys get-global [ subseq? ] with filter ;
|
[ lint-definitions-keys get-global ] dip '[ _ subseq? ] filter ;
|
||||||
|
|
||||||
M: word lint ( word -- seq/f )
|
M: word lint ( word -- seq/f )
|
||||||
def>> [ callable? ] deep-filter [ lint ] map concat ;
|
def>> [ callable? ] deep-filter [ lint ] map concat ;
|
||||||
|
|
|
@ -227,7 +227,7 @@ CONSTANT: compass-directions H{
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: parse-weather ( str -- str' )
|
: parse-weather ( str -- str' )
|
||||||
dup "VC" subseq? [ "VC" "" replace t ] [ f ] if
|
"VC" over subseq? [ "VC" "" replace t ] [ f ] if
|
||||||
[ (parse-weather) ]
|
[ (parse-weather) ]
|
||||||
[ [ " in the vicinity" append ] when ] bi* ;
|
[ [ " in the vicinity" append ] when ] bi* ;
|
||||||
|
|
||||||
|
|
|
@ -80,7 +80,7 @@ SYMBOL: sieve
|
||||||
] each sieve get ;
|
] each sieve get ;
|
||||||
|
|
||||||
: consecutive-under ( m limit -- n/f )
|
: consecutive-under ( m limit -- n/f )
|
||||||
prime-tau-upto swap dup <repetition> start ;
|
prime-tau-upto [ dup <repetition> ] dip start ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -32,7 +32,7 @@ TUPLE: maxlicense max-count current-count times ;
|
||||||
|
|
||||||
: <maxlicense> ( -- max ) -1 0 V{ } clone \ maxlicense boa ; inline
|
: <maxlicense> ( -- max ) -1 0 V{ } clone \ maxlicense boa ; inline
|
||||||
|
|
||||||
: out? ( line -- ? ) "OUT" subseq? ; inline
|
: out? ( line -- ? ) [ "OUT" ] dip subseq? ; inline
|
||||||
|
|
||||||
: line-time ( line -- time ) " " split harvest fourth ; inline
|
: line-time ( line -- time ) " " split harvest fourth ; inline
|
||||||
|
|
||||||
|
|
|
@ -16,6 +16,6 @@ IN: rosetta-code.web-scraping
|
||||||
|
|
||||||
: web-scraping-main ( -- )
|
: web-scraping-main ( -- )
|
||||||
"http://tycho.usno.navy.mil/cgi-bin/timer.pl" http-get nip
|
"http://tycho.usno.navy.mil/cgi-bin/timer.pl" http-get nip
|
||||||
[ "UTC" start [ 9 - ] [ 1 - ] bi ] keep subseq print ;
|
[ "UTC" swap start [ 9 - ] [ 1 - ] bi ] keep subseq print ;
|
||||||
|
|
||||||
MAIN: web-scraping-main
|
MAIN: web-scraping-main
|
||||||
|
|
|
@ -187,10 +187,10 @@ HELP: start-all
|
||||||
{ "subseq" sequence } { "seq" sequence } { "indices" sequence } }
|
{ "subseq" sequence } { "seq" sequence } { "indices" sequence } }
|
||||||
{ $description "Outputs the starting indices of the non-overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
{ $description "Outputs the starting indices of the non-overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences.extras ; \"ABABA\" \"ABA\" start-all ."
|
{ $example "USING: prettyprint sequences.extras ; \"ABA\" \"ABABA\" start-all ."
|
||||||
"{ 0 }"
|
"{ 0 }"
|
||||||
}
|
}
|
||||||
{ $example "USING: prettyprint sequences.extras ; \"ABAABA\" \"ABA\" start-all ."
|
{ $example "USING: prettyprint sequences.extras ; \"ABA\" \"ABAABA\" start-all ."
|
||||||
"{ 0 3 }"
|
"{ 0 3 }"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -200,7 +200,7 @@ HELP: start-all*
|
||||||
{ "subseq" sequence } { "seq" sequence } { "indices" sequence } }
|
{ "subseq" sequence } { "seq" sequence } { "indices" sequence } }
|
||||||
{ $description "Outputs the starting indices of the possibly overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
{ $description "Outputs the starting indices of the possibly overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences.extras ; \"ABABA\" \"ABA\" start-all* ."
|
{ $example "USING: prettyprint sequences.extras ; \"ABA\" \"ABABA\" start-all* ."
|
||||||
"{ 0 2 }"
|
"{ 0 2 }"
|
||||||
} } ;
|
} } ;
|
||||||
|
|
||||||
|
@ -209,7 +209,7 @@ HELP: count-subseq
|
||||||
{ "subseq" sequence } { "seq" sequence } { "n" integer } }
|
{ "subseq" sequence } { "seq" sequence } { "n" integer } }
|
||||||
{ $description "Outputs the number of non-overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
{ $description "Outputs the number of non-overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences.extras ; \"ABABA\" \"ABA\" count-subseq ."
|
{ $example "USING: prettyprint sequences.extras ; \"ABA\" \"ABABA\" count-subseq ."
|
||||||
"1"
|
"1"
|
||||||
} } ;
|
} } ;
|
||||||
|
|
||||||
|
@ -219,7 +219,7 @@ HELP: count-subseq*
|
||||||
{ "subseq" sequence } { "seq" sequence } { "n" integer } }
|
{ "subseq" sequence } { "seq" sequence } { "n" integer } }
|
||||||
{ $description "Outputs the number of possibly overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
{ $description "Outputs the number of possibly overlapping occurrences of " { $snippet "subseq" } " in " { $snippet "seq" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences.extras ; \"ABABA\" \"ABA\" count-subseq* ."
|
{ $example "USING: prettyprint sequences.extras ; \"ABA\" \"ABABA\" count-subseq* ."
|
||||||
"2"
|
"2"
|
||||||
} } ;
|
} } ;
|
||||||
|
|
||||||
|
|
|
@ -226,11 +226,11 @@ IN: sequences.extras.tests
|
||||||
|
|
||||||
{ 3/10 } [ 10 iota [ 3 < ] count* ] unit-test
|
{ 3/10 } [ 10 iota [ 3 < ] count* ] unit-test
|
||||||
|
|
||||||
{ { 0 } } [ "ABABA" "ABA" start-all ] unit-test
|
{ { 0 } } [ "ABA" "ABABA" start-all ] unit-test
|
||||||
{ { 0 2 } } [ "ABABA" "ABA" start-all* ] unit-test
|
{ { 0 2 } } [ "ABA" "ABABA" start-all* ] unit-test
|
||||||
{ { 0 3 } } [ "ABAABA" "ABA" start-all ] unit-test
|
{ { 0 3 } } [ "ABA" "ABAABA" start-all ] unit-test
|
||||||
{ 1 } [ "ABABA" "ABA" count-subseq ] unit-test
|
{ 1 } [ "ABA" "ABABA" count-subseq ] unit-test
|
||||||
{ 2 } [ "ABABA" "ABA" count-subseq* ] unit-test
|
{ 2 } [ "ABA" "ABABA" count-subseq* ] unit-test
|
||||||
|
|
||||||
{ 120000 } [ { 10 20 30 40 50 60 } 1 [ * ] 3 reduce-from ] unit-test
|
{ 120000 } [ { 10 20 30 40 50 60 } 1 [ * ] 3 reduce-from ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -577,21 +577,21 @@ PRIVATE>
|
||||||
: map-find-last-index ( ... seq quot: ( ... elt index -- ... result/f ) -- ... result i elt )
|
: map-find-last-index ( ... seq quot: ( ... elt index -- ... result/f ) -- ... result i elt )
|
||||||
[ find-last-index ] (map-find-index) ; inline
|
[ find-last-index ] (map-find-index) ; inline
|
||||||
|
|
||||||
:: (start-all) ( seq subseq increment -- indices )
|
:: (start-all) ( subseq seq increment -- indices )
|
||||||
0
|
0
|
||||||
[ [ seq subseq ] dip start* dup ]
|
[ [ subseq seq ] dip start* dup ]
|
||||||
[ [ increment + ] keep ] produce nip ;
|
[ [ increment + ] keep ] produce nip ;
|
||||||
|
|
||||||
: start-all ( seq subseq -- indices )
|
: start-all ( subseq seq -- indices )
|
||||||
dup length (start-all) ; inline
|
over length (start-all) ; inline
|
||||||
|
|
||||||
: start-all* ( seq subseq -- indices )
|
: start-all* ( subseq seq -- indices )
|
||||||
1 (start-all) ; inline
|
1 (start-all) ; inline
|
||||||
|
|
||||||
: count-subseq ( seq subseq -- n )
|
: count-subseq ( subseq seq -- n )
|
||||||
start-all length ; inline
|
start-all length ; inline
|
||||||
|
|
||||||
: count-subseq* ( seq subseq -- n )
|
: count-subseq* ( subseq seq -- n )
|
||||||
start-all* length ; inline
|
start-all* length ; inline
|
||||||
|
|
||||||
: map-zip ( quot: ( x -- y ) -- alist )
|
: map-zip ( quot: ( x -- y ) -- alist )
|
||||||
|
|
|
@ -41,8 +41,8 @@ DEFER: name/values
|
||||||
parse-name [ parse-value ] dip associate ;
|
parse-name [ parse-value ] dip associate ;
|
||||||
|
|
||||||
: name=value ( string -- remain term )
|
: name=value ( string -- remain term )
|
||||||
[ blank? ] trim dup ":`" subseq?
|
[ blank? ] trim
|
||||||
[ (name=value) ] [ f swap ] if ;
|
":`" over subseq? [ (name=value) ] [ f swap ] if ;
|
||||||
|
|
||||||
: name/values ( string -- remain terms )
|
: name/values ( string -- remain terms )
|
||||||
[ dup { [ empty? not ] [ first CHAR: ` = not ] } 1&& ]
|
[ dup { [ empty? not ] [ first CHAR: ` = not ] } 1&& ]
|
||||||
|
|
Loading…
Reference in New Issue