steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

class introspection tools

cvs
Slava Pestov 2005-04-10 22:58:30 +00:00
parent e7a0913e90
commit 86e09c52ae
21 changed files with 218 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
doc/tools.tex
View File

@ -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}

9
library/alien/aliens.factor
View File

@ -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
prettyprint stdio unparser ;
USING: hashtables kernel lists math namespaces parser stdio ;
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 )

8
library/bootstrap/boot-stage1.factor
View File

@ -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

3
library/bootstrap/boot-stage2.factor
View File

@ -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"

4
library/bootstrap/boot-stage3.factor
View File

@ -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"

2
library/bootstrap/image.factor
View File

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

14
library/bootstrap/primitives.factor
View File

@ -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 ] -- )

8
library/generic/generic.factor
View File

@ -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

38
library/io/directories.factor Normal file
View File

@ -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 ;

36
library/io/files.factor
View File

@ -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
streams strings unparser ;
USING: kernel lists strings ;
! 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 ;

10
library/syntax/prettyprint.factor
View File

@ -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
parser presentation sequences stdio streams strings unparser
vectors words ;
USING: alien errors generic hashtables kernel lists math
namespaces parser presentation sequences stdio streams strings
unparser vectors words ;
SYMBOL: prettyprint-limit
SYMBOL: one-line
@ -30,6 +30,7 @@ M: object prettyprint* ( indent obj -- indent )
[[ "Execute" "execute" ]]
[[ "jEdit" "jedit" ]]
[[ "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

36
library/syntax/see.factor
View File

@ -1,8 +1,8 @@
! 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
presentation streams unparser words ;
USING: generic hashtables kernel lists math namespaces
presentation stdio streams strings unparser words ;
! Prettyprinting words
: vocab-actions ( search -- list )
@ -83,27 +83,21 @@ M: compound (see) ( word -- )
[ word-def prettyprint-elements \ ; word. ] keep
prettyprint-plist terpri drop ;
: prettyprint-M: ( indent -- indent )
\ M: word-bl tab-size get + ;
: prettyprint-M: ( -- indent )
\ M: word-bl tab-size get ;
: prettyprint-; \ ; word. terpri ;
: see-method ( indent word class method -- indent )
>r >r >r prettyprint-M:
r> r> word-bl
word-bl
dup prettyprint-newline
r> prettyprint-elements
prettyprint-; tab-size get - ;
: method. ( word [[ class method ]] -- )
uncons >r >r >r prettyprint-M: r> r> word-bl word-bl
dup prettyprint-newline r> prettyprint-elements
prettyprint-; drop ;
: see-generic ( word -- )
0 swap dup methods [
over >r uncons see-method r>
] each 2drop ;
: generic. ( word -- ) dup methods [ method. ] each-with ;
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 ;

3
library/syntax/unparser.factor
View File

@ -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 ;

5
library/test/generic.factor
View File

@ -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

1
library/test/prettyprint.factor
View File

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

14
library/tools/debugger.factor
View File

@ -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 -- ) . ;

27
library/tools/word-tools.factor
View File

@ -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 ;

14
library/vocabularies.factor
View File

@ -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 ;
inline
all-words swap each ; 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.

14
library/words.factor
View File

@ -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
#! the crossref hash.
crossref get closure ;
#! List all usages of a word. This is a transitive closure,
#! so indirect usages are reported.
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 ;