diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index b500d9f5ca..03bd21e58c 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -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 "> "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 diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index ce069ac953..edd4932c66 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -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: }