steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

GENERIC: support in functors

db4
Joe Groff 2009-05-01 16:16:40 -05:00
parent a09187fbf8
commit 65b33c145c
2 changed files with 38 additions and 8 deletions

26
basis/functors/functors-tests.factor
View File

@ -81,7 +81,26 @@ SYMBOL: W
[ blorgh ] [ blorgh ] unit-test
GENERIC: some-generic ( a -- b )
<<
FUNCTOR: generic-test ( W -- )
W DEFINES ${W}
WHERE
GENERIC: W ( a -- b )
M: object W ;
M: integer W 1 + ;
;FUNCTOR
"snurv" generic-test
>>
[ 2 ] [ 1 snurv ] unit-test
[ 3.0 ] [ 3.0 snurv ] unit-test
! Does replacing an ordinary word with a functor-generated one work?
[ [ ] ] [
@ -89,6 +108,7 @@ GENERIC: some-generic ( a -- b )
TUPLE: some-tuple ;
: some-word ( -- ) ;
GENERIC: some-generic ( a -- b )
M: some-tuple some-generic ;
SYMBOL: some-symbol
"> <string-reader> "functors-test" parse-stream
@ -97,6 +117,7 @@ GENERIC: some-generic ( a -- b )
: test-redefinition ( -- )
[ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
[ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
[ t ] [ "some-generic" "functors.tests" lookup >boolean ] unit-test
[ t ] [
"some-tuple" "functors.tests" lookup
"some-generic" "functors.tests" lookup method >boolean
@ -109,13 +130,14 @@ FUNCTOR: redefine-test ( W -- )
W-word DEFINES ${W}-word
W-tuple DEFINES-CLASS ${W}-tuple
W-generic IS ${W}-generic
W-generic DEFINES ${W}-generic
W-symbol DEFINES ${W}-symbol
WHERE
TUPLE: W-tuple ;
: W-word ( -- ) ;
GENERIC: W-generic ( a -- b )
M: W-tuple W-generic ;
SYMBOL: W-symbol

20
basis/functors/functors.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel quotations classes.tuple make combinators generic
words interpolate namespaces sequences io.streams.string fry
classes.mixin effects lexer parser classes.tuple.parser
effects.parser locals.types locals.parser generic.parser
locals.rewrite.closures vocabs.parser classes.parser
arrays accessors words.symbol ;
USING: accessors arrays classes.mixin classes.parser
classes.tuple classes.tuple.parser combinators effects
effects.parser fry generic generic.parser generic.standard
interpolate io.streams.string kernel lexer locals.parser
locals.rewrite.closures locals.types make namespaces parser
quotations sequences vocabs.parser words words.symbol ;
IN: functors
! This is a hack
@ -18,6 +18,8 @@ IN: functors
: define-declared* ( word def effect -- ) pick set-word define-declared ;
: define-simple-generic* ( word effect -- ) over set-word define-simple-generic ;
TUPLE: fake-call-next-method ;
TUPLE: fake-quotation seq ;
@ -104,6 +106,11 @@ SYNTAX: `INSTANCE:
scan-param parsed
\ add-mixin-instance parsed ;
SYNTAX: `GENERIC:
scan-param parsed
complete-effect parsed
\ define-simple-generic* parsed ;
SYNTAX: `inline [ word make-inline ] over push-all ;
SYNTAX: `call-next-method T{ fake-call-next-method } parsed ;
@ -130,6 +137,7 @@ DEFER: ;FUNCTOR delimiter
{ "M:" POSTPONE: `M: }
{ "C:" POSTPONE: `C: }
{ ":" POSTPONE: `: }
{ "GENERIC:" POSTPONE: `GENERIC: }
{ "INSTANCE:" POSTPONE: `INSTANCE: }
{ "SYNTAX:" POSTPONE: `SYNTAX: }
{ "SYMBOL:" POSTPONE: `SYMBOL: }