Fix functors bug where changing a hand-written method into one generated by a functor would forget the method; also associate functor-generated methods with the source file they're in.
Add DEFINES-CLASS, to parallel DEFINES. Update math.blas and specialized-arrays/vectors to use DEFINES-CLASS where appropriatedb4
parent
67ffc89402
commit
4adef7db09
|
@ -1,11 +1,12 @@
|
||||||
IN: functors.tests
|
IN: functors.tests
|
||||||
USING: functors tools.test math words kernel ;
|
USING: functors tools.test math words kernel multiline parser
|
||||||
|
io.streams.string generic ;
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
|
||||||
FUNCTOR: define-box ( T -- )
|
FUNCTOR: define-box ( T -- )
|
||||||
|
|
||||||
B DEFINES ${T}-box
|
B DEFINES-CLASS ${T}-box
|
||||||
<B> DEFINES <${B}>
|
<B> DEFINES <${B}>
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
@ -63,3 +64,47 @@ WHERE
|
||||||
>>
|
>>
|
||||||
|
|
||||||
[ 4 ] [ 1 3 blah ] unit-test
|
[ 4 ] [ 1 3 blah ] unit-test
|
||||||
|
|
||||||
|
GENERIC: some-generic ( a -- b )
|
||||||
|
|
||||||
|
! Does replacing an ordinary word with a functor-generated one work?
|
||||||
|
[ [ ] ] [
|
||||||
|
<" IN: functors.tests
|
||||||
|
|
||||||
|
TUPLE: some-tuple ;
|
||||||
|
: some-word ( -- ) ;
|
||||||
|
M: some-tuple some-generic ;
|
||||||
|
"> <string-reader> "functors-test" parse-stream
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
: test-redefinition ( -- )
|
||||||
|
[ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
|
||||||
|
[ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
|
||||||
|
[ t ] [
|
||||||
|
"some-tuple" "functors.tests" lookup
|
||||||
|
"some-generic" "functors.tests" lookup method >boolean
|
||||||
|
] unit-test ;
|
||||||
|
|
||||||
|
test-redefinition
|
||||||
|
|
||||||
|
FUNCTOR: redefine-test ( W -- )
|
||||||
|
|
||||||
|
W-word DEFINES ${W}-word
|
||||||
|
W-tuple DEFINES-CLASS ${W}-tuple
|
||||||
|
W-generic IS ${W}-generic
|
||||||
|
|
||||||
|
WHERE
|
||||||
|
|
||||||
|
TUPLE: W-tuple ;
|
||||||
|
: W-word ( -- ) ;
|
||||||
|
M: W-tuple W-generic ;
|
||||||
|
|
||||||
|
;FUNCTOR
|
||||||
|
|
||||||
|
[ [ ] ] [
|
||||||
|
<" IN: functors.tests
|
||||||
|
<< "some" redefine-test >>
|
||||||
|
"> <string-reader> "functors-test" parse-stream
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
test-redefinition
|
|
@ -3,8 +3,9 @@
|
||||||
USING: kernel quotations classes.tuple make combinators generic
|
USING: kernel quotations classes.tuple make combinators generic
|
||||||
words interpolate namespaces sequences io.streams.string fry
|
words interpolate namespaces sequences io.streams.string fry
|
||||||
classes.mixin effects lexer parser classes.tuple.parser
|
classes.mixin effects lexer parser classes.tuple.parser
|
||||||
effects.parser locals.types locals.parser
|
effects.parser locals.types locals.parser generic.parser
|
||||||
locals.rewrite.closures vocabs.parser arrays accessors ;
|
locals.rewrite.closures vocabs.parser classes.parser
|
||||||
|
arrays accessors ;
|
||||||
IN: functors
|
IN: functors
|
||||||
|
|
||||||
! This is a hack
|
! This is a hack
|
||||||
|
@ -29,7 +30,7 @@ M: object >fake-quotations ;
|
||||||
GENERIC: fake-quotations> ( fake -- quot )
|
GENERIC: fake-quotations> ( fake -- quot )
|
||||||
|
|
||||||
M: fake-quotation fake-quotations>
|
M: fake-quotation fake-quotations>
|
||||||
seq>> [ fake-quotations> ] map >quotation ;
|
seq>> [ fake-quotations> ] [ ] map-as ;
|
||||||
|
|
||||||
M: array fake-quotations> [ fake-quotations> ] map ;
|
M: array fake-quotations> [ fake-quotations> ] map ;
|
||||||
|
|
||||||
|
@ -57,7 +58,7 @@ M: object fake-quotations> ;
|
||||||
effect off
|
effect off
|
||||||
scan-param parsed
|
scan-param parsed
|
||||||
scan-param parsed
|
scan-param parsed
|
||||||
\ create-method parsed
|
\ create-method-in parsed
|
||||||
parse-definition*
|
parse-definition*
|
||||||
DEFINE* ; parsing
|
DEFINE* ; parsing
|
||||||
|
|
||||||
|
@ -96,6 +97,8 @@ PRIVATE>
|
||||||
|
|
||||||
: DEFINES [ create-in ] (INTERPOLATE) ; parsing
|
: DEFINES [ create-in ] (INTERPOLATE) ; parsing
|
||||||
|
|
||||||
|
: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ; parsing
|
||||||
|
|
||||||
DEFER: ;FUNCTOR delimiter
|
DEFER: ;FUNCTOR delimiter
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -256,7 +256,7 @@ XGEMM IS cblas_${T}gemm
|
||||||
XGERU IS cblas_${T}ger${U}
|
XGERU IS cblas_${T}ger${U}
|
||||||
XGERC IS cblas_${T}ger${C}
|
XGERC IS cblas_${T}ger${C}
|
||||||
|
|
||||||
MATRIX DEFINES ${TYPE}-blas-matrix
|
MATRIX DEFINES-CLASS ${TYPE}-blas-matrix
|
||||||
<MATRIX> DEFINES <${TYPE}-blas-matrix>
|
<MATRIX> DEFINES <${TYPE}-blas-matrix>
|
||||||
>MATRIX DEFINES >${TYPE}-blas-matrix
|
>MATRIX DEFINES >${TYPE}-blas-matrix
|
||||||
XMATRIX{ DEFINES ${T}matrix{
|
XMATRIX{ DEFINES ${T}matrix{
|
||||||
|
|
|
@ -134,7 +134,7 @@ XCOPY IS cblas_${T}copy
|
||||||
XSWAP IS cblas_${T}swap
|
XSWAP IS cblas_${T}swap
|
||||||
IXAMAX IS cblas_i${T}amax
|
IXAMAX IS cblas_i${T}amax
|
||||||
|
|
||||||
VECTOR DEFINES ${TYPE}-blas-vector
|
VECTOR DEFINES-CLASS ${TYPE}-blas-vector
|
||||||
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
||||||
>VECTOR DEFINES >${TYPE}-blas-vector
|
>VECTOR DEFINES >${TYPE}-blas-vector
|
||||||
|
|
||||||
|
|
|
@ -11,7 +11,7 @@ A' IS ${T}-array
|
||||||
>A' IS >${T}-array
|
>A' IS >${T}-array
|
||||||
<A'> IS <${A'}>
|
<A'> IS <${A'}>
|
||||||
|
|
||||||
A DEFINES direct-${T}-array
|
A DEFINES-CLASS direct-${T}-array
|
||||||
<A> DEFINES <${A}>
|
<A> DEFINES <${A}>
|
||||||
|
|
||||||
NTH [ T dup c-getter array-accessor ]
|
NTH [ T dup c-getter array-accessor ]
|
||||||
|
|
|
@ -15,7 +15,7 @@ M: bad-byte-array-length summary
|
||||||
|
|
||||||
FUNCTOR: define-array ( T -- )
|
FUNCTOR: define-array ( T -- )
|
||||||
|
|
||||||
A DEFINES ${T}-array
|
A DEFINES-CLASS ${T}-array
|
||||||
<A> DEFINES <${A}>
|
<A> DEFINES <${A}>
|
||||||
(A) DEFINES (${A})
|
(A) DEFINES (${A})
|
||||||
>A DEFINES >${A}
|
>A DEFINES >${A}
|
||||||
|
|
|
@ -9,7 +9,7 @@ FUNCTOR: define-vector ( T -- )
|
||||||
A IS ${T}-array
|
A IS ${T}-array
|
||||||
<A> IS <${A}>
|
<A> IS <${A}>
|
||||||
|
|
||||||
V DEFINES ${T}-vector
|
V DEFINES-CLASS ${T}-vector
|
||||||
<V> DEFINES <${V}>
|
<V> DEFINES <${V}>
|
||||||
>V DEFINES >${V}
|
>V DEFINES >${V}
|
||||||
V{ DEFINES ${V}{
|
V{ DEFINES ${V}{
|
||||||
|
|
Loading…
Reference in New Issue