see works with generics

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 9130aa10c1c03ff82115b32750392fa7096231c1..badfa4cb7169cdba1163b9ef7e16e67461ddf939 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -19,7 +19,7 @@
 \r
 + oop:\r
 \r
-- make see work with generics\r
+- make see work with union, builtin, predicate\r
 - doc comments of generics\r
 - redo traits with generic method map\r
 \r

diff --git a/factor/jedit/FactorPlugin.java b/factor/jedit/FactorPlugin.java
index 3e7420b09f894e8f2d3f75422f4e1b382f2a5c19..d526b237a5b0fe3386a815f56bc46b0f140e776a 100644 (file)
--- a/factor/jedit/FactorPlugin.java
+++ b/factor/jedit/FactorPlugin.java
@@ -121,10 +121,6 @@ public class FactorPlugin extends EditPlugin
                                        new String[args.size()]));
 
                                external = new ExternalFactor(PORT);
-
-                               process.getErrorStream().close();
-                               process.getInputStream().close();
-                               process.getOutputStream().close();
                        }
                        catch(Exception e)
                        {
@@ -157,6 +153,9 @@ public class FactorPlugin extends EditPlugin
                        external.close();
                        try
                        {
+                               process.getErrorStream().close();
+                               process.getInputStream().close();
+                               process.getOutputStream().close();
                                process.waitFor();
                        }
                        catch(Exception e)
@@ -164,6 +163,7 @@ public class FactorPlugin extends EditPlugin
                                Log.log(Log.DEBUG,FactorPlugin.class,e);
                        }
                        external = null;
+                       process = null;
                }
        } //}}}
        

diff --git a/factor/jedit/FactorShell.java b/factor/jedit/FactorShell.java
index 760ff0aa26fb57961d66f6632ec11223da720883..b1f8d6306c9e6b0aaa68f70d8647627cf1692329 100644 (file)
--- a/factor/jedit/FactorShell.java
+++ b/factor/jedit/FactorShell.java
@@ -82,6 +82,7 @@ public class FactorShell extends Shell
                try
                {
                        state = getConsoleState(console);
+                       state.openStream();
                        state.packetLoop(output);
                }
                catch(Exception e)
@@ -210,14 +211,14 @@ public class FactorShell extends Shell
                        }
                        else
                        {
-                               /* try
+                               try
                                {
                                        packetLoop(output);
                                }
                                catch(Exception e)
                                {
                                        Log.log(Log.ERROR,this,e);
-                               } */
+                               }
                        }
                }
 
@@ -264,8 +265,6 @@ public class FactorShell extends Shell
                        if(waitingForInput)
                                return;
 
-                       openStream();
-
                        if(stream == null)
                                return;
 

diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor
index 1db73197fd92f9bc863357dc147d4c713b35da6d..987f40996b5b7161897d5e5085ca052e18c3c85d 100644 (file)
--- a/library/generic/builtin.factor
+++ b/library/generic/builtin.factor
@@ -50,6 +50,9 @@ builtin [
 
 builtin 50 "priority" set-word-property
 
+! All builtin types are equivalent in ordering
+builtin [ 2drop t ] "class<" set-word-property
+
 : builtin-predicate ( type# symbol -- )
     over f type = [
         nip [ not ] "predicate" set-word-property

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index 02a289fbf11361f48192d307b9b9639b00cb2b89..e4077dedd97563db25313b3241322959d6c51277 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -80,10 +80,14 @@ USE: math-internals
 : class-ord ( class -- n ) metaclass "priority" word-property ;
 
 : class< ( cls1 cls2 -- ? )
-    swap class-ord swap class-ord < ;
+    over metaclass over metaclass = [
+        dup metaclass "class<" word-property call
+    ] [
+        swap class-ord swap class-ord <
+    ] ifte ;
 
-: sort-methods ( methods -- alist )
-    hash>alist [ 2car class< ] sort ;
+: methods ( generic -- alist )
+    "methods" word-property hash>alist [ 2car class< ] sort ;
 
 : add-method ( generic vtable definition class -- )
     #! Add the method entry to the vtable. Unlike define-method,
@@ -95,8 +99,9 @@ USE: math-internals
 : <empty-vtable> ( -- vtable )
     num-types [ drop [ undefined-method ] ] vector-project ;
 
-: <vtable> ( generic methods -- vtable )
-    >r <empty-vtable> r> sort-methods [
+: <vtable> ( generic -- vtable )
+    <empty-vtable> over methods [
+        ( generic vtable method )
         >r 2dup r> unswons add-method
     ] each nip ;
 
@@ -104,21 +109,28 @@ USE: math-internals
     over "combination" word-property cons define-compound ;
 
 : (define-method) ( definition class generic -- )
-    [ "methods" word-property set-hash ] keep
-    dup dup "methods" word-property <vtable>
+    [ "methods" word-property set-hash ] keep dup <vtable>
     define-generic ;
 
+: init-methods ( word -- )
+     dup "methods" word-property [
+         drop
+     ] [
+        <namespace> "methods" set-word-property
+     ] ifte ;
+
 ! Defining generic words
-: (GENERIC) ( combination -- )
+: (GENERIC) ( combination definer -- )
     #! Takes a combination parameter. A combination is a
     #! quotation that takes some objects and a vtable from the
     #! stack, and calls the appropriate row of the vtable.
-    CREATE [ swap "combination" set-word-property ] keep
-    dup dup "methods" word-property [
-        dup <namespace> [ "methods" set-word-property ] keep
-    ] unless* <vtable> define-generic ;
+    CREATE
+    [ swap "definer" set-word-property ] keep
+    [ swap "combination" set-word-property ] keep
+    dup init-methods
+    dup <vtable> define-generic ;
 
-PREDICATE: word generic ( word -- ? )
+PREDICATE: compound generic ( word -- ? )
     "combination" word-property ;
 
 : single-combination ( obj vtable -- )
@@ -127,7 +139,7 @@ PREDICATE: word generic ( word -- ? )
 : GENERIC:
     #! GENERIC: bar creates a generic word bar. Add methods to
     #! the generic word using M:.
-    [ single-combination ] (GENERIC) ; parsing
+    [ single-combination ] \ GENERIC: (GENERIC) ; parsing
 
 : arithmetic-combination ( n n vtable -- )
     #! Note that the numbers remain on the stack, possibly after
@@ -139,7 +151,7 @@ PREDICATE: word generic ( word -- ? )
     #! the generic word using M:. 2GENERIC words dispatch on
     #! arithmetic types and should not be used for non-numerical
     #! types.
-    [ arithmetic-combination ] (GENERIC) ; parsing
+    [ arithmetic-combination ] \ 2GENERIC: (GENERIC) ; parsing
 
 : define-method ( class -- quotation )
     #! In a vain attempt at something resembling a "meta object

diff --git a/library/generic/object.factor b/library/generic/object.factor
index edd24e3faa29bcc465ebcf93bfda9ea429589220..61e5941f242d7b8b1c43554dd9e01ace56338a5a 100644 (file)
--- a/library/generic/object.factor
+++ b/library/generic/object.factor
@@ -55,4 +55,6 @@ object [ drop t ] "predicate" set-word-property
 
 object 100 "priority" set-word-property
 
+object [ 2drop t ] "class<" set-word-property
+
 object object define-class

diff --git a/library/generic/predicate.factor b/library/generic/predicate.factor
index ef17c0e1e1fa7a6c2f76635c4b71f64ab2103a85..ae07db14680dfd8ea0b72c4a781c8f2f0448e973 100644 (file)
--- a/library/generic/predicate.factor
+++ b/library/generic/predicate.factor
@@ -65,6 +65,14 @@ predicate [
 
 predicate 25 "priority" set-word-property
 
+predicate [
+    2dup = [
+        2drop t
+    ] [
+        >r "superclass" word-property r> class<
+    ] ifte
+] "class<" set-word-property
+
 : define-predicate ( class predicate definition -- )
     rot "superclass" word-property "predicate" word-property
     [ \ dup , append, , [ drop f ] , \ ifte , ] make-list

diff --git a/library/generic/traits.factor b/library/generic/traits.factor
index b56cedf48ea47da706e747abf966666bbe4858af..2172f000037baab65d387c690b1a2c58ee9e2ee4 100644 (file)
--- a/library/generic/traits.factor
+++ b/library/generic/traits.factor
@@ -92,6 +92,8 @@ traits [
 
 traits 10 "priority" set-word-property
 
+traits [ 2drop t ] "class<" set-word-property
+
 : init-traits-map ( word -- )
     <namespace> "traits-map" set-word-property ;
 

diff --git a/library/generic/union.factor b/library/generic/union.factor
index 8da98f582d4bd465a2de83afd801fbc254758ab7..a90ce324ef8bed3049f51d5994fe097ecb47ec93 100644 (file)
--- a/library/generic/union.factor
+++ b/library/generic/union.factor
@@ -52,6 +52,8 @@ union [
 
 union 30 "priority" set-word-property
 
+union [ 2drop t ] "class<" set-word-property
+
 : union-predicate ( definition -- list )
     [
         [

diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor
index 2120f31a1d92839994b77718271829c9ba42d04e..a68c20793fa0b294ca0d9bc77e9561278fd4ffb0 100644 (file)
--- a/library/syntax/prettyprint.factor
+++ b/library/syntax/prettyprint.factor
@@ -58,20 +58,17 @@ M: object prettyprint* ( indent obj -- indent )
 : prettyprint-newline ( indent -- )
     "\n" write indent ;
 
-: prettyprint-space ( -- )
-    " " write ;
-
 : prettyprint-element ( indent obj -- indent )
     over prettyprint-limit get >= [
         unparse write
     ] [
         prettyprint*
-    ] ifte prettyprint-space ;
+    ] ifte " " write ;
 
 : <prettyprint ( indent -- indent )
     tab-size +
     "prettyprint-single-line" get [
-        prettyprint-space
+        " " write
     ] [
         dup prettyprint-newline
     ] ifte ;
@@ -128,7 +125,7 @@ M: word prettyprint* ( indent word -- indent )
         ] [
             [
                 \ | prettyprint*
-                prettyprint-space prettyprint-element
+                " " write prettyprint-element
             ] when*
         ] ifte
     ] when* ;
@@ -150,7 +147,7 @@ M: vector prettyprint* ( indent vector -- indent )
     dup vector-length 0 = [
         drop
         \ { prettyprint*
-        prettyprint-space
+        " " write
         \ } prettyprint*
     ] [
         swap prettyprint-{ swap prettyprint-vector prettyprint-}
@@ -166,7 +163,7 @@ M: hashtable prettyprint* ( indent hashtable -- indent )
     hash>alist dup length 0 = [
         drop
         \ {{ prettyprint*
-        prettyprint-space 
+        " " write 
         \ }} prettyprint*
     ] [
         swap prettyprint-{{ swap prettyprint-list prettyprint-}}

diff --git a/library/syntax/see.factor b/library/syntax/see.factor
index 5b7276de89b252041c75668e851766bbdf35e0c9..953f5bea4ef6c34fb24b33787f9f6fc4788e90b0 100644 (file)
--- a/library/syntax/see.factor
+++ b/library/syntax/see.factor
@@ -53,11 +53,11 @@ USE: words
     dup vocab-attrs write-attr ;
 
 : prettyprint-IN: ( word -- )
-    \ IN: prettyprint* prettyprint-space
-    word-vocabulary prettyprint-vocab prettyprint-space ;
+    \ IN: prettyprint* " " write
+    word-vocabulary prettyprint-vocab " " write ;
 
 : prettyprint-: ( indent -- indent )
-    \ : prettyprint* prettyprint-space
+    \ : prettyprint* " " write
     tab-size + ;
 
 : prettyprint-; ( indent -- indent )
@@ -66,7 +66,7 @@ USE: words
 
 : prettyprint-prop ( word prop -- )
     tuck word-name word-property [
-        prettyprint-space prettyprint-1
+        " " write prettyprint-1
     ] [
         drop
     ] ifte ;
@@ -98,28 +98,43 @@ USE: words
         stack-effect. dup prettyprint-newline
     ] keep documentation. ;
 
-GENERIC: see ( word -- )
+: prettyprint-M: ( indent -- indent )
+    \ M: prettyprint-1 " " write tab-size + ;
 
-M: object see ( obj -- )
-    "Not a word: " write . ;
+GENERIC: see ( word -- )
 
 M: compound see ( word -- )
-    [ prettyprint-IN: ] keep
+    dup prettyprint-IN:
     0 prettyprint-: swap
     [ prettyprint-1 ] keep
     [ prettyprint-docs ] keep
     [ word-parameter prettyprint-list prettyprint-; ] keep
     prettyprint-plist prettyprint-newline ;
 
+: see-method ( indent word class method -- indent )
+    >r >r >r prettyprint-M:
+    r> prettyprint-1 " " write
+    r> prettyprint-1 " " write
+    dup prettyprint-newline
+    r> prettyprint-list
+    prettyprint-;
+    terpri ;
+
+M: generic see ( word -- )
+    dup prettyprint-IN:
+    0 swap
+    dup "definer" word-property prettyprint-1 " " write
+    dup prettyprint-1 terpri
+    dup methods [ over >r uncons see-method r> ] each 2drop ;
+
 M: primitive see ( word -- )
     dup prettyprint-IN:
     "PRIMITIVE: " write dup prettyprint-1 stack-effect. terpri ;
 
 M: symbol see ( word -- )
     dup prettyprint-IN:
-    0 swap
-    \ SYMBOL: prettyprint-1 prettyprint-space . ;
+    \ SYMBOL: prettyprint-1 " " write . ;
 
 M: undefined see ( word -- )
     dup prettyprint-IN:
-    \ DEFER: prettyprint-1 prettyprint-space . ;
+    \ DEFER: prettyprint-1 " " write . ;

diff --git a/library/test/generic.factor b/library/test/generic.factor
index cdb3eae3881506acd9364252044d61fb276dd0a5..d55899ffa12c600438d2fbb45c71292beffdc20f 100644 (file)
--- a/library/test/generic.factor
+++ b/library/test/generic.factor
@@ -142,3 +142,6 @@ M: very-funny gooey sq ;
 [ t ] [ del1 builtin-supertypes [ integer? ] all? ] unit-test
 
 [ cons ] [ [ 1 2 ] class ] unit-test
+
+[ t ] [ \ generic \ compound class< ] unit-test
+[ f ] [ \ compound \ generic class< ] unit-test