1 ! Copyright (c) 2008 Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: words kernel sequences locals locals.parser fry
4 locals.definitions accessors parser namespaces continuations
5 summary definitions generalizations arrays prettyprint debugger io
6 effects tools.annotations ;
9 ERROR: descriptive-error args underlying word ;
11 M: descriptive-error error.
12 "The word " write dup word>> pprint " encountered an error." print
20 : rethrower ( word inputs -- quot )
21 [ length ] keep [ [ narray ] dip swap 2array flip ] 2curry
22 [ 2 ndip descriptive-error ] 2curry ;
24 : [descriptive] ( word def effect -- newdef )
25 swapd in>> rethrower [ recover ] 2curry ;
29 : make-descriptive ( word -- )
30 dup [ ] [ def>> ] [ stack-effect ] tri [descriptive]
31 '[ drop _ ] annotate ;
33 : define-descriptive ( word def effect -- )
34 [ drop "descriptive-definition" set-word-prop ]
35 [ [ [ dup ] 2dip [descriptive] ] keep define-declared ]
38 SYNTAX: DESCRIPTIVE: (:) define-descriptive ;
40 PREDICATE: descriptive < word
41 "descriptive-definition" word-prop ;
43 M: descriptive definer drop \ DESCRIPTIVE: \ ; ;
45 M: descriptive definition
46 "descriptive-definition" word-prop ;
48 SYNTAX: DESCRIPTIVE:: (::) define-descriptive ;
50 INTERSECTION: descriptive-lambda descriptive lambda-word ;
52 M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ;
54 M: descriptive-lambda definition
55 "lambda" word-prop body>> ;