diff --git a/basis/checksums/sha1/sha1.factor b/basis/checksums/sha1/sha1.factor index e75ebfb9e4..0ddb429b28 100755 --- a/basis/checksums/sha1/sha1.factor +++ b/basis/checksums/sha1/sha1.factor @@ -127,7 +127,7 @@ M: sha1 checksum-stream ( stream -- sha1 ) [ zip concat ] keep like ; : sha1-interleave ( string -- seq ) - [ zero? ] left-trim + [ zero? ] trim-left dup length odd? [ rest ] when seq>2seq [ sha1 checksum-bytes ] bi@ 2seq>seq ; diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor index 12c7a60ec8..08481726dc 100644 --- a/basis/compiler/tree/normalization/normalization.factor +++ b/basis/compiler/tree/normalization/normalization.factor @@ -151,7 +151,7 @@ M: #branch normalize* : eliminate-phi-introductions ( introductions seq terminated -- seq' ) [ [ nip ] [ - dup [ +bottom+ eq? ] left-trim + dup [ +bottom+ eq? ] trim-left [ [ length ] bi@ - tail* ] keep append ] if ] 3map ; diff --git a/basis/help/help-docs.factor b/basis/help/help-docs.factor index 47cc2987d7..643e121f5e 100755 --- a/basis/help/help-docs.factor +++ b/basis/help/help-docs.factor @@ -14,6 +14,7 @@ ARTICLE: "span-elements" "Span elements" { $subsection $link } { $subsection $vocab-link } { $subsection $snippet } +{ $subsection $slot } { $subsection $url } ; ARTICLE: "block-elements" "Block elements" @@ -212,6 +213,18 @@ HELP: $code { $markup-example { $code "2 2 + ." } } } ; +HELP: $nl +{ $values { "children" "unused parameter" } } +{ $description "Prints a paragraph break. The parameter is unused." } ; + +HELP: $snippet +{ $values { "children" "markup elements" } } +{ $description "Prints a key word or otherwise notable snippet of text, such as a type or a word input parameter. To document slot names, use " { $link $slot } "." } ; + +HELP: $slot +{ $values { "children" "markup elements" } } +{ $description "Prints a tuple slot name in the same way as a snippet. The help tool can check that there exists an accessor with this name." } ; + HELP: $vocabulary { $values { "element" "a markup element of the form " { $snippet "{ word }" } } } { $description "Prints a word's vocabulary. This markup element is automatically output by the help system, so help descriptions of parsing words should not call it." } ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index d65eb8fc88..d94b9c4b41 100755 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -3,7 +3,7 @@ USING: accessors arrays definitions generic io kernel assocs hashtables namespaces parser prettyprint sequences strings io.styles vectors words math sorting splitting classes slots -vocabs help.stylesheet help.topics vocabs.loader ; +vocabs help.stylesheet help.topics vocabs.loader alias ; IN: help.markup ! Simple markup language. @@ -61,6 +61,9 @@ M: f print-element drop ; : $snippet ( children -- ) [ snippet-style get print-element* ] ($span) ; +! for help-lint +ALIAS: $slot $snippet + : $emphasis ( children -- ) [ emphasis-style get print-element* ] ($span) ; diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index ea1cfd9a4b..8dc1924a12 100755 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -113,7 +113,7 @@ SYMBOL: redirects PRIVATE> : read-chunk-size ( -- n ) - read-crlf ";" split1 drop [ blank? ] right-trim + read-crlf ";" split1 drop [ blank? ] trim-right hex> [ "Bad chunk size" throw ] unless* ; : read-chunks ( -- ) diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 98510e45fd..dfbe93d86d 100755 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -45,9 +45,9 @@ TUPLE: file-responder root hook special allow-listings ; [ file-responder get hook>> call ] [ 2drop <304> ] if ; : serving-path ( filename -- filename ) - file-responder get root>> right-trim-separators + file-responder get root>> trim-right-separators "/" - rot "" or left-trim-separators 3append ; + rot "" or trim-left-separators 3append ; : serve-file ( filename -- response ) dup mime-type diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor index 63381811d1..1cc97753b7 100755 --- a/basis/io/monitors/monitors-tests.factor +++ b/basis/io/monitors/monitors-tests.factor @@ -54,7 +54,7 @@ os { winnt linux macosx } member? [ "m" get next-change drop dup print flush dup parent-directory - [ right-trim-separators "xyz" tail? ] either? not + [ trim-right-separators "xyz" tail? ] either? not ] loop "c1" get count-down @@ -63,7 +63,7 @@ os { winnt linux macosx } member? [ "m" get next-change drop dup print flush dup parent-directory - [ right-trim-separators "yxy" tail? ] either? not + [ trim-right-separators "yxy" tail? ] either? not ] loop "c2" get count-down diff --git a/basis/io/windows/nt/files/files-tests.factor b/basis/io/windows/nt/files/files-tests.factor index 0fa4b4151c..830861eba0 100755 --- a/basis/io/windows/nt/files/files-tests.factor +++ b/basis/io/windows/nt/files/files-tests.factor @@ -21,8 +21,8 @@ IN: io.windows.nt.files.tests [ t ] [ "\\\\" root-directory? ] unit-test [ t ] [ "/" root-directory? ] unit-test [ t ] [ "//" root-directory? ] unit-test -[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test -[ t ] [ "Z:\\" right-trim-separators root-directory? ] unit-test +[ t ] [ "c:\\" trim-right-separators root-directory? ] unit-test +[ t ] [ "Z:\\" trim-right-separators root-directory? ] unit-test [ f ] [ "c:\\foo" root-directory? ] unit-test [ f ] [ "." root-directory? ] unit-test [ f ] [ ".." root-directory? ] unit-test diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor index 6a890f6392..5fbacfa325 100755 --- a/basis/io/windows/nt/files/files.factor +++ b/basis/io/windows/nt/files/files.factor @@ -22,7 +22,7 @@ M: winnt root-directory? ( path -- ? ) { { [ dup empty? ] [ f ] } { [ dup [ path-separator? ] all? ] [ t ] } - { [ dup right-trim-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] } + { [ dup trim-right-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] } [ f ] } cond nip ; diff --git a/extra/match/authors.txt b/basis/match/authors.txt similarity index 100% rename from extra/match/authors.txt rename to basis/match/authors.txt diff --git a/extra/match/match-docs.factor b/basis/match/match-docs.factor similarity index 100% rename from extra/match/match-docs.factor rename to basis/match/match-docs.factor diff --git a/extra/match/match-tests.factor b/basis/match/match-tests.factor similarity index 100% rename from extra/match/match-tests.factor rename to basis/match/match-tests.factor diff --git a/extra/match/match.factor b/basis/match/match.factor similarity index 100% rename from extra/match/match.factor rename to basis/match/match.factor diff --git a/extra/match/summary.txt b/basis/match/summary.txt similarity index 100% rename from extra/match/summary.txt rename to basis/match/summary.txt diff --git a/extra/match/tags.txt b/basis/match/tags.txt similarity index 100% rename from extra/match/tags.txt rename to basis/match/tags.txt diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 0cf0382ee2..dbb3a04a09 100755 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -513,18 +513,11 @@ TUPLE: action-parser p1 quot ; M: action-parser (compile) ( peg -- quot ) [ p1>> compile-parser 1quotation ] [ quot>> ] bi '[ @ , check-action ] ; -: left-trim-slice ( string -- string ) - #! Return a new string without any leading whitespace - #! from the original string. - dup empty? [ - dup first blank? [ rest-slice left-trim-slice ] when - ] unless ; - TUPLE: sp-parser p1 ; M: sp-parser (compile) ( peg -- quot ) p1>> compile-parser 1quotation '[ - input-slice left-trim-slice input-from pos set @ + input-slice trim-left-slice input-from pos set @ ] ; TUPLE: delay-parser quot ; diff --git a/basis/tools/annotations/annotations-docs.factor b/basis/tools/annotations/annotations-docs.factor index affb95c761..f0a3235e62 100755 --- a/basis/tools/annotations/annotations-docs.factor +++ b/basis/tools/annotations/annotations-docs.factor @@ -1,4 +1,5 @@ -USING: help.markup help.syntax words parser ; +USING: help.markup help.syntax words parser quotations strings +system sequences ; IN: tools.annotations ARTICLE: "tools.annotations" "Word annotations" @@ -20,6 +21,8 @@ HELP: watch { $values { "word" word } } { $description "Annotates a word definition to print the data stack on entry and exit." } ; +{ watch watch-vars reset } related-words + HELP: breakpoint { $values { "word" word } } { $description "Annotates a word definition to enter the single stepper when executed." } ; @@ -27,3 +30,36 @@ HELP: breakpoint HELP: breakpoint-if { $values { "quot" "a quotation with stack effect" { $snippet "( -- ? )" } } { "word" word } } { $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ; + +HELP: annotate-methods +{ $values + { "word" word } { "quot" quotation } } +{ $description "Annotates the word -- for generic words, all its methods -- with the quotation." } ; + +HELP: entering +{ $values + { "str" string } } +{ $description "Prints a message and the inputs to the word before the word has been called." } ; + +HELP: leaving +{ $values + { "str" string } } +{ $description "Prints a message and the outputs from a word after a word has been called." } ; + +HELP: reset +{ $values + { "word" word } } +{ $description "Resets any annotations on a word." } +{ $notes "This word will remove a " { $link watch } "." } ; + +HELP: watch-vars +{ $values + { "word" word } { "vars" "a sequence of symbols" } } +{ $description "Annotates a word definition to print the " { $snippet "vars" } " upon entering the word. This word is useful for debugging." } ; + +HELP: word-inputs +{ $values + { "word" word } + { "seq" sequence } } +{ $description "Makes a sequence of the inputs to a word by counting the number of inputs in the stack effect and saving that many items from the datastack." } ; + diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 1312681f85..74c92605aa 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -4,7 +4,7 @@ USING: assocs io.files hashtables kernel namespaces sequences vocabs.loader io combinators io.encodings.utf8 calendar accessors math.parser io.streams.string ui.tools.operations quotations strings arrays prettyprint words vocabs sorting sets -classes ; +classes alien ; IN: tools.scaffold SYMBOL: developer-name @@ -95,6 +95,7 @@ ERROR: no-vocab vocab ; { "obj3" object } { "obj4" object } { "quot" quotation } { "quot1" quotation } { "quot2" quotation } { "quot3" quotation } + { "quot'" quotation } { "string" string } { "string1" string } { "string2" string } { "string3" string } { "str" string } @@ -105,9 +106,20 @@ ERROR: no-vocab vocab ; { "ch" "a character" } { "word" word } { "array" array } + { "duration" duration } { "path" "a pathname string" } { "vocab" "a vocabulary specifier" } { "vocab-root" "a vocabulary root string" } + { "c-ptr" c-ptr } + { "seq" sequence } { "seq1" sequence } { "seq2" sequence } + { "seq3" sequence } { "seq4" sequence } + { "seq1'" sequence } { "seq2'" sequence } + { "newseq" sequence } + { "assoc" assoc } { "assoc1" assoc } { "assoc2" assoc } + { "assoc3" assoc } { "newassoc" assoc } + { "alist" "an array of key/value pairs" } + { "keys" sequence } { "values" sequence } + { "class" class } } at* ; : add-using ( object -- ) @@ -227,3 +239,20 @@ PRIVATE> [ drop scaffold-authors ] [ nip require ] } 2cleave ; + +SYMBOL: examples-flag + +: example ( -- ) + { + "{ $example \"\" \"USING: prettyprint ;\"" + " \"\"" + " \"\"" + "}" + } [ examples-flag get [ " " write ] when print ] each ; + +: examples ( n -- ) + t \ examples-flag [ + "{ $examples " print + [ example ] times + "}" print + ] with-variable ; diff --git a/basis/tools/vocabs/monitor/monitor.factor b/basis/tools/vocabs/monitor/monitor.factor index 12b2e41d36..ed2e486ecc 100755 --- a/basis/tools/vocabs/monitor/monitor.factor +++ b/basis/tools/vocabs/monitor/monitor.factor @@ -9,8 +9,8 @@ IN: tools.vocabs.monitor TR: convert-separators "/\\" ".." ; : vocab-dir>vocab-name ( path -- vocab ) - left-trim-separators - right-trim-separators + trim-left-separators + trim-right-separators convert-separators ; : path>vocab-name ( path -- vocab ) diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index b5c7665b8b..d71fffaaab 100755 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -136,7 +136,7 @@ PRIVATE> : insensitive= ( str1 str2 levels-removed -- ? ) [ swap collation-key swap - [ [ 0 = not ] right-trim but-last ] times + [ [ 0 = not ] trim-right but-last ] times ] curry bi@ = ; PRIVATE> diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor index 67fde74a92..a494c09b05 100755 --- a/core/combinators/combinators-docs.factor +++ b/core/combinators/combinators-docs.factor @@ -16,6 +16,10 @@ $nl { $subsection while } "Generalization of " { $link bi } " and " { $link tri } ":" { $subsection cleave } +"Generalization of " { $link 2bi } " and " { $link 2tri } ":" +{ $subsection 2cleave } +"Generalization of " { $link 3bi } " and " { $link 3tri } ":" +{ $subsection 3cleave } "Generalization of " { $link bi* } " and " { $link tri* } ":" { $subsection spread } "Two combinators which abstract out nested chains of " { $link if } ":" @@ -50,6 +54,16 @@ HELP: cleave } } ; +HELP: 2cleave +{ $values { "x" object } { "y" object } + { "seq" "a sequence of quotations with stack effect " { $snippet "( x y -- ... )" } } } +{ $description "Applies each quotation to the two objects in turn." } ; + +HELP: 3cleave +{ $values { "x" object } { "y" object } { "z" object } + { "seq" "a sequence of quotations with stack effect " { $snippet "( x y z -- ... )" } } } +{ $description "Applies each quotation to the three objects in turn." } ; + { bi tri cleave } related-words HELP: spread diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index d0c83d0ca2..4a362a7f9d 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -13,14 +13,14 @@ IN: combinators [ [ keep ] curry ] map concat [ drop ] append [ ] like ; ! 2cleave -: 2cleave ( x seq -- ) +: 2cleave ( x y seq -- ) [ 2keep ] each 2drop ; : 2cleave>quot ( seq -- quot ) [ [ 2keep ] curry ] map concat [ 2drop ] append [ ] like ; ! 3cleave -: 3cleave ( x seq -- ) +: 3cleave ( x y z seq -- ) [ 3keep ] each 3drop ; : 3cleave>quot ( seq -- quot ) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index cf87506bf9..93405fe7c0 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -47,11 +47,11 @@ HOOK: (file-appender) io-backend ( path -- stream ) : path-separator ( -- string ) os windows? "\\" "/" ? ; -: right-trim-separators ( str -- newstr ) - [ path-separator? ] right-trim ; +: trim-right-separators ( str -- newstr ) + [ path-separator? ] trim-right ; -: left-trim-separators ( str -- newstr ) - [ path-separator? ] left-trim ; +: trim-left-separators ( str -- newstr ) + [ path-separator? ] trim-left ; : last-path-separator ( path -- n ? ) [ length 1- ] keep [ path-separator? ] find-last-from ; @@ -65,7 +65,7 @@ ERROR: no-parent-directory path ; : parent-directory ( path -- parent ) dup root-directory? [ - right-trim-separators + trim-right-separators dup last-path-separator [ 1+ cut ] [ @@ -92,7 +92,7 @@ ERROR: no-parent-directory path ; : append-path-empty ( path1 path2 -- path' ) { { [ dup head.? ] [ - rest left-trim-separators append-path-empty + rest trim-left-separators append-path-empty ] } { [ dup head..? ] [ drop no-parent-directory ] } [ nip ] @@ -121,19 +121,19 @@ PRIVATE> { { [ over empty? ] [ append-path-empty ] } { [ dup empty? ] [ drop ] } - { [ over right-trim-separators "." = ] [ nip ] } + { [ over trim-right-separators "." = ] [ nip ] } { [ dup absolute-path? ] [ nip ] } - { [ dup head.? ] [ rest left-trim-separators append-path ] } + { [ dup head.? ] [ rest trim-left-separators append-path ] } { [ dup head..? ] [ - 2 tail left-trim-separators + 2 tail trim-left-separators >r parent-directory r> append-path ] } { [ over absolute-path? over first path-separator? and ] [ >r 2 head r> append ] } [ - >r right-trim-separators "/" r> - left-trim-separators 3append + >r trim-right-separators "/" r> + trim-left-separators 3append ] } cond ; @@ -142,7 +142,7 @@ PRIVATE> : file-name ( path -- string ) dup root-directory? [ - right-trim-separators + trim-right-separators dup last-path-separator [ 1+ tail ] [ drop "resource:" ?head [ file-name ] when ] if @@ -200,7 +200,7 @@ SYMBOL: current-directory : (normalize-path) ( path -- path' ) "resource:" ?head [ - left-trim-separators resource-path + trim-left-separators resource-path (normalize-path) ] [ current-directory get prepend-path @@ -219,7 +219,7 @@ M: object normalize-path ( path -- path' ) HOOK: make-directory io-backend ( path -- ) : make-directories ( path -- ) - normalize-path right-trim-separators { + normalize-path trim-right-separators { { [ dup "." = ] [ ] } { [ dup root-directory? ] [ ] } { [ dup empty? ] [ ] } diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index baf68db112..4ada1ece9a 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -178,6 +178,16 @@ ARTICLE: "sequences-search" "Searching sequences" { $subsection find-last } { $subsection find-last-from } ; +ARTICLE: "sequences-trimming" "Trimming sequences" +"Trimming words:" +{ $subsection trim } +{ $subsection trim-left } +{ $subsection trim-right } +"Potentially more efficient trim:" +{ $subsection trim-slice } +{ $subsection trim-left-slice } +{ $subsection trim-right-slice } ; + ARTICLE: "sequences-destructive" "Destructive operations" "These words modify their input, instead of creating a new sequence." $nl @@ -245,6 +255,7 @@ $nl { $subsection "sequences-sorting" } { $subsection "binary-search" } { $subsection "sets" } +{ $subsection "sequences-trimming" } "For inner loops:" { $subsection "sequences-unsafe" } ; @@ -731,7 +742,7 @@ HELP: reverse-here HELP: padding { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "quot" "a quotation with stack effect " { $snippet "( seq1 seq2 -- newseq )" } } { "newseq" "a new sequence" } } -{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of { " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ; +{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ; HELP: pad-left { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } } @@ -1004,3 +1015,45 @@ HELP: count "50" } ; +HELP: pusher +{ $values + { "quot" "a predicate quotation" } + { "quot" quotation } { "accum" vector } } +{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the accumulator if the test yields true. The accumulator is left on the stack for convenience." } +{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;" + "10 [ even? ] pusher [ each ] dip ." + "V{ 0 2 4 6 8 }" +} +{ $notes "Used to implement the " { $link filter } " word." } ; + +HELP: trim-left +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim-left ." + "{ 1 2 3 0 0 }" +} ; + +HELP: trim-right +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim-right ." + "{ 0 0 1 2 3 }" +} ; + +HELP: trim +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim ." + "{ 1 2 3 }" +} ; + +{ trim-left trim-right trim } related-words diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 8d7a0469a0..8018fe1cdc 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -237,13 +237,13 @@ unit-test [ -1./0. 0 delete-nth ] must-fail [ "" ] [ "" [ CHAR: \s = ] trim ] unit-test -[ "" ] [ "" [ CHAR: \s = ] left-trim ] unit-test -[ "" ] [ "" [ CHAR: \s = ] right-trim ] unit-test -[ "" ] [ " " [ CHAR: \s = ] left-trim ] unit-test -[ "" ] [ " " [ CHAR: \s = ] right-trim ] unit-test +[ "" ] [ "" [ CHAR: \s = ] trim-left ] unit-test +[ "" ] [ "" [ CHAR: \s = ] trim-right ] unit-test +[ "" ] [ " " [ CHAR: \s = ] trim-left ] unit-test +[ "" ] [ " " [ CHAR: \s = ] trim-right ] unit-test [ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test -[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test -[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test +[ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-left ] unit-test +[ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-right ] unit-test [ 328350 ] [ 100 [ sq ] sigma ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 2ce939d96f..32671fc7f0 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -748,16 +748,25 @@ PRIVATE> dup slice? [ { } like ] when 0 over length rot ; inline -: left-trim ( seq quot -- newseq ) +: trim-left-slice ( seq quot -- slice ) over >r [ not ] compose find drop r> swap - [ tail ] [ dup length tail ] if* ; inline + [ tail-slice ] [ dup length tail-slice ] if* ; inline + +: trim-left ( seq quot -- newseq ) + over [ trim-left-slice ] dip like ; inline -: right-trim ( seq quot -- newseq ) +: trim-right-slice ( seq quot -- slice ) over >r [ not ] compose find-last drop r> swap - [ 1+ head ] [ 0 head ] if* ; inline + [ 1+ head-slice ] [ 0 head-slice ] if* ; inline + +: trim-right ( seq quot -- newseq ) + over [ trim-right-slice ] dip like ; inline + +: trim-slice ( seq quot -- slice ) + [ trim-left-slice ] [ trim-right-slice ] bi ; : trim ( seq quot -- newseq ) - [ left-trim ] [ right-trim ] bi ; inline + over [ trim-slice ] dip like ; inline : sum ( seq -- n ) 0 [ + ] binary-reduce ; diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index e3adf2277d..1883f56929 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -22,7 +22,7 @@ PRIVATE> : p= ( p p -- ? ) pextend = ; : ptrim ( p -- p ) - dup length 1 = [ [ zero? ] right-trim ] unless ; + dup length 1 = [ [ zero? ] trim-right ] unless ; : 2ptrim ( p p -- p p ) [ ptrim ] bi@ ; : p+ ( p p -- p ) pextend v+ ; diff --git a/extra/pack/pack.factor b/extra/pack/pack.factor index adceab72f6..b487b385b9 100755 --- a/extra/pack/pack.factor +++ b/extra/pack/pack.factor @@ -84,7 +84,7 @@ M: string b, ( n string -- ) heap-size b, ; "\0" read-until [ drop f ] unless ; : read-c-string* ( n -- str/f ) - read [ zero? ] right-trim dup empty? [ drop f ] when ; + read [ zero? ] trim-right dup empty? [ drop f ] when ; : (read-128-ber) ( n -- n ) read1 diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index da723bae9d..0ee91bc326 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -175,11 +175,11 @@ M: or-parser parse ( input parser1 -- list ) parsers>> 0 swap seq>list [ parse ] lazy-map-with lconcat ; -: left-trim-slice ( string -- string ) +: trim-left-slice ( string -- string ) #! Return a new string without any leading whitespace #! from the original string. dup empty? [ - dup first blank? [ rest-slice left-trim-slice ] when + dup first blank? [ rest-slice trim-left-slice ] when ] unless ; TUPLE: sp-parser p1 ; @@ -191,7 +191,7 @@ C: sp sp-parser ( p1 -- parser ) M: sp-parser parse ( input parser -- list ) #! Skip all leading whitespace from the input then call #! the parser on the remaining input. - >r left-trim-slice r> p1>> parse ; + >r trim-left-slice r> p1>> parse ; TUPLE: just-parser p1 ; diff --git a/extra/project-euler/059/059.factor b/extra/project-euler/059/059.factor index 7cc6df3525..aa2cdb75b0 100644 --- a/extra/project-euler/059/059.factor +++ b/extra/project-euler/059/059.factor @@ -53,7 +53,7 @@ IN: project-euler.059 : source-059 ( -- seq ) "resource:extra/project-euler/059/cipher1.txt" - ascii file-contents [ blank? ] right-trim "," split + ascii file-contents [ blank? ] trim-right "," split [ string>number ] map ; TUPLE: rollover seq n ; diff --git a/extra/soundex/soundex.factor b/extra/soundex/soundex.factor index 23d5ee4d4c..d0da0b1347 100644 --- a/extra/soundex/soundex.factor +++ b/extra/soundex/soundex.factor @@ -15,7 +15,7 @@ TR: soundex-tr [ 2 [ = not ] assoc-filter values ] [ first ] bi prefix ; : first>upper ( seq -- seq' ) 1 head >upper ; -: trim-first ( seq -- seq' ) dup first [ = ] curry left-trim ; +: trim-first ( seq -- seq' ) dup first [ = ] curry trim-left ; : remove-zeroes ( seq -- seq' ) CHAR: 0 swap remove ; : remove-non-alpha ( seq -- seq' ) [ alpha? ] filter ; : pad-4 ( first seq -- seq' ) "000" 3append 4 head ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 28913d7141..286ac0183a 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -135,7 +135,7 @@ M: unknown-typeflag summary ( obj -- str ) : typeflag-L ( header -- ) drop ; ! [ read-data-blocks ] keep - ! >string [ zero? ] right-trim filename set + ! >string [ zero? ] trim-right filename set ! filename get tar-prepend-path make-directories ; ! Multi volume continuation entry