some code cleanups, factorbot PING fix

examples/factorbot.factor

@@ -1,8 +1,8 @@
 ! Simple IRC bot written in Factor.
 
-IN: factorbot
 USING: generic hashtables http io kernel math namespaces
 prettyprint sequences strings words ;
+IN: factorbot
 
 SYMBOL: irc-stream
 SYMBOL: nickname
@@ -48,6 +48,9 @@ M: privmsg handle-irc ( line -- )
     [ "factorbot-commands" ] search dup
     [ execute ] [ 2drop ] ifte ;
 
+M: ping handle-irc ( line -- )
+    "PING " ?head drop "PONG " swap append irc-print ;
+
 : parse-irc ( line -- )
     ":" ?head [ "!" split1 swap speaker set ] when handle-irc ;
 

library/collections/cons.factor

@@ -40,13 +40,6 @@ PREDICATE: general-list list ( list -- ? )
 
 : 2car ( cons cons -- car car ) swap car swap car ;
 : 2cdr ( cons cons -- car car ) swap cdr swap cdr ;
-: 2cons ( ca1 ca2 cd1 cd2 -- c1 c2 ) rot swons >r cons r> ;
-: 2uncons ( c1 c2 -- ca1 ca2 cd1 cd2 ) [ 2car ] 2keep 2cdr ;
-
-: unzip ( assoc -- keys values )
-    #! Split an association list into two lists of keys and
-    #! values.
-    [ uncons >r uncons r> unzip 2cons ] [ [ ] [ ] ] ifte* ;
 
 : unpair ( list -- list1 list2 )
     [ uncons uncons unpair rot swons >r cons r> ] [ f f ] ifte* ;

library/collections/sequences-epilogue.factor

@@ -239,6 +239,10 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
     #! { { 1 2 3 } { 4 5 6 } } ==> { { 1 2 } { 3 4 } { 5 6 } }
     dup first length [ swap [ nth ] map-with ] map-with ;
 
+: max-length ( seq -- n )
+    #! Longest sequence length in a sequence of sequences.
+    0 [ length max ] reduce ;
+
 IN: kernel
 
 : depth ( -- n )

library/inference/branches.factor

@@ -1,11 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: inference
-USING: errors generic interpreter kernel lists math namespaces
-sequences strings vectors words hashtables prettyprint ;
-
-: longest ( list -- length )
-    [ length ] map 0 [ max ] reduce ;
+USING: errors generic hashtables interpreter kernel lists math
+matrices namespaces prettyprint sequences strings vectors words ;
 
 : computed-value-vector ( n -- vector )
     empty-vector [ drop object <computed> ] map ;
@@ -14,53 +11,48 @@ sequences strings vectors words hashtables prettyprint ;
     #! Add this many inputs to the given stack.
     [ length - computed-value-vector ] keep append ;
 
-: unify-lengths ( list -- list )
+: unify-lengths ( seq -- list )
     #! Pad all vectors to the same length. If one vector is
     #! shorter, pad it with unknown results at the bottom.
-    dup longest swap [ add-inputs ] map-with ;
+    dup max-length swap [ add-inputs ] map-with ;
 
-: unify-results ( list -- value )
+: unify-results ( seq -- value )
     #! If all values in list are equal, return the value.
     #! Otherwise, unify types.
-    dup [ eq? ] fiber? [
-        car
-    ] [
-        [ value-class ] map class-or-list <computed>
-    ] ifte ;
+    dup [ eq? ] fiber?
+    [ first ]
+    [ [ value-class ] map class-or-list <computed> ] ifte ;
 
-: unify-stacks ( list -- stack )
+: unify-stacks ( seq -- stack )
     #! Replace differing literals in stacks with unknown
     #! results.
     unify-lengths seq-transpose [ unify-results ] map ;
 
-: balanced? ( list -- ? )
-    #! Check if a list of [[ instack outstack ]] pairs is
-    #! balanced.
-    [ uncons length swap length - ] map [ = ] fiber? ;
+: balanced? ( in out -- ? )
+    swap [ length ] map swap [ length ] map v- [ = ] fiber? ;
 
-: unify-effect ( list -- in out )
-    #! Unify a list of [[ instack outstack ]] pairs.
-    dup balanced? [
-        unzip unify-stacks >r unify-stacks r>
-    ] [
-        "Unbalanced branches" inference-error
-    ] ifte ;
+: unify-effect ( in out -- in out )
+    2dup balanced?
+    [ unify-stacks >r unify-stacks r> ]
+    [ "Unbalanced branches" inference-error ] ifte ;
 
-: datastack-effect ( list -- )
-    [ [ effect ] bind ] map
+: datastack-effect ( seq -- )
+    dup [ d-in swap hash ] map
+    swap [ meta-d swap hash ] map
     unify-effect
     meta-d set d-in set ;
 
-: callstack-effect ( list -- )
-    [ [ { } meta-r get ] bind cons ] map
+: callstack-effect ( seq -- )
+    dup length { } <repeated>
+    swap [ meta-r swap hash ] map
     unify-effect
     meta-r set drop ;
 
-: filter-terminators ( list -- list )
+: filter-terminators ( seq -- seq )
     #! Remove branches that unconditionally throw errors.
     [ [ active? ] bind ] subset ;
 
-: unify-effects ( list -- )
+: unify-effects ( seq -- )
     filter-terminators [
         dup datastack-effect callstack-effect
     ] [

library/test/lists/assoc.factor

@@ -45,6 +45,3 @@ USE: test
 [ [ [ "one" + ] [ "four" * ] ] ] [
     "three" "quot-alist" get remove-assoc
 ] unit-test
-
-[ [ "one" "three" "four" ] [ [ + ] [ - ] [ * ] ] ]
-[ "quot-alist" get unzip ] unit-test

library/test/lists/cons.factor

@@ -34,4 +34,3 @@ USE: test
 
 [ 1 3 ] [ [[ 1 2 ]] [[ 3 4 ]] 2car ] unit-test
 [ 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2cdr ] unit-test
-[ 1 3 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2uncons ] unit-test

library/test/memory.factor

@@ -10,9 +10,14 @@ TUPLE: testing x y z ;
     num-types [
         [
             builtin-type [
-                "predicate" word-prop instances [
-                    class drop
-                ] each
+                dup \ cons = [
+                    ! too many conses!
+                    drop
+                ] [
+                    "predicate" word-prop instances [
+                        class drop
+                    ] each
+                ] ifte
             ] when*
         ] keep
     ] repeat

library/tools/inspector.factor

@@ -23,11 +23,11 @@ M: vector sheet unit ;
 
 M: array sheet unit ;
 
-M: hashtable sheet hash>alist unzip 2list ;
+M: hashtable sheet dup hash-keys swap hash-values 2list ;
 
 : column ( list -- list )
     [ unparse ] map
-    [ [ length ] map 0 [ max ] reduce ] keep
+    [ max-length ] keep
     [ swap CHAR: \s pad-right ] map-with ;
 
 : format-sheet ( sheet -- list )

native/io.c

@@ -60,6 +60,10 @@ void primitive_fwrite(void)
 	maybe_gc(0);
 	file = (FILE*)unbox_alien();
 	text = untag_string(dpop());
+
+	if(string_capacity(text) == 0)
+		return;
+
 	if(fwrite(to_c_string_unchecked(text),1,
 		untag_fixnum_fast(text->length),
 		file) == 0)