factor/library/tools/definitions.factor

126 lines
2.7 KiB
Factor
Raw Normal View History

2006-08-02 15:17:13 -04:00
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
2006-08-02 15:17:13 -04:00
IN: definitions
2006-08-25 00:02:30 -04:00
USING: arrays errors generic hashtables io kernel math
namespaces parser prettyprint sequences styles words ;
2006-08-02 15:17:13 -04:00
2006-08-25 00:02:30 -04:00
: where ( defspec -- loc )
2006-08-26 15:23:44 -04:00
where* dup [ first2 >r ?resource-path r> 2array ] when ;
2006-08-25 00:02:30 -04:00
2006-08-02 15:17:13 -04:00
: reload ( defspec -- )
2006-08-25 00:02:30 -04:00
where first [ run-file ] when* ;
TUPLE: no-edit-hook ;
SYMBOL: edit-hook
: edit-location ( file line -- )
edit-hook get [ call ] [ <no-edit-hook> throw ] if* ;
: edit-file ( file -- ) ?resource-path 0 edit-location ;
: edit ( defspec -- )
where [
first2 edit-location
] [
"Not from a source file" throw
2006-08-26 03:27:37 -04:00
] if* ;
2006-08-02 15:17:13 -04:00
2006-09-16 17:11:55 -04:00
GENERIC: synopsis* ( defspec -- )
2006-08-02 15:17:13 -04:00
: write-vocab ( vocab -- )
dup <vocab-link> presented associate styled-text ;
: in. ( word -- )
word-vocabulary [
H{ } <block \ IN: pprint-word write-vocab block;
] when* ;
2006-08-16 21:55:53 -04:00
: comment. ( string -- )
2006-08-15 16:29:35 -04:00
[ H{ { font-style italic } } styled-text ] when* ;
2006-09-16 17:11:55 -04:00
M: word synopsis*
2006-08-15 16:29:35 -04:00
dup in.
dup definer pprint-word
dup pprint-word
2006-08-18 03:51:41 -04:00
stack-effect [ effect>string comment. ] when* ;
2006-08-02 15:17:13 -04:00
2006-09-16 17:11:55 -04:00
M: method-spec synopsis*
2006-08-02 15:17:13 -04:00
\ M: pprint-word [ pprint-word ] each ;
2006-09-16 17:11:55 -04:00
: synopsis ( defspec -- str )
[ 0 margin set [ synopsis* ] with-pprint ] string-out ;
M: word summary synopsis ;
2004-11-25 21:08:09 -05:00
2006-08-02 02:50:23 -04:00
GENERIC: definition ( spec -- quot ? )
M: word definition drop f f ;
M: compound definition word-def t ;
M: generic definition "combination" word-prop t ;
2006-08-16 21:55:53 -04:00
M: method-spec definition first2 method method-def t ;
2006-08-02 02:50:23 -04:00
GENERIC: declarations. ( obj -- )
M: object declarations. drop ;
2005-08-21 01:17:37 -04:00
: declaration. ( word prop -- )
2005-09-24 15:21:17 -04:00
tuck word-name word-prop [ pprint-word ] [ drop ] if ;
2004-11-25 21:08:09 -05:00
2006-08-02 02:50:23 -04:00
M: word declarations.
2005-11-29 23:49:59 -05:00
{
POSTPONE: parsing
POSTPONE: inline
POSTPONE: foldable
2005-11-29 23:49:59 -05:00
} [ declaration. ] each-with ;
2004-11-25 21:08:09 -05:00
2006-08-02 02:50:23 -04:00
: pprint-; \ ; pprint-word ;
2005-12-28 20:25:17 -05:00
2006-08-02 02:50:23 -04:00
: (see) ( spec -- )
[
2006-09-16 17:11:55 -04:00
dup synopsis*
2006-08-02 02:50:23 -04:00
dup definition [
H{ } <block
pprint-elements pprint-; declarations.
block;
] [
2drop
] if newline
] with-pprint ;
2005-12-28 20:25:17 -05:00
2006-08-02 02:50:23 -04:00
M: method-spec see (see) ;
2005-02-07 13:14:55 -05:00
2006-08-02 02:50:23 -04:00
GENERIC: see-class* ( word -- )
2005-08-21 14:25:05 -04:00
2006-08-02 02:50:23 -04:00
M: union see-class*
2005-08-29 01:00:55 -04:00
\ UNION: pprint-word
dup pprint-word
2005-10-05 02:01:06 -04:00
members pprint-elements pprint-; ;
2005-08-21 14:25:05 -04:00
2006-08-02 02:50:23 -04:00
M: predicate see-class*
2005-08-29 01:00:55 -04:00
\ PREDICATE: pprint-word
dup superclass pprint-word
2005-08-29 01:00:55 -04:00
dup pprint-word
H{ } <block
2005-08-21 14:25:05 -04:00
"definition" word-prop pprint-elements
2005-10-05 02:01:06 -04:00
pprint-; block; ;
2005-08-21 14:25:05 -04:00
2006-08-02 02:50:23 -04:00
M: tuple-class see-class*
2005-08-29 01:00:55 -04:00
\ TUPLE: pprint-word
dup pprint-word
"slot-names" word-prop [ text ] each
2005-10-05 02:01:06 -04:00
pprint-; ;
2005-08-21 14:25:05 -04:00
2006-08-02 02:50:23 -04:00
M: word see-class* drop ;
2005-08-21 14:25:05 -04:00
2006-08-02 02:50:23 -04:00
: see-class ( word -- )
2005-10-03 19:53:32 -04:00
[
2006-08-02 02:50:23 -04:00
dup class?
[ see-class* newline ] [ drop ] if
2005-10-03 19:53:32 -04:00
] with-pprint ;
2006-08-02 02:50:23 -04:00
2006-08-02 15:17:13 -04:00
M: word see dup (see) dup see-class see-subdefs ;