1 ! Copyright (C) 2010 Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators definitions kernel
4 locals.types namespaces parser quotations see sequences slots
6 FROM: kernel.private => declare ;
7 FROM: help.markup.private => link-effect? ;
10 PREDICATE: variable < word
11 "variable-setter" word-prop >boolean ;
13 GENERIC: variable-setter ( word -- word' )
15 M: variable variable-setter "variable-setter" word-prop ;
16 M: local-reader variable-setter "local-writer" word-prop ;
19 scan-object variable-setter suffix! ;
21 : [variable-getter] ( variable -- quot )
23 : [variable-setter] ( variable -- quot )
26 : (define-variable) ( word getter setter -- )
27 [ ( -- value ) define-inline ]
30 [ name>> "set: " prepend <uninterned-word> ]
31 [ over "variable-setter" set-word-prop ] bi
32 ] dip ( value -- ) define-inline
35 : define-variable ( word -- )
36 dup [ [variable-getter] ] [ [variable-setter] ] bi (define-variable) ;
39 scan-new-word define-variable ;
41 M: variable definer drop \ VAR: f ;
42 M: variable definition drop f ;
43 M: variable link-effect? drop f ;
44 M: variable print-stack-effect? drop f ;
46 PREDICATE: typed-variable < variable
47 "variable-type" word-prop >boolean ;
49 : [typed-getter] ( quot type -- quot )
50 1array '[ @ _ declare ] ;
51 : [typed-setter] ( quot type -- quot )
52 instance-check-quot prepose ;
54 : define-typed-variable ( word type -- )
56 [ [ [variable-getter] ] dip [typed-getter] ]
57 [ [ [variable-setter] ] dip [typed-setter] ]
58 [ "variable-type" set-word-prop ]
59 [ initial-value drop swap set-global ]
60 } 2cleave (define-variable) ;
63 scan-new-word scan-object define-typed-variable ;
65 M: typed-variable definer drop \ TYPED-VAR: f ;
66 M: typed-variable definition "variable-type" word-prop 1quotation ;
68 TUPLE: global-box value ;
70 PREDICATE: global-variable < variable
71 def>> first global-box? ;
73 : [global-getter] ( box -- quot )
75 : [global-setter] ( box -- quot )
78 : define-global ( word -- )
79 global-box new [ [global-getter] ] [ [global-setter] ] bi (define-variable) ;
82 scan-new-word define-global ;
84 M: global-variable definer drop \ GLOBAL: f ;
86 INTERSECTION: typed-global-variable
87 global-variable typed-variable ;
89 : define-typed-global ( word type -- )
90 2dup "variable-type" set-word-prop
91 dup initial-value drop global-box boa swap
92 [ [ [global-getter] ] dip [typed-getter] ]
93 [ [ [global-setter] ] dip [typed-setter] ] 2bi (define-variable) ;
96 scan-new-word scan-object define-typed-global ;
98 M: typed-global-variable definer drop \ TYPED-GLOBAL: f ;