more generic word cleanups

diff --git a/CHANGES.html b/CHANGES.html
index 6a6ed71ddf41561324474ecb48f530e58e7abd50..19f0dbe12cec78095b67a43750277033818a2af4 100644 (file)
--- a/CHANGES.html
+++ b/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>

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

diff --git a/library/collections/sequence-sort.factor b/library/collections/sequence-sort.factor
index a5829f6b89fa92c312b51293a4c273e7836f1ba8..58429e098708aec0c2c9c28b55b7ea990d5aaf20 100644 (file)
--- a/library/collections/sequence-sort.factor
+++ b/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

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index 77ebfe116901a0ed2a5312f538f25f06786da48c..9ab74d8dec853bd6bc1ad7b0a139c6223a560ad7 100644 (file)
--- a/library/generic/generic.factor
+++ b/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 [
-         drop
-     ] [
-        <namespace> "methods" set-word-prop
-     ] ifte ;
+     dup "methods" word-prop
+     [ drop ] [ <namespace> "methods" set-word-prop ] ifte ;
 
 ! Defining generic words
-: define-generic* ( picker combination word -- )
-    [ swap "combination" set-word-prop ] keep
-    [ swap "picker" set-word-prop ] keep
+: define-generic* ( word combination -- )
+    dupd "combination" set-word-prop
     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* ;
 

diff --git a/library/generic/standard-combination.factor b/library/generic/standard-combination.factor
index 139944b6e5620d8b6444639e2294164bedba2190..b0b87415684547dddb11a73e7c40ba2471ac632f 100644 (file)
--- a/library/generic/standard-combination.factor
+++ b/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 ( generic -- method )
-    [ dup picker% literalize , \ no-method , ] make-list ;
+: error-method ( picker word -- method )
+    [ swap % literalize , \ no-method , ] make-list ;
 
 DEFER: delegate
 
-: empty-method ( generic -- method )
-    dup "picker" word-prop [ dup ] = [
+: empty-method ( picker word -- method )
+    over [ dup ] = [
         [
-            [ dup delegate ] %
-            [ dup , ] make-list ,
-            error-method ,
-            \ ?ifte ,
+            [ dup delegate ] % dup unit , error-method , \ ?ifte ,
         ] make-list
     ] [
         error-method
     ] ifte ;
 
-: class-predicates ( generic assoc -- assoc )
-    >r "picker" word-prop r> [
-        uncons >r "predicate" word-prop append r> cons
-    ] map-with ;
+: class-predicates ( picker assoc -- assoc )
+    [ 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 )
-    dup dup methods sort-methods [ class-predicates ] map-with 
+: <vtable> ( picker word -- vtable )
+    2dup methods sort-methods [ class-predicates ] map-with
     >r empty-method r> [ alist>quot ] map-with ;
 
-: small-generic ( word -- def )
-    dup dup methods class-predicates
-    >r empty-method r> alist>quot ;
+: small-generic ( picker word -- def )
+    2dup methods class-predicates >r empty-method r> alist>quot ;
 
-: big-generic ( word -- def )
-    [ dup picker% \ type , <vtable> , \ dispatch , ] make-list ;
+: big-generic ( picker word -- def )
+    [ over % \ type , <vtable> , \ dispatch , ] make-list ;
 
 : small-generic? ( word -- ? )
     "methods" word-prop hash-size 3 <= ;
 
-: standard-combination ( word -- quot )
-    dup small-generic? [ small-generic ] [ big-generic ] ifte ;
+: standard-combination ( word picker -- quot )
+    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 ] = ;

diff --git a/library/generic/union.factor b/library/generic/union.factor
index 04061682af514e6809397d2c7d832ba1e86021fe..e091a5669b04f0a50bb380157fd37e15766e3781 100644 (file)
--- a/library/generic/union.factor
+++ b/library/generic/union.factor
@@ -9,16 +9,9 @@ SYMBOL: union
 
 : union-predicate ( members -- list )
     [
-        [
-            \ dup ,
-            unswons "predicate" word-prop %
-            [ drop t ] ,
-            union-predicate ,
-            \ ifte ,
-        ] make-list
-    ] [
-        [ drop f ]
-    ] ifte* ;
+        "predicate" word-prop
+        [ dup ] swap add [ drop t ] cons
+    ] map [ drop f ] swap alist>quot ;
 
 : set-members ( class members -- )
     2dup [ types ] map concat "types" set-word-prop

diff --git a/library/syntax/generic.factor b/library/syntax/generic.factor
index 4a58b3b0fee54fb8645bcccb899cd0d186886e1d..d7190b5cf90eddbe280dfc88bbfc79df699c58ba 100644 (file)
--- a/library/syntax/generic.factor
+++ b/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 ;
-    CREATE [ 2unlist rot define-generic* ] [ ] ; parsing
+    #! G: word combination ;
+    CREATE [ define-generic* ] [ ] ; parsing
 
 : COMPLEMENT: ( -- )
     #! Followed by a class name, then a complemented class.

diff --git a/library/syntax/see.factor b/library/syntax/see.factor
index a518860f562f4f94f505a429e8914f64de122ddf..488338df9d45992da3fa1918f3da0ce650403a90 100644 (file)
--- a/library/syntax/see.factor
+++ b/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 ;