factor/library/tools/definitions.factor

! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: definitions
USING: arrays generic hashtables io kernel math namespaces
parser prettyprint sequences styles words ;

: ?resource-path ( path -- path )
    "resource:/" ?head [ resource-path ] when ;

: reload ( defspec -- )
    where first [ ?resource-path run-file ] when* ;

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

: comment. ( comment -- )
    [ H{ { font-style italic } } styled-text ] when* ;

M: word (synopsis)
    dup in.
    dup definer pprint-word
    dup pprint-word
    stack-effect comment. ;

M: method-spec (synopsis)
    \ M: pprint-word [ pprint-word ] each ;

: synopsis ( word -- string )
    [ 0 margin set [ (synopsis) ] with-pprint ] string-out ;

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 method t ;

GENERIC: declarations. ( obj -- )

M: object declarations. drop ;

: declaration. ( word prop -- )
    tuck word-name word-prop [ pprint-word ] [ drop ] if ;

M: word declarations.
    {
        POSTPONE: parsing
        POSTPONE: inline
        POSTPONE: foldable
    } [ declaration. ] each-with ;

: pprint-; \ ; pprint-word ;

: (see) ( spec -- )
    [
        dup (synopsis)
        dup definition [
            H{ } <block
            pprint-elements pprint-; declarations.
            block;
        ] [
            2drop
        ] if newline
    ] with-pprint ;

M: method-spec see (see) ;

GENERIC: see-class* ( word -- )

M: union see-class*
    \ UNION: pprint-word
    dup pprint-word
    members pprint-elements pprint-; ;

M: predicate see-class*
    \ PREDICATE: pprint-word
    dup superclass pprint-word
    dup pprint-word
    H{ } <block
    "definition" word-prop pprint-elements
    pprint-; block; ;

M: tuple-class see-class*
    \ TUPLE: pprint-word
    dup pprint-word
    "slot-names" word-prop [ text ] each
    pprint-; ;

M: word see-class* drop ;

: see-class ( word -- )
    [
        dup class?
        [ see-class* newline ] [ drop ] if
    ] with-pprint ;

M: word see dup (see) dup see-class see-subdefs ;