1 ! (c)2010 Joe Groff bsd license
2 USING: accessors arrays combinators definitions fry kernel
3 locals.types namespaces parser quotations see sequences slots
5 FROM: kernel.private => declare ;
6 FROM: help.markup.private => link-effect? ;
9 PREDICATE: variable < word
10 "variable-setter" word-prop ;
12 GENERIC: variable-setter ( word -- word' )
14 M: variable variable-setter "variable-setter" word-prop ;
15 M: local-reader variable-setter "local-writer" word-prop ;
18 scan-object variable-setter suffix! ;
20 : [variable-getter] ( variable -- quot )
22 : [variable-setter] ( variable -- quot )
25 : (define-variable) ( word getter setter -- )
26 [ (( -- value )) define-inline ]
29 [ name>> "set: " prepend <uninterned-word> ]
30 [ over "variable-setter" set-word-prop ] bi
31 ] dip (( value -- )) define-inline
34 : define-variable ( word -- )
35 dup [ [variable-getter] ] [ [variable-setter] ] bi (define-variable) ;
38 CREATE-WORD define-variable ;
40 M: variable definer drop \ VAR: f ;
41 M: variable definition drop f ;
42 M: variable link-effect? drop f ;
43 M: variable print-stack-effect? drop f ;
45 PREDICATE: typed-variable < variable
46 "variable-type" word-prop ;
48 : [typed-getter] ( quot type -- quot )
49 1array '[ @ _ declare ] ;
50 : [typed-setter] ( quot type -- quot )
51 instance-check-quot prepose ;
53 : define-typed-variable ( word type -- )
55 [ [ [variable-getter] ] dip [typed-getter] ]
56 [ [ [variable-setter] ] dip [typed-setter] ]
57 [ "variable-type" set-word-prop ]
58 [ initial-value swap set-global ]
59 } 2cleave (define-variable) ;
62 CREATE-WORD scan-object define-typed-variable ;
64 M: typed-variable definer drop \ TYPED-VAR: f ;
65 M: typed-variable definition "variable-type" word-prop 1quotation ;
67 TUPLE: global-box value ;
69 PREDICATE: global-variable < variable
70 def>> first global-box? ;
72 : [global-getter] ( box -- quot )
74 : [global-setter] ( box -- quot )
77 : define-global ( word -- )
78 global-box new [ [global-getter] ] [ [global-setter] ] bi (define-variable) ;
81 CREATE-WORD define-global ;
83 M: global-variable definer drop \ GLOBAL: f ;
85 INTERSECTION: typed-global-variable
86 global-variable typed-variable ;
88 : define-typed-global ( word type -- )
89 2dup "variable-type" set-word-prop
90 dup initial-value global-box boa swap
91 [ [ [global-getter] ] dip [typed-getter] ]
92 [ [ [global-setter] ] dip [typed-setter] ] 2bi (define-variable) ;
95 CREATE-WORD scan-object define-typed-global ;
97 M: typed-global-variable definer drop \ TYPED-GLOBAL: f ;