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 appropriate
db4
Slava Pestov 2009-02-06 02:45:21 -06:00
parent 67ffc89402
commit 4adef7db09
7 changed files with 60 additions and 12 deletions

View File

@ -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
@ -62,4 +63,48 @@ 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

View File

@ -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

View File

@ -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{

View File

@ -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

View File

@ -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 ]

View File

@ -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}

View File

@ -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}{