more generic word cleanups

CHANGES.html

@@ -46,6 +46,7 @@
 <li>Everything else:
 
 <ul>
+<li>New <code>make-hash ( quot -- namespace )</code> combinator executes quotation in a new namespace, which is then pushed on the stack.</li>
 <li>Erlang/Termite-style concurrency library in <code>contrib/concurrency</code> (Chris Double).</li>
 <li>Object slots are now clickable in the inspector</li>
 <li>The matrices library has been greatly simplified. Matrices are now represented as vectors of vectors, and matrix words have been moved to the <code>math</code> vocabulary.</li>

TODO.FACTOR.txt

@@ -1,13 +1,6 @@
-+ messy code hall of shame:
-
-- alien/c-types.factor is ugly
-- compile-byte/cell: instantiating aliens
-- buffer: instantiating aliens
-
-- flushing optimization
 - reader syntax for arrays, byte arrays, displaced aliens
-- split, group: return vectors
 - sleep word
+- docstrings appear twice
 
 + ui:
 
@@ -56,6 +49,7 @@
 
 + ffi:
 
+- alien/c-types.factor is ugly
 - smarter out parameter handling
 - clarify powerpc passing of value struct parameters
 - ffi unicode strings: null char security hole
@@ -66,6 +60,8 @@
 
 + compiler:
 
+- flushing optimization
+- compile-byte/cell: instantiating aliens
 - changing a word to be 'inline' after it was already defined doesn't
   work properly
 - inference needs to be more robust with heavily recursive code
@@ -84,22 +80,21 @@
 
 + kernel:
 
+- split, group: return vectors
 - specialized arrays
-- clear "predicating" word prop when redefining words
+- clear special word props when redefining words
 - there is a problem with hashcodes of words and bootstrapping
 - delegating generic words with a non-standard picker
 - powerpc has weird callstack residue
 - instances: do not use make-list
-- method doc strings
 - vectors: ensure its ok with bignum indices
 - code gc
-- doc comments of generics
 
 + i/o:
 
+- buffer: instantiating aliens
 - faster stream-copy
 - reading and writing byte arrays
-- unix io: handle \n\r and \n\0
 - stream server can hang because of exception handler limitations
 - better i/o scheduler
 - utf16, utf8 encoding

library/collections/sequence-sort.factor

@@ -3,7 +3,7 @@ USING: kernel math sequences ;
 
 : midpoint ( seq -- elt ) dup length 2 /i swap nth ; inline
 
-TUPLE: sorter seq start end mid ;
+TUPLE: sorter start end mid ;
 
 C: sorter ( seq start end -- sorter )
     [ >r 1 + rot <slice> r> set-sorter-seq ] keep

library/generic/generic.factor

@@ -75,16 +75,12 @@ SYMBOL: builtin
     [ "methods" word-prop remove-hash ] keep make-generic ;
 
 : init-methods ( word -- )
-     dup "methods" word-prop [
+     dup "methods" word-prop
-         drop
+     [ drop ] [ <namespace> "methods" set-word-prop ] ifte ;
-     ] [
-        <namespace> "methods" set-word-prop
-     ] ifte ;
 
 ! Defining generic words
-: define-generic* ( picker combination word -- )
+: define-generic* ( word combination -- )
-    [ swap "combination" set-word-prop ] keep
+    dupd "combination" set-word-prop
-    [ swap "picker" set-word-prop ] keep
     dup init-methods make-generic ;
 
 PREDICATE: compound generic ( word -- ? )
@@ -92,9 +88,6 @@ PREDICATE: compound generic ( word -- ? )
 
 M: generic definer drop \ G: ;
 
-PREDICATE: generic simple-generic ( word -- ? )
-    "picker" word-prop [ dup ] = ;
-
 : lookup-union ( typelist -- class )
     [ - ] sort typemap get hash [ object ] unless* ;
 

library/generic/standard-combination.factor

@@ -2,29 +2,22 @@ IN: generic
 USING: errors hashtables kernel kernel-internals lists math
 namespaces sequences vectors words ;
 
-: picker% "picker" word-prop % ;
+: error-method ( picker word -- method )
-
+    [ swap % literalize , \ no-method , ] make-list ;
-: error-method ( generic -- method )
-    [ dup picker% literalize , \ no-method , ] make-list ;
 
 DEFER: delegate
 
-: empty-method ( generic -- method )
+: empty-method ( picker word -- method )
-    dup "picker" word-prop [ dup ] = [
+    over [ dup ] = [
         [
-            [ dup delegate ] %
+            [ dup delegate ] % dup unit , error-method , \ ?ifte ,
-            [ dup , ] make-list ,
-            error-method ,
-            \ ?ifte ,
         ] make-list
     ] [
         error-method
     ] ifte ;
 
-: class-predicates ( generic assoc -- assoc )
+: class-predicates ( picker assoc -- assoc )
-    >r "picker" word-prop r> [
+    [ uncons >r "predicate" word-prop append r> cons ] map-with ;
-        uncons >r "predicate" word-prop append r> cons
-    ] map-with ;
 
 : alist>quot ( default alist -- quot )
     [ unswons [ % , , \ ifte , ] make-list ] each ;
@@ -37,22 +30,28 @@ DEFER: delegate
         [ 2drop f ] ifte
     ] map-with ;
 
-: <vtable> ( generic -- vtable )
+: <vtable> ( picker word -- vtable )
-    dup dup methods sort-methods [ class-predicates ] map-with 
+    2dup methods sort-methods [ class-predicates ] map-with
     >r empty-method r> [ alist>quot ] map-with ;
 
-: small-generic ( word -- def )
+: small-generic ( picker word -- def )
-    dup dup methods class-predicates
+    2dup methods class-predicates >r empty-method r> alist>quot ;
-    >r empty-method r> alist>quot ;
 
-: big-generic ( word -- def )
+: big-generic ( picker word -- def )
-    [ dup picker% \ type , <vtable> , \ dispatch , ] make-list ;
+    [ over % \ type , <vtable> , \ dispatch , ] make-list ;
 
 : small-generic? ( word -- ? )
     "methods" word-prop hash-size 3 <= ;
 
-: standard-combination ( word -- quot )
+: standard-combination ( word picker -- quot )
-    dup small-generic? [ small-generic ] [ big-generic ] ifte ;
+    swap dup small-generic?
+    [ small-generic ] [ big-generic ] ifte ;
+
+: simple-combination ( word -- quot )
+    [ dup ] standard-combination ;
 
 : define-generic ( word -- )
-    >r [ dup ] [ standard-combination ] r> define-generic* ;
+    [ simple-combination ] define-generic* ;
+
+PREDICATE: generic simple-generic ( word -- ? )
+    "combination" word-prop [ simple-combination ] = ;

library/generic/union.factor

@@ -9,16 +9,9 @@ SYMBOL: union
 
 : union-predicate ( members -- list )
     [
-        [
+        "predicate" word-prop
-            \ dup ,
+        [ dup ] swap add [ drop t ] cons
-            unswons "predicate" word-prop %
+    ] map [ drop f ] swap alist>quot ;
-            [ drop t ] ,
-            union-predicate ,
-            \ ifte ,
-        ] make-list
-    ] [
-        [ drop f ]
-    ] ifte* ;
 
 : set-members ( class members -- )
     2dup [ types ] map concat "types" set-word-prop

library/syntax/generic.factor

@@ -3,15 +3,16 @@
 
 ! Bootstrapping trick; see doc/bootstrap.txt.
 IN: !syntax
-USING: syntax generic kernel lists namespaces parser words ;
+USING: generic kernel lists namespaces parser sequences syntax
+words ;
 
 : GENERIC:
-    #! GENERIC: bar == G: bar [ dup ] [ type ] ;
+    #! GENERIC: bar == G: bar simple-combination ;
     CREATE define-generic ; parsing
 
 : G:
-    #! G: word picker dispatcher ;
+    #! G: word combination ;
-    CREATE [ 2unlist rot define-generic* ] [ ] ; parsing
+    CREATE [ define-generic* ] [ ] ; parsing
 
 : COMPLEMENT: ( -- )
     #! Followed by a class name, then a complemented class.

library/syntax/see.factor

@@ -75,7 +75,7 @@ M: compound (see)
 
 M: generic (see)
     <block
-    dup dup { "picker" "combination" } [ word-prop ] map-with
+    dup dup "combination" word-prop
     swap see-body block; t newline
     dup methods [ method. ] each-with ;