From ad4729712c46327d566b3bea3d9d226fad264602 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 17:21:15 -0600 Subject: [PATCH 1/5] remove combinators that nobody uses --- extra/combinators/lib/lib.factor | 9 --------- 1 file changed, 9 deletions(-) diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index ac8c3d11d8..5e78d183b0 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -116,18 +116,9 @@ MACRO: construct-slots ( assoc tuple-class -- tuple ) [ dip ] curry swap 1quotation [ keep ] curry compose ] { } assoc>map concat compose ; -: either ( object first second -- ? ) - >r keep swap [ r> drop ] [ r> call ] ?if ; inline - : 2quot-with ( obj seq quot1 quot2 -- seq quot1 quot2 ) >r pick >r with r> r> swapd with ; -: or? ( obj quot1 quot2 -- ? ) - [ keep ] dip rot [ 2nip ] [ call ] if* ; inline - -: and? ( obj quot1 quot2 -- ? ) - [ keep ] dip rot [ call ] [ 2drop f ] if ; inline - MACRO: multikeep ( word out-indexes -- ... ) [ dup >r [ \ npick \ >r 3array % ] each From ce00c953847e8680158882209acade3e13735d02 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 17:22:05 -0600 Subject: [PATCH 2/5] remove some trivial definitions from lint --- extra/lint/lint.factor | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index a8320c1464..77b0b11238 100644 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -44,11 +44,13 @@ SYMBOL: def-hash-keys : trivial-defs { + [ drop ] [ 2array ] + [ bitand ] + [ . ] [ get ] [ t ] [ f ] [ { } ] - [ drop ] ! because of declare [ drop f ] [ "cdecl" ] [ first ] [ second ] [ third ] [ fourth ] @@ -80,6 +82,12 @@ def-hash get-global [ drop empty? not ] assoc-filter ! Remove trivial defs [ drop trivial-defs member? not ] assoc-filter +! Remove numbers only defs +[ drop [ number? ] all? not ] assoc-filter + +! Remove curry only defs +[ drop [ \ curry = ] all? not ] assoc-filter + ! Remove tag defs [ drop { From 819239edb9718c9149cbad1cdf33c6b0db5e06ae Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 23:51:13 -0600 Subject: [PATCH 3/5] add file-systems. word --- basis/tools/files/files.factor | 35 ++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 58c24ef6ca..18baedae0a 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -1,14 +1,15 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators io io.files kernel -math.parser sequences system vocabs.loader calendar ; +math.parser sequences system vocabs.loader calendar math +symbols fry prettyprint ; IN: tools.files > ] [ minute>> ] bi - [ number>string 2 CHAR: 0 pad-left ] bi@ ":" swap 3append ; + [ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ; : ls-timestamp ( timestamp -- string ) [ month>> month-abbreviation ] @@ -32,7 +33,37 @@ PRIVATE> : directory. ( path -- ) [ (directory.) ] with-directory-files [ print ] each ; +SYMBOLS: device-name mount-point type +available-space free-space used-space total-space +percent-used percent-free ; + +: percent ( real -- integer ) 100 * >integer ; inline + +: file-system-spec ( file-system-info obj -- str ) + { + { device-name [ device-name>> ] } + { mount-point [ mount-point>> ] } + { type [ type>> ] } + { available-space [ available-space>> ] } + { free-space [ free-space>> ] } + { used-space [ used-space>> ] } + { total-space [ total-space>> ] } + { percent-used [ + [ used-space>> ] [ total-space>> ] bi dup 0 = + [ 2drop 0 ] [ / percent ] if + ] } + } case ; + +: file-systems-info ( spec -- seq ) + file-systems swap '[ _ [ file-system-spec ] with map ] map ; + +: file-systems. ( spec -- ) + [ file-systems-info ] + [ [ unparse ] map ] bi prefix simple-table. ; + { { [ os unix? ] [ "tools.files.unix" ] } { [ os windows? ] [ "tools.files.windows" ] } } cond require + +! { device-name free-space used-space total-space percent-used } file-systems. From 24c9337db6c29f65a3c124a60285a6308297f955 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 00:05:52 -0600 Subject: [PATCH 4/5] remove >r r> --- basis/state-parser/state-parser.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/state-parser/state-parser.factor b/basis/state-parser/state-parser.factor index dab5414b49..9341f39426 100644 --- a/basis/state-parser/state-parser.factor +++ b/basis/state-parser/state-parser.factor @@ -139,7 +139,7 @@ M: not-enough-characters summary ( obj -- str ) : expect ( ch -- ) get-char 2dup = [ 2drop ] [ - >r 1string r> 1string expected + [ 1string ] bi@ expected ] if next ; : expect-string ( string -- ) @@ -155,4 +155,4 @@ M: not-enough-characters summary ( obj -- str ) swap [ init-parser call ] with-input-stream ; inline : string-parse ( input quot -- ) - >r r> state-parse ; inline + [ ] dip state-parse ; inline From 90cdb6c4f4fc23b3e9c63591c3a5fcd5d22f8fa2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 00:10:24 -0600 Subject: [PATCH 5/5] remove >r r> --- basis/memoize/memoize-tests.factor | 4 ++-- basis/nmake/nmake.factor | 2 +- basis/random/mersenne-twister/mersenne-twister-tests.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/memoize/memoize-tests.factor b/basis/memoize/memoize-tests.factor index 1f819d281d..7ee56866ce 100644 --- a/basis/memoize/memoize-tests.factor +++ b/basis/memoize/memoize-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: math kernel memoize tools.test parser +USING: math kernel memoize tools.test parser generalizations prettyprint io.streams.string sequences eval ; IN: memoize.tests @@ -9,7 +9,7 @@ MEMO: fib ( m -- n ) [ 89 ] [ 10 fib ] unit-test -[ "USING: kernel math memoize ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) >r >r >r >r 1+ r> r> r> r> ;" eval ] must-fail +[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" eval ] must-fail MEMO: see-test ( a -- b ) reverse ; diff --git a/basis/nmake/nmake.factor b/basis/nmake/nmake.factor index 80c3ce3411..61a0950ce4 100644 --- a/basis/nmake/nmake.factor +++ b/basis/nmake/nmake.factor @@ -10,7 +10,7 @@ SYMBOL: building-seq : n, ( obj n -- ) get-building-seq push ; : n% ( seq n -- ) get-building-seq push-all ; -: n# ( num n -- ) >r number>string r> n% ; +: n# ( num n -- ) [ number>string ] dip n% ; : 0, ( obj -- ) 0 n, ; : 0% ( seq -- ) 0 n% ; diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index 8a2a5031fa..fe58e3d07c 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -11,7 +11,7 @@ IN: random.mersenne-twister.tests 100 [ 100 random ] replicate ; : test-rng ( seed quot -- ) - >r r> with-random ; + [ ] dip with-random ; [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test