diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 704879bc5a..1e54cf10d5 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -36,6 +36,7 @@ + listener/plugin: +- use decl wrong - faster completion - sidekick: still parsing too much - errors don't always disappear diff --git a/examples/timesheet.factor b/examples/timesheet.factor index 3c92fce932..cdae6ecefd 100644 --- a/examples/timesheet.factor +++ b/examples/timesheet.factor @@ -2,7 +2,6 @@ IN: timesheet USE: errors -USE: format USE: kernel USE: lists USE: math @@ -31,7 +30,7 @@ USE: vectors ! Printing the timesheet. : hh ( duration -- str ) 60 /i ; -: mm ( duration -- str ) 60 mod unparse 2 digits ; +: mm ( duration -- str ) 60 mod unparse 2 "0" pad ; : hh:mm ( millis -- str ) [ dup hh , ":" , mm , ] make-list ; : print-entry ( duration description -- ) diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 980f27f95e..14aa3b40d0 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -74,7 +74,6 @@ USE: stdio "/library/syntax/parse-stream.factor" "/library/bootstrap/init.factor" - "/library/format.factor" "/library/syntax/unparser.factor" "/library/io/presentation.factor" "/library/io/vocabulary-style.factor" diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 857338c7d1..36cf969e36 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -137,7 +137,7 @@ GENERIC: ' ( obj -- ptr ) : here-as ( tag -- pointer ) here swap bitor ; -: pad ( -- ) +: align-here ( -- ) here 8 mod 4 = [ 0 emit ] when ; ( Remember what objects we've compiled ) @@ -162,7 +162,7 @@ M: bignum ' ( bignum -- tagged ) [ 0 | [ 1 0 ] ] [ -1 | [ 2 1 1 ] ] [ 1 | [ 2 0 1 ] ] - ] assoc [ emit ] each pad r> ; + ] assoc [ emit ] each align-here r> ; ( Special objects ) @@ -267,7 +267,7 @@ M: cons ' ( c -- tagged ) dup str-length emit dup hashcode emit pack-string - pad ; + align-here ; M: string ' ( string -- pointer ) #! We pool strings so that each string is only written once @@ -286,7 +286,7 @@ M: string ' ( string -- pointer ) array-type >header emit dup length emit ( elements -- ) [ emit ] each - pad r> ; + align-here r> ; M: vector ' ( vector -- pointer ) dup vector>list emit-array swap vector-length @@ -294,7 +294,7 @@ M: vector ' ( vector -- pointer ) vector-type >header emit emit ( length ) emit ( array ptr ) - pad r> ; + align-here r> ; ( End of the image ) diff --git a/library/cli.factor b/library/cli.factor index 9165d2b142..8a61dc9c35 100644 --- a/library/cli.factor +++ b/library/cli.factor @@ -64,26 +64,16 @@ USE: words #! #! Arguments containing = are handled differently; they #! set the object path. - "=" split1 dup [ + "=" split1 [ cli-var-param ] [ - drop dup "no-" str-head? dup [ - f put drop - ] [ - drop t put - ] ifte - ] ifte ; + "no-" ?str-head not put + ] ifte* ; : cli-arg ( argument -- argument ) #! Handle a command-line argument. If the argument was #! consumed, returns f. Otherwise returns the argument. - dup f-or-"" [ - dup "-" str-head? dup [ - cli-param drop f - ] [ - drop - ] ifte - ] unless ; + dup f-or-"" [ "-" ?str-head [ cli-param f ] when ] unless ; : parse-switches ( args -- args ) [ cli-arg ] map ; diff --git a/library/format.factor b/library/format.factor deleted file mode 100644 index 7475325079..0000000000 --- a/library/format.factor +++ /dev/null @@ -1,69 +0,0 @@ -! :folding=indent:collapseFolds=0: - -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -IN: format -USE: kernel -USE: math -USE: namespaces -USE: strings - -: decimal-split ( string -- string string ) - #! Split a string before and after the decimal point. - dup "." index-of dup -1 = [ drop f ] [ str// ] ifte ; - -: decimal-tail ( count str -- string ) - #! Given a decimal, trims all but a count of decimal places. - [ str-length min ] keep str-head ; - -: decimal-cat ( before after -- string ) - #! If after is of zero length, return before, otherwise - #! return "before.after". - dup str-length 0 = [ - drop - ] [ - "." swap cat3 - ] ifte ; - -: decimal-places ( num count -- string ) - #! Trims the number to a count of decimal places. - >r decimal-split dup [ - r> swap decimal-tail decimal-cat - ] [ - r> 2drop - ] ifte ; - -: digits ( string count -- string ) - #! Make sure string has at least count digits, padding it - #! with zeroes on the left if needed. - over str-length - dup 0 <= [ - drop - ] [ - "0" fill swap cat2 - ] ifte ; - -: pad-string ( len str -- str ) - str-length - " " fill ; diff --git a/library/generic/predicate.factor b/library/generic/predicate.factor index 84694e78a0..b08d9d54d1 100644 --- a/library/generic/predicate.factor +++ b/library/generic/predicate.factor @@ -44,7 +44,7 @@ SYMBOL: predicate \ dup , "predicate" word-property , , , \ ifte , ] make-list ; -: (predicate-method) ( vtable definition class type# -- ) +: predicate-method ( vtable definition class type# -- ) >r rot r> swap [ vector-nth ( vtable definition class existing ) @@ -59,7 +59,7 @@ predicate [ ( vtable definition class -- ) dup builtin-supertypes [ ( vtable definition class type# ) - >r 3dup r> (predicate-method) + >r 3dup r> predicate-method ] each 3drop ] "add-method" set-word-property diff --git a/library/httpd/file-responder.factor b/library/httpd/file-responder.factor index 092c84cf09..ea4d8c45b3 100644 --- a/library/httpd/file-responder.factor +++ b/library/httpd/file-responder.factor @@ -42,7 +42,7 @@ USE: strings USE: unparser : serving-path ( filename -- filename ) - f>"" "doc-root" get swap cat2 ; + [ "" ] unless* "doc-root" get swap cat2 ; : file-response ( mime-type length -- ) [ diff --git a/library/httpd/html-tags.factor b/library/httpd/html-tags.factor index 31f80e4378..c21a16fdc7 100644 --- a/library/httpd/html-tags.factor +++ b/library/httpd/html-tags.factor @@ -26,7 +26,6 @@ IN: html USE: strings USE: lists -USE: format USE: kernel USE: stdio USE: namespaces diff --git a/library/httpd/html.factor b/library/httpd/html.factor index 5f2576086c..d73e3d60c4 100644 --- a/library/httpd/html.factor +++ b/library/httpd/html.factor @@ -26,7 +26,6 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: html -USE: format USE: lists USE: kernel USE: namespaces @@ -55,7 +54,7 @@ USE: generic [ dup html-entities assoc dup rot ? ] str-map ; : >hex-color ( triplet -- hex ) - [ >hex 2 digits ] map "#" swons cat ; + [ >hex 2 "0" pad ] map "#" swons cat ; : fg-css, ( color -- ) "color: " , >hex-color , "; " , ; diff --git a/library/httpd/http-common.factor b/library/httpd/http-common.factor index ccce12bce1..afb4b2faf1 100644 --- a/library/httpd/http-common.factor +++ b/library/httpd/http-common.factor @@ -27,7 +27,6 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: httpd -USE: format USE: kernel USE: lists USE: logging diff --git a/library/httpd/url-encoding.factor b/library/httpd/url-encoding.factor index 8a9a6d7af5..d9936d26aa 100644 --- a/library/httpd/url-encoding.factor +++ b/library/httpd/url-encoding.factor @@ -29,7 +29,6 @@ IN: url-encoding USE: errors USE: kernel USE: lists -USE: format USE: math USE: parser USE: strings @@ -37,7 +36,9 @@ USE: unparser : url-encode ( str -- str ) [ - dup url-quotable? [ "%" swap >hex 2 digits cat2 ] unless + dup url-quotable? [ + "%" swap >hex 2 "0" pad cat2 + ] unless ] str-map ; : catch-hex> ( str -- n ) diff --git a/library/io/ansi.factor b/library/io/ansi.factor index b980d2b707..7e37e1f832 100644 --- a/library/io/ansi.factor +++ b/library/io/ansi.factor @@ -28,7 +28,6 @@ IN: ansi USE: lists USE: kernel -USE: format USE: namespaces USE: stdio USE: streams diff --git a/library/sbuf.factor b/library/sbuf.factor index 2b0219f49b..c56f4c506d 100644 --- a/library/sbuf.factor +++ b/library/sbuf.factor @@ -48,6 +48,13 @@ USE: strings #! repeated. [ swap [ dup , ] times drop ] make-string ; +: pad ( string count char -- string ) + >r over str-length - dup 0 <= [ + r> 2drop + ] [ + r> fill swap cat2 + ] ifte ; + : str-map ( str code -- str ) #! Apply a quotation to each character in the string, and #! push a new string constructed from return values. diff --git a/library/strings.factor b/library/strings.factor index 2f8f14d2ac..6bfaf13a76 100644 --- a/library/strings.factor +++ b/library/strings.factor @@ -43,9 +43,6 @@ M: sbuf = sbuf= ; : f-or-"" ( obj -- ? ) dup not swap "" = or ; -: f>"" ( str/f -- str ) - [ "" ] unless* ; - : str-length< ( str str -- boolean ) #! Compare string lengths. swap str-length swap str-length < ; @@ -96,31 +93,33 @@ M: sbuf = sbuf= ; #! index. [ swap str-head ] 2keep succ swap str-tail ; -: str-headcut ( str begin -- str str ) - str-length str/ ; - -: =? ( x y z -- z/f ) - #! Push z if x = y, otherwise f. - >r = r> f ? ; - -: str-head? ( str begin -- str ) - #! If the string starts with begin, return the rest of the - #! string after begin. Otherwise, return f. - 2dup str-length< [ 2drop f ] [ tuck str-headcut =? ] ifte ; +: str-head? ( str begin -- ? ) + 2dup str-length< [ + 2drop f + ] [ + dup str-length rot str-head = + ] ifte ; : ?str-head ( str begin -- str ? ) - dupd str-head? dup [ nip t ] [ drop f ] ifte ; + 2dup str-head? [ + str-length swap str-tail t + ] [ + drop f + ] ifte ; -: str-tailcut ( str end -- str str ) - str-length >r dup str-length r> - str/ swap ; +: str-tail? ( str end -- ? ) + 2dup str-length< [ + 2drop f + ] [ + dup str-length pick str-length swap - rot str-tail = + ] ifte ; -: str-tail? ( str end -- str ) - #! If the string ends with end, return the start of the - #! string before end. Otherwise, return f. - 2dup str-length< [ 2drop f ] [ tuck str-tailcut =? ] ifte ; - -: ?str-tail ( str end -- str ? ) - dupd str-tail? dup [ nip t ] [ drop f ] ifte ; +: ?str-tail ( str end -- ? ) + 2dup str-tail? [ + str-length swap [ str-length swap - ] keep str-head t + ] [ + drop f + ] ifte ; : split1 ( string split -- before after ) 2dup index-of dup -1 = [ @@ -130,11 +129,6 @@ M: sbuf = sbuf= ; rot str-head swap ] ifte ; -: max-str-length ( list -- len ) - #! Returns the length of the longest string in the given - #! list. - 0 swap [ str-length max ] each ; - : str-each ( str [ code ] -- ) #! Execute the code, with each character of the string #! pushed onto the stack. diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index d93117058f..b347e261fb 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -27,7 +27,6 @@ IN: prettyprint USE: errors -USE: format USE: generic USE: kernel USE: lists diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor index e89fa25c93..727e461bd5 100644 --- a/library/syntax/unparser.factor +++ b/library/syntax/unparser.factor @@ -28,7 +28,6 @@ IN: unparser USE: generic USE: kernel -USE: format USE: lists USE: math USE: namespaces @@ -142,7 +141,7 @@ M: complex unparse ( num -- str ) ] assoc ; : ch>unicode-escape ( ch -- esc ) - >hex 4 digits "\\u" swap cat2 ; + >hex 4 "0" pad "\\u" swap cat2 ; : unparse-ch ( ch -- ch/str ) dup quotable? [ diff --git a/library/test/format.factor b/library/test/format.factor deleted file mode 100644 index 69bf341ae0..0000000000 --- a/library/test/format.factor +++ /dev/null @@ -1,12 +0,0 @@ -IN: scratchpad -USE: format -USE: test - -[ "123" ] [ 4 "123" decimal-tail ] unit-test -[ "12" ] [ 2 "123" decimal-tail ] unit-test -[ "123" ] [ "123" 2 decimal-places ] unit-test -[ "123.12" ] [ "123.12" 2 decimal-places ] unit-test -[ "123.123" ] [ "123.123" 5 decimal-places ] unit-test -[ "123" ] [ "123.123" 0 decimal-places ] unit-test -[ "05" ] [ "5" 2 digits ] unit-test -[ "666" ] [ "666" 2 digits ] unit-test diff --git a/library/test/strings.factor b/library/test/strings.factor index f549116991..1e06d37e33 100644 --- a/library/test/strings.factor +++ b/library/test/strings.factor @@ -43,13 +43,13 @@ USE: test [ "goodbye" f ] [ "goodbye" " " split1 ] unit-test [ "" "" ] [ "great" "great" split1 ] unit-test -[ "and end" ] [ "Beginning and end" "Beginning " str-head? ] unit-test -[ f ] [ "Beginning and end" "Beginning x" str-head? ] unit-test -[ f ] [ "Beginning and end" "eginning " str-head? ] unit-test +[ "and end" t ] [ "Beginning and end" "Beginning " ?str-head ] unit-test +[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-head ] unit-test +[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?str-head ] unit-test -[ "Beginning" ] [ "Beginning and end" " and end" str-tail? ] unit-test -[ f ] [ "Beginning and end" "Beginning x" str-tail? ] unit-test -[ f ] [ "Beginning and end" "eginning " str-tail? ] unit-test +[ "Beginning" t ] [ "Beginning and end" " and end" ?str-tail ] unit-test +[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-tail ] unit-test +[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?str-tail ] unit-test [ [ "This" "is" "a" "split" "sentence" ] ] [ "This is a split sentence" " " split ] @@ -62,16 +62,10 @@ unit-test [ [ "a" "b" "c" "d" "e" "f" ] ] [ "aXXbXXcXXdXXeXXf" "XX" split ] unit-test -[ 6 ] -[ - [ "One" "Two" "Little" "Piggy" "Went" "To" "The" "Market" ] - max-str-length -] unit-test - -[ "Hello world" ] [ "Hello world\n" "\n" str-tail? ] unit-test -[ f ] [ "Hello world" "\n" str-tail? ] unit-test -[ "" ] [ "\n" "\n" str-tail? ] unit-test -[ f ] [ "" "\n" str-tail? ] unit-test +[ "Hello world" t ] [ "Hello world\n" "\n" ?str-tail ] unit-test +[ "Hello world" f ] [ "Hello world" "\n" ?str-tail ] unit-test +[ "" t ] [ "\n" "\n" ?str-tail ] unit-test +[ "" f ] [ "" "\n" ?str-tail ] unit-test [ t ] [ CHAR: a letter? ] unit-test [ f ] [ CHAR: A letter? ] unit-test @@ -101,3 +95,6 @@ unit-test [ dup CHAR: \s = [ drop CHAR: + ] when ] str-map ] unit-test + +[ "05" ] [ "5" 2 "0" pad ] unit-test +[ "666" ] [ "666" 2 "0" pad ] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index 8fced0fc5e..9bbd5a4ce5 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -78,7 +78,6 @@ USE: unparser "namespaces" "generic" "files" - "format" "parser" "parse-number" "prettyprint" diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor index 2e4a833f92..6cfbf989d1 100644 --- a/library/tools/inspector.factor +++ b/library/tools/inspector.factor @@ -26,7 +26,6 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: inspector -USE: format USE: kernel USE: hashtables USE: lists @@ -38,6 +37,7 @@ USE: words USE: prettyprint USE: unparser USE: vectors +USE: math : relative>absolute-object-path ( string -- string ) "object-path" get [ "'" rot cat3 ] when* ; @@ -60,6 +60,9 @@ USE: vectors 3list default-style append ; +: pad-string ( len str -- str ) + str-length - " " fill ; + : var-name. ( max name -- ) tuck unparse pad-string write dup link-style swap unparse swap write-attr ; @@ -67,6 +70,11 @@ USE: vectors : value. ( max name value -- ) >r var-name. ": " write r> . ; +: max-str-length ( list -- len ) + #! Returns the length of the longest string in the given + #! list. + 0 swap [ str-length max ] each ; + : name-padding ( alist -- col ) [ car unparse ] map max-str-length ; diff --git a/library/tools/jedit.factor b/library/tools/jedit.factor index 1c06d2237f..2e5603075e 100644 --- a/library/tools/jedit.factor +++ b/library/tools/jedit.factor @@ -88,10 +88,10 @@ USE: words : word-file ( path -- dir file ) dup [ - dup "resource:/" str-head? dup [ - nip resource-path swap + "resource:/" ?str-head [ + resource-path swap ] [ - swap ( f file ) + f swap ] ifte ] [ f diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor index d99757ab6e..0dbb06a6b7 100644 --- a/library/tools/word-tools.factor +++ b/library/tools/word-tools.factor @@ -82,7 +82,7 @@ USE: math : vocab-completions ( substring vocab -- list ) #! Used by jEdit plugin. Like vocab-apropos, but only #! matches at the start of a word name are considered. - words [ word-name over str-head? ] subset nip ; + words [ word-name over ?str-head nip ] subset nip ; : apropos. ( substring -- ) #! List all words that contain a string.