-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate classes.singleton
generic.single generic.standard generic.hook io io.pathnames
io.streams.string io.styles kernel make namespaces prettyprint
prettyprint.backend prettyprint.config prettyprint.custom
-prettyprint.sections sequences sets sorting strings summary words
-words.symbol words.constant words.alias ;
+prettyprint.sections sequences sets slots sorting strings summary
+words words.symbol words.constant words.alias vocabs ;
+FROM: namespaces => set ;
+FROM: classes => members ;
+RENAME: members sets => set-members
IN: see
GENERIC: synopsis* ( defspec -- )
: synopsis ( defspec -- str )
[
+ string-limit? off
0 margin set
1 line-limit set
[ synopsis* ] with-in
: stack-effect. ( word -- )
[ print-stack-effect? ] [ stack-effect ] bi and
- [ effect>string comment. ] when* ;
+ [ pprint-effect ] when* ;
<PRIVATE
: seeing-word ( word -- )
- vocabulary>> pprinter-in set ;
+ vocabulary>> dup [ lookup-vocab ] when pprinter-in set ;
: word-synopsis ( word -- )
{
[ stack-effect. ]
} cleave ;
-M: method-body synopsis*
+M: method synopsis*
[ definer. ]
- [ "method-class" word-prop pprint-word ]
+ [ "method-class" word-prop pprint-class ]
[ "method-generic" word-prop pprint-word ] tri ;
M: mixin-instance synopsis*
M: pathname synopsis* pprint* ;
+M: alias summary
+ [
+ 0 margin set 1 line-limit set
+ [
+ {
+ [ seeing-word ]
+ [ definer. ]
+ [ pprint-word ]
+ [ stack-effect pprint-effect ]
+ } cleave
+ ] with-in
+ ] with-string-writer ;
+
M: word summary synopsis ;
GENERIC: declarations. ( obj -- )
M: word declarations.
{
POSTPONE: delimiter
+ POSTPONE: deprecated
POSTPONE: inline
POSTPONE: recursive
POSTPONE: foldable
<block \ MIXIN: pprint-word
dup pprint-word <block
dup members [
- hard line-break
+ hard add-line-break
\ INSTANCE: pprint-word pprint-word pprint-word
] with each block> block> ;
dup name>> ,
dup class>> object eq? [
dup class>> ,
- initial: ,
- dup initial>> ,
] unless
dup read-only>> [
read-only ,
] when
+ dup [ class>> object eq? not ] [ initial>> ] bi or [
+ initial: ,
+ dup initial>> ,
+ ] when
drop
] { } make ;
dup length 1 = [ first ] when
pprint-slot-name ;
+: tuple-declarations. ( class -- )
+ \ final declaration. ;
+
+: superclass. ( class -- )
+ superclass dup tuple eq? [ drop ] [ "<" text pprint-word ] if ;
+
M: tuple-class see-class*
<colon \ TUPLE: pprint-word
- dup pprint-word
- dup superclass tuple eq? [
- "<" text dup superclass pprint-word
- ] unless
- <block "slots" word-prop [ pprint-slot ] each block>
- pprint-; block> ;
+ {
+ [ pprint-word ]
+ [ superclass. ]
+ [ <block "slots" word-prop [ pprint-slot ] each block> pprint-; ]
+ [ tuple-declarations. ]
+ } cleave
+ block> ;
M: word see-class* drop ;
M: builtin-class see-class*
- drop "! Built-in class" comment. ;
+ <block
+ \ BUILTIN: pprint-word
+ [ pprint-word ]
+ [ <block "slots" word-prop [ pprint-slot ] each pprint-; block> ] bi
+ block> ;
: see-class ( class -- )
dup class? [
] tri ;
: seeing-implementors ( class -- seq )
- dup implementors [ method ] with map natural-sort ;
+ dup implementors
+ [ [ reader? ] [ writer? ] bi or ] reject
+ [ lookup-method ] with map
+ natural-sort ;
: seeing-methods ( generic -- seq )
"methods" word-prop values natural-sort ;
dup class? [ dup seeing-implementors % ] when
dup generic? [ dup seeing-methods % ] when
drop
- ] { } make prune ;
+ ] { } make set-members ;
: see-methods ( word -- )
- methods see-all nl ;
\ No newline at end of file
+ methods see-all nl ;