'see' cleanup

library/bootstrap/boot-stage1.factor

@@ -93,6 +93,7 @@ sequences vectors words ;
         "/library/compiler/alien/aliens.factor"
         
         "/library/syntax/prettyprint.factor"
+        "/library/syntax/synopsis.factor"
         "/library/syntax/see.factor"
         "/library/syntax/parser.factor"
 
@@ -296,6 +297,7 @@ sequences vectors words ;
         "/library/syntax/parser.facts"
         "/library/syntax/parse-syntax.facts"
         "/library/syntax/prettyprint.facts"
+        "/library/syntax/synopsis.facts"
         "/library/syntax/see.facts"
         "/library/test/test.facts"
         "/library/tools/word-tools.facts"

library/syntax/see.factor

@@ -4,103 +4,67 @@ IN: prettyprint
 USING: arrays generic hashtables io kernel math namespaces
 sequences strings styles words ;
 
+GENERIC: definition ( spec -- quot ? )
+
+M: word definition drop f f ;
+
+M: compound definition word-def t ;
+
+M: generic definition "combination" word-prop t ;
+
+M: method-spec definition first2 "methods" word-prop hash t ;
+
+GENERIC: see ( spec -- )
+
+GENERIC: declarations. ( obj -- )
+
+M: object declarations. drop ;
+
 : declaration. ( word prop -- )
     tuck word-name word-prop [ pprint-word ] [ drop ] if ;
 
-: declarations. ( word -- )
+M: word declarations.
     {
         POSTPONE: parsing
         POSTPONE: inline
         POSTPONE: foldable
     } [ declaration. ] each-with ;
 
-: write-vocab ( vocab -- )
-    dup <vocab-link> presented associate styled-text ;
-
-: in. ( word -- )
-    word-vocabulary [
-        H{ } <block \ IN: pprint-word write-vocab block;
-    ] when* ;
-
-: (synopsis) ( word -- )
-    dup in. dup definer pprint-word pprint-word ;
-
-: comment. ( comment -- )
-    [ H{ { font-style italic } } [ text ] with-style ] when* ;
-
-: stack-picture ( seq -- string )
-    [ [ % CHAR: \s , ] each ] "" make ;
-
-: effect>string ( effect -- string )
-    [
-        "( " %
-        dup first stack-picture %
-        "-- " %
-        second stack-picture %
-        ")" %
-    ] "" make ;
-
-: stack-effect ( word -- string )
-    dup "stack-effect" word-prop [ ] [
-        "infer-effect" word-prop dup [
-            [
-                dup integer? [ object <array> ] when
-                [ word-name ] map
-            ] map effect>string
-        ] when
-    ] ?if ;
-
-: synopsis ( word -- string )
-    [
-        0 margin set [
-            dup (synopsis) stack-effect comment.
-        ] with-pprint
-    ] string-out ;
-
-GENERIC: (see) ( word -- )
-
-M: word (see) drop ;
-
 : pprint-; \ ; pprint-word ;
 
-: see-body ( quot word -- )
-    H{ } <block
-    swap pprint-elements pprint-; declarations.
-    block; ;
+: (see) ( spec -- )
+    [
+        dup (synopsis)
+        dup definition [
+            H{ } <block
+            pprint-elements pprint-; declarations.
+            block;
+        ] [
+            2drop
+        ] if newline
+    ] with-pprint ;
 
-M: compound (see)
-    dup word-def swap see-body ;
+M: method-spec see (see) ;
 
-: method. ( word class method -- )
-    \ M: pprint-word
-    >r pprint-word pprint-word r>
-    H{ } <block pprint-elements pprint-; block; ;
+GENERIC: see-methods* ( word -- seq )
 
-M: generic (see)
-    dup dup "combination" word-prop swap see-body
-    dup methods [ newline first2 method. ] each-with ;
+M: generic see-methods*
+    dup order [ swap 2array ] map-with ;
 
-GENERIC: class. ( word -- )
+M: class see-methods*
+    dup implementors [ 2array ] map-with ;
 
-: methods. ( class -- )
-    #! List all methods implemented for this class.
-    dup class? [
-        dup implementors [
-            newline
-            tuck dupd "methods" word-prop hash method.
-        ] each-with
-    ] [
-        drop
-    ] if ;
+: see-methods ( word -- )
+    see-methods* [ see ] each ;
 
-M: union class.
-    newline
+GENERIC: see-class* ( word -- )
+
+M: union see-class*
     \ UNION: pprint-word
     dup pprint-word
     members pprint-elements pprint-; ;
 
-M: predicate class.
-    newline
+M: predicate see-class*
     \ PREDICATE: pprint-word
     dup superclass pprint-word
     dup pprint-word
@@ -108,20 +72,18 @@ M: predicate class.
     "definition" word-prop pprint-elements
     pprint-; block; ;
 
-M: tuple-class class.
-    newline
+M: tuple-class see-class*
     \ TUPLE: pprint-word
     dup pprint-word
     "slot-names" word-prop [ text ] each
     pprint-; ;
 
-M: word class. drop ;
+M: word see-class* drop ;
 
-: see ( word -- )
+: see-class ( word -- )
     [
-        dup (synopsis)
-        dup (see)
-        dup class.
-        methods.
-        newline
+        dup class?
+        [ see-class* newline ] [ drop ] if
     ] with-pprint ;
+
+M: word see dup (see) dup see-class see-methods ;

library/syntax/see.facts

@@ -5,55 +5,6 @@ HELP: declaration. "( word prop -- )"
 { $description "Prettyprints " { $snippet "prop" } " if " { $snippet "word" } " defines a word property string named by " { $snippet "prop" } "." }
 $prettyprinting-note ;
 
-HELP: in. "( word -- )"
-{ $values { "word" "a word" } }
-{ $description "Prettyprints a " { $snippet "IN:" } " declaration for the word." }
-$prettyprinting-note ;
-
-HELP: (synopsis) "( word -- )"
-{ $values { "word" "a word" } }
-{ $description "Prettyprints the prologue of the word's source definition." }
-$prettyprinting-note ;
-
-HELP: comment. "( string -- )"
-{ $description "Prettyprints some text with the comment style." }
-$prettyprinting-note ;
-
-HELP: stack-effect "( word -- str )"
-{ $values { "word" "a word" } { "str" "a string" } }
-{ $description "Outputs the stack effect of a word, as a stack picture string. The stack effect is taken from either online help, or a cached inferred effect." }
-$prettyprinting-note ;
-
-HELP: synopsis "( word -- str )"
-{ $values { "word" "a word" } { "str" "a string" } }
-{ $description "Outputs a short string describing the word in Factor pseudo-code." }
-{ $examples { $example "\\ append synopsis print" "IN: sequences : append ( seq1 seq2 -- seq )" } } ;
-
-HELP: (see) "( word -- )"
-{ $values { "word" "a word" } }
-{ $contract "Prettyprints the definition of the word." }
-$prettyprinting-note ;
-
-HELP: see-body "( quot word -- )"
-{ $values { "quot" "a quotation" } { "word" "a word" } }
-{ $description "Prettyprints the elements of a quotation, followed by a semicolon (;) and any declarations for the word." }
-$prettyprinting-note ;
-
-HELP: method. "( word class method -- )"
-{ $values { "word" "a generic word" } { "class" "a class word" } { "method" "a method quotation" } }
-{ $description "Prettyprints a method definition." }
-$prettyprinting-note ;
-
-HELP: class. "( class -- )"
-{ $values { "class" "a class word" } }
-{ $contract "Prettyprints the class definition." }
-$prettyprinting-note ;
-
-HELP: methods. "( class -- )"
-{ $values { "class" "a class word" } }
-{ $contract "Prettyprints all methods defined on this class." }
-$prettyprinting-note ;
-
 HELP: see "( word -- )"
 { $values { "word" "a word" } }
 { $description "Prettyprints the definition of a word." } ;

library/syntax/synopsis.factor

@@ -0,0 +1,60 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: prettyprint
+USING: arrays generic hashtables io kernel math namespaces
+sequences styles words ;
+
+PREDICATE: array method-spec
+    dup length 2 = [
+        first2 generic? >r class? r> and
+    ] [
+        drop f
+    ] if ;
+
+GENERIC: (synopsis) ( spec -- )
+
+: write-vocab ( vocab -- )
+    dup <vocab-link> presented associate styled-text ;
+
+: in. ( word -- )
+    word-vocabulary [
+        H{ } <block \ IN: pprint-word write-vocab block;
+    ] when* ;
+
+M: word (synopsis)
+    dup in. dup definer pprint-word pprint-word ;
+
+M: method-spec (synopsis)
+    \ M: pprint-word [ pprint-word ] each ;
+
+: comment. ( comment -- )
+    [ H{ { font-style italic } } [ text ] with-style ] when* ;
+
+: stack-picture ( seq -- string )
+    [ [ % CHAR: \s , ] each ] "" make ;
+
+: effect>string ( effect -- string )
+    [
+        "( " %
+        dup first stack-picture %
+        "-- " %
+        second stack-picture %
+        ")" %
+    ] "" make ;
+
+: stack-effect ( word -- string )
+    dup "stack-effect" word-prop [ ] [
+        "infer-effect" word-prop dup [
+            [
+                dup integer? [ object <array> ] when
+                [ word-name ] map
+            ] map effect>string
+        ] when
+    ] ?if ;
+
+: synopsis ( word -- string )
+    [
+        0 margin set [
+            dup (synopsis) stack-effect comment.
+        ] with-pprint
+    ] string-out ;

library/syntax/synopsis.facts

@@ -0,0 +1,26 @@
+IN: prettyprint
+USING: help ;
+
+HELP: in. "( word -- )"
+{ $values { "word" "a word" } }
+{ $description "Prettyprints a " { $snippet "IN:" } " declaration for the word." }
+$prettyprinting-note ;
+
+HELP: (synopsis) "( word -- )"
+{ $values { "word" "a word" } }
+{ $description "Prettyprints the prologue of the word's source definition." }
+$prettyprinting-note ;
+
+HELP: comment. "( string -- )"
+{ $description "Prettyprints some text with the comment style." }
+$prettyprinting-note ;
+
+HELP: stack-effect "( word -- str )"
+{ $values { "word" "a word" } { "str" "a string" } }
+{ $description "Outputs the stack effect of a word, as a stack picture string. The stack effect is taken from either online help, or a cached inferred effect." }
+$prettyprinting-note ;
+
+HELP: synopsis "( word -- str )"
+{ $values { "word" "a word" } { "str" "a string" } }
+{ $description "Outputs a short string describing the word in Factor pseudo-code." }
+{ $examples { $example "\\ append synopsis print" "IN: sequences : append ( seq1 seq2 -- seq )" } } ;