]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorJohn Benediktsson <mrjbq7@gmail.com>
Mon, 8 Dec 2008 21:09:44 +0000 (13:09 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Mon, 8 Dec 2008 21:09:44 +0000 (13:09 -0800)
basis/memoize/memoize-tests.factor
basis/nmake/nmake.factor
basis/random/mersenne-twister/mersenne-twister-tests.factor
basis/state-parser/state-parser.factor
basis/tools/files/files.factor
extra/combinators/lib/lib.factor
extra/lint/lint.factor

index 1f819d281df998fa318c4d6199d45a935129531e..7ee56866cecd823dde9e3d1f3fc2f650d80f251c 100644 (file)
@@ -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 ;
 
index 80c3ce3411cdac137b4a2b67e95e429d640b1382..61a0950ce4a5d8523df2cd9d35de6ed8fa7419d4 100644 (file)
@@ -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% ;
index 8a2a5031fadc9ff5bff583768a7993a5fd83d3ce..fe58e3d07c02ba5629aa46d178ba33fbf3d48604 100644 (file)
@@ -11,7 +11,7 @@ IN: random.mersenne-twister.tests
     100 [ 100 random ] replicate ;
 
 : test-rng ( seed quot -- )
-    >r <mersenne-twister> r> with-random ;
+    [  <mersenne-twister> ] dip with-random ;
 
 [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
 
index dab5414b49ec18d0b7e80ce7b72b7d0696913a13..9341f39426530205c61a0b52f6ba90657abeaaff 100644 (file)
@@ -139,7 +139,7 @@ M: not-enough-characters summary ( obj -- str )
 \r
 : expect ( ch -- )\r
     get-char 2dup = [ 2drop ] [\r
-        >r 1string r> 1string expected\r
+        [ 1string ] bi@ expected\r
     ] if next ;\r
 \r
 : expect-string ( string -- )\r
@@ -155,4 +155,4 @@ M: not-enough-characters summary ( obj -- str )
     swap [ init-parser call ] with-input-stream ; inline\r
 \r
 : string-parse ( input quot -- )\r
-    >r <string-reader> r> state-parse ; inline\r
+    [ <string-reader> ] dip state-parse ; inline\r
index 58c24ef6ca935f25800641deb1f608be3460aaa1..18baedae0a98200ccce9428a85ff006a05b36eff 100755 (executable)
@@ -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
 
 <PRIVATE
 
 : ls-time ( timestamp -- string )
     [ hour>> ] [ 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.
index ac8c3d11d8e6bc9218c6bfd8d23b658b429498b2..5e78d183b0b5f2bd791b2c49c43793ba04ab1aac 100755 (executable)
@@ -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
index a8320c1464febb412e7f932dfa9ace6a927a6b1c..77b0b11238745b74311de3c089dd175cbbc7fbf5 100644 (file)
@@ -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 {