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

sequence.extras: adding ?trim-head and ?trim-tail.

db4
John Benediktsson 2013-04-03 08:55:48 -07:00
parent f351eaedd0
commit ec74336c7b
2 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
extra/sequences/extras/extras-tests.factor
View File

@ -77,6 +77,11 @@ IN: sequences.extras.tests
{ t } [ "ABC" dup [ blank? ] ?trim [ identity-hashcode ] same? ] unit-test
{ "ABC" } [ " ABC " [ blank? ] ?trim ] unit-test
{ t } [ "ABC" dup [ blank? ] ?trim-head [ identity-hashcode ] same? ] unit-test
{ t } [ "ABC" dup [ blank? ] ?trim-tail [ identity-hashcode ] same? ] unit-test
{ "ABC " } [ " ABC " [ blank? ] ?trim-head ] unit-test
{ " ABC" } [ " ABC " [ blank? ] ?trim-tail ] unit-test
{ "" } [ "" "" "" unsurround ] unit-test
{ "" } [ " " " " " " unsurround ] unit-test
{ "foo.com" } [ "http://foo.com" "http://" "/" unsurround ] unit-test

14
extra/sequences/extras/extras.factor
View File

@ -242,12 +242,24 @@ PRIVATE>
: trim-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... newseq )
[ trim-slice ] [ like ] bi* ; inline
: ?trim ( ... seq quot: ( ... elt -- ... ? ) -- ... seq/newseq )
: ?trim ( seq quot: ( elt -- ? ) -- seq/newseq )
over empty? [ drop ] [
over [ first-unsafe ] [ last-unsafe ] bi pick bi@ or
[ trim ] [ drop ] if
] if ; inline
: ?trim-head ( seq quot: ( elt -- ? ) -- seq/newseq )
over empty? [ drop ] [
over first-unsafe over call
[ trim-head ] [ drop ] if
] if ; inline
: ?trim-tail ( seq quot: ( elt -- ? ) -- seq/newseq )
over empty? [ drop ] [
over last-unsafe over call
[ trim-tail ] [ drop ] if
] if ; inline
: unsurround ( newseq seq2 seq3 -- seq1 )
[ ?head drop ] [ ?tail drop ] bi* ;