1 USING: classes.struct classes.tuple functors tools.test math
2 words kernel multiline parser io.streams.string generic ;
3 QUALIFIED-WITH: alien.c-types c
8 FUNCTOR: define-box ( T -- )
10 B DEFINES-CLASS ${T}-box
15 TUPLE: B { value T } ;
25 { 1 0 } [ define-box ] must-infer-as
27 [ T{ float-box f 5.0 } ] [ 5.0 <float-box> ] unit-test
30 [ execute ] [ execute ] bi ; inline
33 FUNCTOR: wrapper-test ( W -- )
39 : WW ( a -- b ) \ W twice ;
47 [ 16 ] [ 2 sqsq ] unit-test
51 FUNCTOR: wrapper-test-2 ( W -- )
57 : W ( a b -- c ) \ + execute ;
65 [ 4 ] [ 1 3 blah ] unit-test
69 FUNCTOR: symbol-test ( W -- )
83 [ blorgh ] [ blorgh ] unit-test
87 FUNCTOR: generic-test ( W -- )
103 [ 2 ] [ 1 snurv ] unit-test
104 [ 3.0 ] [ 3.0 snurv ] unit-test
106 ! Does replacing an ordinary word with a functor-generated one work?
112 GENERIC: some-generic ( a -- b )
113 M: some-tuple some-generic ;
114 SYMBOL: some-symbol" <string-reader> "functors-test" parse-stream
117 : test-redefinition ( -- )
118 [ t ] [ "some-word" "functors.tests" lookup-word >boolean ] unit-test
119 [ t ] [ "some-tuple" "functors.tests" lookup-word >boolean ] unit-test
120 [ t ] [ "some-generic" "functors.tests" lookup-word >boolean ] unit-test
122 "some-tuple" "functors.tests" lookup-word
123 "some-generic" "functors.tests" lookup-word lookup-method >boolean
125 [ t ] [ "some-symbol" "functors.tests" lookup-word >boolean ] unit-test
129 FUNCTOR: redefine-test ( W -- )
131 W-word DEFINES ${W}-word
132 W-tuple DEFINES-CLASS ${W}-tuple
133 W-generic DEFINES ${W}-generic
134 W-symbol DEFINES ${W}-symbol
140 GENERIC: W-generic ( a -- b )
141 M: W-tuple W-generic ;
147 """IN: functors.tests
148 << "some" redefine-test >>""" <string-reader> "functors-test" parse-stream
155 FUNCTOR: define-a-struct ( T NAME TYPE N -- )
157 T-class DEFINES-CLASS ${T}
165 { z TYPE initial: 5 }
166 { float { c:float 2 } } ;
170 "a-struct" "nemo" c:char 2 define-a-struct
188 { type { c:char 4 } }
195 { type { c:short 2 } }
209 { type { c:float 2 } }
212 ] [ a-struct struct-slots ] unit-test
216 FUNCTOR: define-an-inline-word ( W -- )
219 W-W DEFINES ${W}-${W}
228 "an-inline-word" define-an-inline-word
232 [ t ] [ \ an-inline-word inline? ] unit-test
233 [ f ] [ \ an-inline-word-an-inline-word inline? ] unit-test
237 FUNCTOR: define-a-final-class ( T W -- )
250 "a-final-tuple" "a-word" define-a-final-class
254 [ t ] [ a-final-tuple final-class? ] unit-test