huge code cleanup

TODO.FACTOR.txt

@@ -36,6 +36,7 @@
 
 + listener/plugin:
 
+- use decl wrong
 - faster completion
 - sidekick: still parsing too much
 - errors don't always disappear

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 -- )

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"

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 )
 

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 [
+        "no-" ?str-head not put
-            f put drop
+    ] ifte* ;
-        ] [
-            drop t put
-        ] ifte
-    ] 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 f-or-"" [ "-" ?str-head [ cli-param f ] when ] unless ;
-        dup "-" str-head? dup [
-            cli-param drop f
-        ] [
-            drop
-        ] ifte
-    ] unless ;
 
 : parse-switches ( args -- args )
     [ cli-arg ] map ;

library/format.factor

@@ -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 ;

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
 

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 -- )
     [

library/httpd/html-tags.factor

@@ -26,7 +26,6 @@
 IN: html
 USE: strings
 USE: lists
-USE: format
 USE: kernel
 USE: stdio
 USE: namespaces

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 , "; " , ;

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

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 )

library/io/ansi.factor

@@ -28,7 +28,6 @@
 IN: ansi
 USE: lists
 USE: kernel
-USE: format
 USE: namespaces
 USE: stdio
 USE: streams

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.

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-head? ( str begin -- ? )
-    str-length str/ ;
+    2dup str-length< [
-
+        2drop f
-: =? ( x y z -- z/f )
+    ] [
-    #! Push z if x = y, otherwise f.
+        dup str-length rot str-head =
-    >r = r> f ? ;
+    ] ifte ;
-
-: 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 -- 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-tail? ( str end -- ? )
-    str-length >r dup str-length r> - str/ swap ;
+    2dup str-length< [
+        2drop f
+    ] [
+        dup str-length pick str-length swap - rot str-tail =
+    ] ifte ;
 
-: str-tail? ( str end -- str )
+: ?str-tail ( str end -- ? )
-    #! If the string ends with end, return the start of the
+    2dup str-tail? [
-    #! string before end. Otherwise, return f.
+        str-length swap [ str-length swap - ] keep str-head t
-    2dup str-length< [ 2drop f ] [ tuck str-tailcut =? ] ifte ;
+    ] [
-
+        drop f
-: ?str-tail ( str end -- str ? )
+    ] ifte ;
-    dupd str-tail? dup [ nip 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.

library/syntax/prettyprint.factor

@@ -27,7 +27,6 @@
 
 IN: prettyprint
 USE: errors
-USE: format
 USE: generic
 USE: kernel
 USE: lists

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? [

library/test/format.factor

@@ -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

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
+[ "and end" t ] [ "Beginning and end" "Beginning " ?str-head ] unit-test
-[ f ] [ "Beginning and end" "Beginning x" str-head? ] unit-test
+[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-head ] unit-test
-[ f ] [ "Beginning and end" "eginning " 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
+[ "Beginning" t ] [ "Beginning and end" " and end" ?str-tail ] unit-test
-[ f ] [ "Beginning and end" "Beginning x" str-tail? ] unit-test
+[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-tail ] unit-test
-[ f ] [ "Beginning and end" "eginning " 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 ]
+[ "Hello world" t ] [ "Hello world\n" "\n" ?str-tail ] unit-test
-[
+[ "Hello world" f ] [ "Hello world" "\n" ?str-tail ] unit-test
-    [ "One" "Two" "Little" "Piggy" "Went" "To" "The" "Market" ]
+[ "" t ] [ "\n" "\n" ?str-tail ] unit-test
-    max-str-length
+[ "" f ] [ "" "\n" ?str-tail ] unit-test
-] 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
 
 [ 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

library/test/test.factor

@@ -78,7 +78,6 @@ USE: unparser
         "namespaces"
         "generic"
         "files"
-        "format"
         "parser"
         "parse-number"
         "prettyprint"

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 ;
 

library/tools/jedit.factor

@@ -88,10 +88,10 @@ USE: words
 
 : word-file ( path -- dir file )
     dup [
-        dup "resource:/" str-head? dup [
+        "resource:/" ?str-head [
-            nip resource-path swap
+            resource-path swap
         ] [
-            swap ( f file )
+            f swap
         ] ifte
     ] [
         f

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.