steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
U-SLAVA-DFB8FF805\Slava 2008-11-22 02:47:00 -06:00
parent 21856550e3 3a8f1b4966
commit 82a83496f3
11 changed files with 60 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/cocoa/dialogs/dialogs.factor
View File

@ -26,7 +26,7 @@ IN: cocoa.dialogs
[ -> filenames CF>string-array ] [ drop f ] if ;
: split-path ( path -- dir file )
"/" last-split1 [ <NSString> ] bi@ ;
"/" split1-last [ <NSString> ] bi@ ;
: save-panel ( path -- paths )
<NSSavePanel> dup

2
basis/farkup/farkup.factor
View File

@ -36,7 +36,7 @@ TUPLE: line-break ;
{ "http://" "https://" "ftp://" } [ head? ] with contains? ;
: simple-link-title ( string -- string' )
dup absolute-url? [ "/" last-split1 swap or ] unless ;
dup absolute-url? [ "/" split1-last swap or ] unless ;
EBNF: parse-farkup
nl = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]

14
basis/regexp/regexp-tests.factor
View File

@ -1,5 +1,5 @@
USING: regexp tools.test kernel sequences regexp.parser
regexp.traversal eval ;
regexp.traversal eval strings ;
IN: regexp-tests
\ <regexp> must-infer
@ -350,3 +350,15 @@ IN: regexp-tests
[ t ] [ "a:b" ".+:?" <regexp> matches? ] unit-test
[ 1 ] [ "hello" ".+?" <regexp> match length ] unit-test
[ { "1" "2" "3" "4" } ]
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
[ { "1" "2" "3" "4" } ]
[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
[ { "ABC" "DEF" "GHI" } ]
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test
[ "1.2.3.4" ]
[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test

14
basis/regexp/regexp.factor
View File

@ -3,7 +3,7 @@
USING: accessors combinators kernel math sequences
sets assocs prettyprint.backend make lexer namespaces parser
arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa
regexp.dfa regexp.traversal regexp.transition-tables ;
regexp.dfa regexp.traversal regexp.transition-tables splitting ;
IN: regexp
: default-regexp ( string -- regexp )
@ -52,27 +52,25 @@ IN: regexp
[ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
] if ;
: first-match ( string regexp -- pair/f )
: first-match ( string regexp -- slice/f )
dupd 0 swap match-range rot over [ <slice> ] [ 3drop f ] if ;
: re-cut ( string regexp -- end/f start )
dupd first-match
[ [ second tail-slice ] [ first head ] 2bi ]
[ "" like f swap ]
if* ;
[ split1-slice swap ] [ "" like f swap ] if* ;
: re-split ( string regexp -- seq )
[ dup ] swap '[ _ re-cut ] [ ] produce nip ;
[ dup length 0 > ] swap '[ _ re-cut ] [ ] produce nip ;
: re-replace ( string regexp replacement -- result )
[ re-split ] dip join ;
: next-match ( string regexp -- end/f match/f )
dupd first-match dup
[ [ length 1+ tail-slice ] keep ] [ 2drop f f ] if ;
[ [ split1-slice nip ] keep ] [ 2drop f f ] if ;
: all-matches ( string regexp -- seq )
[ dup ] swap '[ _ next-match ] [ ] produce nip ;
[ dup ] swap '[ _ next-match ] [ ] produce nip harvest ;
: count-matches ( string regexp -- n )
all-matches length 1- ;

2
basis/smtp/smtp.factor
View File

@ -153,7 +153,7 @@ ERROR: invalid-header-string string ;
: extract-email ( recepient -- email )
! This could be much smarter.
" " last-split1 swap or "<" ?head drop ">" ?tail drop ;
" " split1-last swap or "<" ?head drop ">" ?tail drop ;
: email>headers ( email -- hashtable )
[

2
basis/urls/urls.factor
View File

@ -132,7 +132,7 @@ M: url present
{ [ dup empty? ] [ drop ] }
{ [ over "/" tail? ] [ append ] }
{ [ "/" pick start not ] [ nip ] }
[ [ "/" last-split1 drop "/" ] dip 3append ]
[ [ "/" split1-last drop "/" ] dip 3append ]
} cond ;
PRIVATE>

2
core/io/files/files.factor
View File

@ -150,7 +150,7 @@ PRIVATE>
] unless ;
: file-extension ( filename -- extension )
"." last-split1 nip ;
"." split1-last nip ;
! File info
TUPLE: file-info type size permissions created modified

15
core/splitting/splitting-docs.factor
View File

@ -8,6 +8,9 @@ ARTICLE: "sequences-split" "Splitting sequences"
{ $subsection ?tail }
{ $subsection ?tail-slice }
{ $subsection split1 }
{ $subsection split1-slice }
{ $subsection split1-last }
{ $subsection split1-last-slice }
{ $subsection split }
"Splitting a string into lines:"
{ $subsection string-lines } ;
@ -18,11 +21,19 @@ HELP: split1
{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before" "a new sequence" } { "after" "a new sequence" } }
{ $description "Splits " { $snippet "seq" } " at the first occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
HELP: last-split1
HELP: split1-slice
{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before-slice" slice } { "after-slice" slice } }
{ $description "Splits " { $snippet "seq" } " at the first occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split as slices. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
HELP: split1-last
{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before" "a new sequence" } { "after" "a new sequence" } }
{ $description "Splits " { $snippet "seq" } " at the last occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
{ split1 last-split1 } related-words
HELP: split1-last-slice
{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before-slice" slice } { "after-slice" slice } }
{ $description "Splits " { $snippet "seq" } " at the last occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split as slices. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
{ split1 split1-slice split1-last split1-last-slice } related-words
HELP: split
{ $values { "seq" "a sequence" } { "separators" "a sequence" } { "pieces" "a new array" } }

13
core/splitting/splitting-tests.factor
View File

@ -6,10 +6,15 @@ IN: splitting.tests
[ "goodbye" f ] [ "goodbye" " " split1 ] unit-test
[ "" "" ] [ "great" "great" split1 ] unit-test
[ "hello world" "." ] [ "hello world ." " " last-split1 ] unit-test
[ "hello-+world" "." ] [ "hello-+world-+." "-+" last-split1 ] unit-test
[ "goodbye" f ] [ "goodbye" " " last-split1 ] unit-test
[ "" "" ] [ "great" "great" last-split1 ] unit-test
[ "hello world" "." ] [ "hello world ." " " split1-last ] unit-test
[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last ] unit-test
[ "goodbye" f ] [ "goodbye" " " split1-last ] unit-test
[ "" "" ] [ "great" "great" split1-last ] unit-test
[ "hello world" "." ] [ "hello world ." " " split1-last-slice [ >string ] bi@ ] unit-test
[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last-slice [ >string ] bi@ ] unit-test
[ "goodbye" f ] [ "goodbye" " " split1-last-slice [ dup [ >string ] when ] bi@ ] unit-test
[ "" "" ] [ "great" "great" split1-last-slice [ >string ] bi@ ] unit-test
[ "and end" t ] [ "Beginning and end" "Beginning " ?head ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?head ] unit-test

13
core/splitting/splitting.factor
View File

@ -23,10 +23,21 @@ IN: splitting
2drop f
] if ;
: last-split1 ( seq subseq -- before after )
: split1-slice ( seq subseq -- before-slice after-slice )
dup pick start dup [
[ >r over r> head-slice -rot length ] keep + tail-slice
] [
2drop f
] if ;
: split1-last ( seq subseq -- before after )
[ <reversed> ] bi@ split1 [ reverse ] bi@
dup [ swap ] when ;
: split1-last-slice ( seq subseq -- before-slice after-slice )
[ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
[ f ] [ swap ] if-empty ;
: (split) ( separators n seq -- )
3dup rot [ member? ] curry find-from drop
[ [ swap subseq , ] 2keep 1+ swap (split) ]

4
extra/bake/fry/fry.factor
View File

@ -44,7 +44,7 @@ DEFER: shallow-fry
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: deep-fry ( quot -- quot )
{ _ } last-split1 dup
{ _ } split1-last dup
[
shallow-fry [ >r ] rot
deep-fry [ [ dip ] curry r> compose ] 4array concat
@ -77,4 +77,4 @@ DEFER: shallow-fry
MACRO: fry ( seq -- quot ) [fry] ;
: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing