class introspection tools

actions.xml

@@ -65,7 +65,7 @@
 	</ACTION>
 	<ACTION NAME="factor-usages">
 		<CODE>
-			FactorPlugin.factorWordOutputOp(view,"usages.");
+			FactorPlugin.factorWordOutputOp(view,"usages .");
 		</CODE>
 	</ACTION>
 	<ACTION NAME="factor-insert-use">

doc/tools.tex

@@ -172,10 +172,10 @@ different numeric bases. The \texttt{.b} word prints an integer in binary, \text
 
 Factor organizes code in a two-tier structure of vocabularies and words. A word is the smallest unit of code; it corresponds to a function or method in other languages. Vocabularies group related words together for easy browsing and tracking of source dependencies.
 
-Entering \texttt{vocabs.}~in the listener produces a list of all existing vocabularies:
+Entering \texttt{vocabs .}~in the listener produces a list of all existing vocabularies:
 
 \begin{alltt}
-\textbf{ok} vocabs.
+\textbf{ok} vocabs .
 \textbf{[ "alien" "ansi" "assembler" "browser-responder"
 "command-line" "compiler" "cont-responder" "errors"
 "file-responder" "files" "gadgets" "generic"
@@ -190,10 +190,10 @@ Entering \texttt{vocabs.}~in the listener produces a list of all existing vocabu
 "threads" "unparser" "url-encoding" "vectors" "words" ]}
 \end{alltt}
 
-As you can see, there are a lot of vocabularies! Now, you can use \texttt{words.}~to list the words inside a given vocabulary:
+As you can see, there are a lot of vocabularies! Now, you can use \texttt{words .}~to list the words inside a given vocabulary:
 
 \begin{alltt}
-\textbf{ok} "namespaces" words.
+\textbf{ok} "namespaces" words .
 \textbf{[ (get) , <namespace> >n append, bind change cons@
 dec extend get global inc init-namespaces list-buffer
 literal, make-list make-rlist make-rstring make-string
@@ -237,15 +237,83 @@ vector-map}
 
 From the above output, you can see that \texttt{map} is for lists, \texttt{string-map} is for strings, and \texttt{vector-map} is for vectors.
 
-The \texttt{usages.} word finds all words that refer to a given word. This word is helpful in two situations; the first is for learning -- a good way to learn a word is to see it used in context. The second is during refactoring -- if you change a word's stack effect, you must also update all words that call it.
+The \texttt{usage} word finds all words that refer to a given word and pushes a list on the stack. This word is helpful in two situations; the first is for learning -- a good way to learn a word is to see it used in context. The second is during refactoring -- if you change a word's stack effect, you must also update all words that call it. Usually you print the
+return value of \texttt{usage} using \texttt{.}:
 
 \begin{alltt}
-\textbf{ok} \ttbs string-map usages.
+\textbf{ok} \ttbs string-map usage .
 \textbf{schars>entities
 filter-null
 url-encode}
 \end{alltt}
 
+Another useful word is \texttt{usages}. Unlike \texttt{usage}, it finds all usages, even
+indirect ones -- so if a word refers to another word that refers to the given word,
+both words will be in the output list.
+
+\subsection{Exploring classes}
+
+Factor supports object-oriented programming via generic words. Generic words are called
+like ordinary words, however they can have multiple definitions, one per class, and
+these definitions do not have to appear in the same source file. Such a definition is
+termed a \emph{method}, and the method is said to \emph{specialize} on a certain
+class. A class in the most
+general sense is just a set of objects. You can output a list of classes in the system
+with \texttt{classes .}:
+
+\begin{alltt}
+\textbf{ok} classes.
+\textbf{[ alien alien-error byte-array displaced-alien
+dll ansi-stream disp-only displaced indirect operand
+register absolute absolute-16/16 relative relative-bitfld
+item kernel-error no-method border checkbox dialog editor
+ellipse etched-rect frame gadget hand hollow-ellipse
+hollow-rect label line menu pane pile plain-ellipse
+plain-rect rectangle roll-rect scroller shelf slider
+stack tile viewport world 2generic arrayed builtin
+complement generic null object predicate tuple
+tuple-class union hashtable html-stream class-tie
+computed inference-error inference-warning literal
+literal-tie value buffer port jedit-stream boolean
+general-t array cons general-list list bignum complex
+fixnum float integer number ratio rational real
+parse-error potential-float potential-ratio
+button-down-event button-up-event joy-axis-event
+joy-ball-event joy-button-down-event joy-button-up-event
+joy-hat-event key-down-event key-up-event motion-event
+quit-event resize-event user-event sequence stdio-stream
+client-stream fd-stream null-stream server string-output
+wrapper-stream LETTER blank digit letter printable sbuf
+string text POSTPONE: f POSTPONE: t vector compound
+primitive symbol undefined word ]}
+\end{alltt}
+
+If you \texttt{see} a generic word, all methods defined on the generic word are shown.
+Alternatively, you can use \texttt{methods.} to print all methods specializing on a
+given class:
+
+\begin{alltt}
+\textbf{ok} \ttbs list methods.
+\textbf{PREDICATE: general-list list
+    dup [
+        last* cdr
+    ] when not ;
+IN: gadgets
+M: list custom-sheet
+    [
+        length count
+    ] keep zip alist>sheet "Elements:" <titled> ;
+IN: prettyprint
+M: list prettyprint*
+    [
+        [
+            POSTPONE: [
+        ] car swap [
+            POSTPONE: ]
+        ] car prettyprint-sequence
+    ] check-recursion ;}
+\end{alltt}
+
 \subsection{Browsing via the HTTP server}
 
 

factor/ExternalFactor.java

@@ -173,7 +173,7 @@ public class ExternalFactor extends DefaultVocabularyLookup
 		{
 			if(!closed)
 			{
-				Cons moreVocabs = (Cons)parseObject(eval("vocabs.")).car;
+				Cons moreVocabs = (Cons)parseObject(eval("vocabs .")).car;
 				while(moreVocabs != null)
 				{
 					String vocab = (String)moreVocabs.car;

library/alien/aliens.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: hashtables kernel lists math namespaces parser
+USING: hashtables kernel lists math namespaces parser stdio ;
-prettyprint stdio unparser ;
 
 BUILTIN: dll   15 [ 1 "dll-path" f ] ;
 BUILTIN: alien 16 ;
@@ -30,12 +29,6 @@ M: alien = ( obj obj -- ? )
 
 : ALIEN: scan <alien> swons ; parsing
 
-M: alien prettyprint* ( alien -- str )
-    \ ALIEN: word-bl alien-address unparse write ;
-
-M: dll unparse ( obj -- str )
-    [ "DLL\" " , dll-path unparse-string CHAR: " , ] make-string ;
-
 : DLL" skip-blank parse-string dlopen swons ; parsing
 
 : library ( name -- object )

library/bootstrap/boot-stage1.factor

@@ -43,7 +43,7 @@ hashtables ;
         "/library/io/stdio.factor"
         "/library/io/io-internals.factor"
         "/library/io/stream-impl.factor"
-        "/library/syntax/unparser.factor"
+        "/library/io/files.factor"
         "/library/syntax/parse-numbers.factor"
         "/library/syntax/parse-words.factor"
         "/library/syntax/parse-errors.factor"
@@ -51,15 +51,13 @@ hashtables ;
         "/library/syntax/parse-stream.factor"
         "/library/syntax/generic.factor"
         "/library/syntax/parse-syntax.factor"
-        "/library/syntax/prettyprint.factor"
-        "/library/io/files.factor"
-        "/library/cli.factor"
         "/library/alien/aliens.factor"
+        "/library/cli.factor"
     ] pull-in
 
     "delegate" [ "generic" ] search
     "object" [ "generic" ] search
-    "classes" [ "generic" ] search
+    "typemap" [ "generic" ] search
     "builtins" [ "generic" ] search
 
     vocabularies get [ "generic" off ] bind

library/bootstrap/boot-stage2.factor

@@ -18,6 +18,9 @@ parse-command-line
     ] ifte ;
 
 t [
+    "/library/syntax/unparser.factor"
+    "/library/syntax/prettyprint.factor"
+
     "/library/tools/debugger.factor"
     "/library/tools/gensym.factor"
     "/library/tools/interpreter.factor"

library/bootstrap/boot-stage3.factor

@@ -25,18 +25,18 @@ t [
     "/library/in-thread.factor"
     "/library/random.factor"
 
+    "/library/io/directories.factor"
     "/library/io/buffer.factor"
     "/library/io/network.factor"
     "/library/io/logging.factor"
     "/library/io/stdio-binary.factor"
     
-    "/library/syntax/see.factor"
-    
     "/library/eval-catch.factor"
     "/library/tools/memory.factor"
     "/library/tools/listener.factor"
     "/library/io/ansi.factor"
     "/library/tools/word-tools.factor"
+    "/library/syntax/see.factor"
     "/library/test/test.factor"
     "/library/inference/test.factor"
     "/library/tools/telnetd.factor"

library/bootstrap/image.factor

@@ -278,7 +278,7 @@ M: hashtable ' ( hashtable -- pointer )
     dup vocabularies,
     <namespace> [
         vocabularies set
-        classes [ ] change
+        typemap [ ] change
         builtins [ ] change
     ] extend '
     global-offset fixup ;

library/bootstrap/primitives.factor

@@ -7,25 +7,23 @@ io-internals kernel kernel-internals lists math math-internals
 parser profiler random strings unparser vectors words
 hashtables ;
 
+! This symbol needs the same hashcode in the target as in the
+! host.
+vocabularies
+
 ! Bring up a bare cross-compiling vocabulary.
 "syntax" vocab clone
 "generic" vocab clone
 
-! These symbol needs the same hashcode in the target as in the
-! host.
-vocabularies
-classes
-
 <namespace> vocabularies set
-<namespace> classes set
+<namespace> typemap set
 num-types <vector> builtins set
 <namespace> crossref set
 
 vocabularies get [
-    reveal
-    reveal
     "generic" set
     "syntax" set
+    reveal
 ] bind
 
 : set-stack-effect ( [ vocab word effect ] -- )

library/generic/generic.factor

@@ -109,7 +109,7 @@ PREDICATE: compound 2generic ( word -- ? )
 M: 2generic definer drop \ 2GENERIC: ;
 
 ! Maps lists of builtin type numbers to class objects.
-SYMBOL: classes
+SYMBOL: typemap
 
 SYMBOL: object
 
@@ -117,7 +117,7 @@ SYMBOL: object
     append prune ;
 
 : lookup-union ( typelist -- class )
-    [ > ] sort classes get hash [ object ] unless* ;
+    [ > ] sort typemap get hash [ object ] unless* ;
 
 : class-or ( class class -- class )
     #! Return a class that both classes are subclasses of.
@@ -141,6 +141,6 @@ SYMBOL: object
 : define-class ( class metaclass -- )
     dupd "metaclass" set-word-prop
     dup builtin-supertypes [ > ] sort
-    classes get set-hash ;
+    typemap get set-hash ;
 
-classes get [ <namespace> classes set ] unless
+typemap get [ <namespace> typemap set ] unless

library/io/directories.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2004, 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: files
+USING: kernel hashtables lists namespaces presentation stdio
+streams strings unparser ;
+
+! Hyperlinked directory listings.
+
+: file-actions ( -- list )
+    [
+        [[ "Push"             ""           ]]
+        [[ "Run file"         "run-file"   ]]
+        [[ "List directory"   "directory." ]]
+        [[ "Change directory" "cd"         ]]
+    ] ;
+
+: dir-icon "/library/icons/Folder.png" ;
+ : file-icon "/library/icons/File.png" ;
+ : file-icon. directory? dir-icon file-icon ? write-icon ;
+
+: file-link. ( dir name -- )
+    tuck "/" swap cat3 dup "file-link" swons swap
+    unparse file-actions <actions> "actions" swons
+    2list write-attr ;
+
+: file. ( dir name -- )
+    #! If "doc-root" set, create links relative to it.
+    2dup "/" swap cat3 file-icon. " " write file-link. terpri ;
+
+: directory. ( dir -- )
+    #! If "doc-root" set, create links relative to it.
+    dup directory [
+        dup [ "." ".." ] contains? [
+            2drop
+        ] [
+            file.
+        ] ifte
+    ] each-with ;

library/io/files.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: files
-USING: kernel hashtables lists namespaces presentation stdio
+USING: kernel lists strings ;
-streams strings unparser ;
 
 ! Words for accessing filesystem meta-data.
 
@@ -12,36 +11,3 @@ streams strings unparser ;
 : file-length ( file -- length ) stat dup [ cdr cdr car ] when ;
 : file-extension ( filename -- extension )
     "." split cdr dup [ last ] when ;
-
-! Hyperlinked directory listings.
-
-: file-actions ( -- list )
-    [
-        [[ "Push"             ""           ]]
-        [[ "Run file"         "run-file"   ]]
-        [[ "List directory"   "directory." ]]
-        [[ "Change directory" "cd"         ]]
-    ] ;
-
-: dir-icon "/library/icons/Folder.png" ;
- : file-icon "/library/icons/File.png" ;
- : file-icon. directory? dir-icon file-icon ? write-icon ;
-
-: file-link. ( dir name -- )
-    tuck "/" swap cat3 dup "file-link" swons swap
-    unparse file-actions <actions> "actions" swons
-    2list write-attr ;
-
-: file. ( dir name -- )
-    #! If "doc-root" set, create links relative to it.
-    2dup "/" swap cat3 file-icon. " " write file-link. terpri ;
-
-: directory. ( dir -- )
-    #! If "doc-root" set, create links relative to it.
-    dup directory [
-        dup [ "." ".." ] contains? [
-            2drop
-        ] [
-            file.
-        ] ifte
-    ] each-with ;

library/syntax/prettyprint.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: prettyprint
-USING: errors generic hashtables kernel lists math namespaces
+USING: alien errors generic hashtables kernel lists math
-parser presentation sequences stdio streams strings unparser
+namespaces parser presentation sequences stdio streams strings
-vectors words ;
+unparser vectors words ;
 
 SYMBOL: prettyprint-limit
 SYMBOL: one-line
@@ -25,11 +25,12 @@ M: object prettyprint* ( indent obj -- indent )
 
 : word-actions ( -- list )
     [
-        [[ "See"     "see"     ]]
+        [[ "See"        "see"          ]]
-        [[ "Push"    ""        ]]
+        [[ "Push"       ""             ]]
-        [[ "Execute" "execute" ]]
+        [[ "Execute"    "execute"      ]]
-        [[ "jEdit"   "jedit"   ]]
+        [[ "jEdit"      "jedit"        ]]
-        [[ "Usages"  "usages." ]]
+        [[ "Usages"     "usages ."     ]]
+        [[ "Implements" "implements ." ]]
     ] ;
 
 : browser-attrs ( word -- style )
@@ -131,6 +132,9 @@ M: tuple prettyprint* ( indent tuple -- indent )
         \ << swap >list \ >> prettyprint-sequence
     ] check-recursion ;
 
+M: alien prettyprint* ( alien -- str )
+    \ ALIEN: word-bl alien-address unparse write ;
+
 : prettyprint ( obj -- )
     [
         recursion-check off

library/syntax/see.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: prettyprint
-USING: generic kernel lists math namespaces stdio strings
+USING: generic hashtables kernel lists math namespaces
-presentation streams unparser words ;
+presentation stdio streams strings unparser words ;
 
 ! Prettyprinting words
 : vocab-actions ( search -- list )
     [
-        [[ "Words"   "words."        ]]
+        [[ "Words"   "words ."       ]]
         [[ "Use"     "\"use\" cons@" ]]
         [[ "In"      "\"in\" set"    ]]
     ] ;
@@ -83,27 +83,21 @@ M: compound (see) ( word -- )
     [ word-def prettyprint-elements \ ; word. ] keep
     prettyprint-plist terpri drop ;
 
-: prettyprint-M: ( indent -- indent )
+: prettyprint-M: ( -- indent )
-    \ M: word-bl tab-size get + ;
+    \ M: word-bl tab-size get ;
 
 : prettyprint-; \ ; word. terpri ;
 
-: see-method ( indent word class method -- indent )
+: method. ( word [[ class method ]] -- )
-    >r >r >r prettyprint-M:
+    uncons >r >r >r prettyprint-M: r> r> word-bl word-bl
-    r> r> word-bl
+    dup prettyprint-newline r> prettyprint-elements
-    word-bl
+    prettyprint-; drop ;
-    dup prettyprint-newline
-    r> prettyprint-elements
-    prettyprint-; tab-size get - ;
 
-: see-generic ( word -- )
+: generic. ( word -- ) dup methods [ method. ] each-with ;
-    0 swap dup methods [
-        over >r uncons see-method r>
-    ] each 2drop ;
 
-M: generic (see) ( word -- ) see-generic ;
+M: generic (see) ( word -- ) generic. ;
 
-M: 2generic (see) ( word -- ) see-generic ;
+M: 2generic (see) ( word -- ) generic. ;
 
 M: word (see) drop ;
 
@@ -146,3 +140,11 @@ M: word class. drop ;
 : see ( word -- )
     dup prettyprint-IN: dup definer.
     dup stack-effect. terpri dup (see) class. ;
+
+: methods. ( class -- )
+    #! List all methods implemented for this class.
+    dup class.
+    dup implementors [
+        dup prettyprint-IN:
+        [ "methods" word-prop hash* ] keep swap method.
+    ] each-with ;

library/syntax/unparser.factor

@@ -100,3 +100,6 @@ M: word unparse ( obj -- str ) word-name dup "#<unnamed>" ? ;
 
 M: t unparse drop "t" ;
 M: f unparse drop "f" ;
+
+M: dll unparse ( obj -- str )
+    [ "DLL\" " , dll-path unparse-string CHAR: " , ] make-string ;

library/test/generic.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: parser prettyprint sequences stdio ;
+USING: parser prettyprint sequences stdio unparser ;
 
 USE: hashtables
 USE: namespaces
@@ -142,3 +142,6 @@ M: cons testing 2 ;
 M: f testing 3 ;
 M: sequence testing 4 ;
 [ [ 1 2 ] 2 ] [ [ 1 2 ] testing ] unit-test
+
+! Bootstrap hashing
+[ f ] [ \ f \ unparse "methods" word-prop hash not ] unit-test

library/test/prettyprint.factor

@@ -7,3 +7,4 @@ USE: kernel
 
 [ ] [ gensym dup [ ] define-compound . ] unit-test
 [ ] [ vocabs [ words [ see ] each ] each ] unit-test
+[ ] [ classes [ methods. ] each ] unit-test

library/tools/debugger.factor

@@ -93,6 +93,20 @@ M: no-method error. ( error -- )
         no-method-object unparse ,
     ] make-string print ;
 
+: parse-dump ( error -- )
+    [
+        "Parsing " ,
+        dup parse-error-file [ "<interactive>" ] unless* , ":" ,
+        dup parse-error-line [ 1 ] unless* unparse ,
+    ] make-string print
+    
+    dup parse-error-text dup string? [ print ] [ drop ] ifte
+    
+    [ parse-error-col " " fill , "^" , ] make-string print ;
+
+M: parse-error error. ( error -- )
+    dup parse-dump  delegate error. ;
+
 M: string error. ( error -- ) print ;
 
 M: object error. ( error -- ) . ;

library/tools/word-tools.factor

@@ -5,17 +5,6 @@ USING: files generic inspector lists kernel namespaces
 prettyprint stdio streams strings unparser math hashtables
 parser ;
 
-: usages. ( word -- )
-    #! List all usages of a word.
-    usages word-sort [.] ;
-
-: usage ( word -- list )
-    crossref get hash dup [ hash-keys ] when ;
-
-: usage. ( word -- )
-    #! List all direct usages of a word.
-    usage word-sort [.] ;
-
 : vocab-apropos ( substring vocab -- list )
     #! Push a list of all words in a vocabulary whose names
     #! contain a string.
@@ -38,12 +27,6 @@ parser ;
     #! List all words that contain a string.
     vocabs [ vocab-apropos. ] each-with ;
 
-: vocabs. ( -- )
-    vocabs . ;
-
-: words. ( vocab -- )
-    words . ;
-
 : word-file ( word -- file )
     "file" word-prop dup [
         "resource:/" ?string-head [
@@ -54,3 +37,13 @@ parser ;
 : reload ( word -- )
     #! Reload the source file the word originated from.
     word-file run-file ;
+
+: implementors ( class -- list )
+    #! Find a list of generics that implement a method
+    #! specializing on this class.
+    [
+        "methods" word-prop [ dupd hash ] [ f ] ifte*
+    ] word-subset word-sort nip ;
+
+: classes ( -- list )
+    [ metaclass ] word-subset ;

library/vocabularies.factor

@@ -15,19 +15,21 @@ SYMBOL: vocabularies
     #! Get a vocabulary.
     vocabularies get hash ;
 
-: word-sort ( list -- list )
-    #! Sort a list of words by name.
-    [ swap word-name swap word-name string> ] sort ;
-
 : words ( vocab -- list )
     #! Push a list of all words in a vocabulary.
     #! Filter empty slots.
     vocab dup [ hash-values [ ] subset word-sort ] when ;
 
+: all-words ( -- list )
+    [ vocabs [ words append, ] each ] make-list ;
+
 : each-word ( quot -- )
     #! Apply a quotation to each word in the image.
-    vocabs [ words [ swap dup >r call r> ] each ] each drop ;
+    all-words swap each ; inline
-    inline
+
+: word-subset ( pred -- list | pred: word -- ? )
+    #! A list of words matching the predicate.
+    all-words swap subset ; inline
 
 : recrossref ( -- )
     #! Update word cross referencing information.

library/words.factor

@@ -41,6 +41,10 @@ M: word allot-count ( w -- n ) 7 integer-slot ;
 GENERIC: set-allot-count
 M: word set-allot-count ( n w -- ) 7 set-integer-slot ;
 
+: word-sort ( list -- list )
+    #! Sort a list of words by name.
+    [ swap word-name swap word-name string> ] sort ;
+
 ! The cross-referencer keeps track of word dependencies, so that
 ! words can be recompiled when redefined.
 SYMBOL: crossref
@@ -72,9 +76,13 @@ global [ <namespace> crossref set ] bind
     dup word-def [ (remove-crossref) ] tree-each-with ;
 
 : usages ( word -- deps )
-    #! The transitive closure over the relation specified in
+    #! List all usages of a word. This is a transitive closure,
-    #! the crossref hash.
+    #! so indirect usages are reported.
-    crossref get closure  ;
+    crossref get closure word-sort ;
+
+: usage ( word -- list )
+    #! List all direct usages of a word.
+    crossref get hash dup [ hash-keys ] when word-sort ;
 
 GENERIC: (uncrossref) ( word -- )
 M: word (uncrossref) drop ;