GENERIC: support in functors

diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index b500d9f5ca864c951e5523049d84c549d7fc9f4f..03bd21e58c379e60c5e3c5510cc0d0f59633c821 100644 (file)
--- 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
     "> <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
 

diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index ce069ac95335abb2224e15575614e108dd967cb5..edd4932c66a05a7451168d24a79fea2614044dee 100644 (file)
--- 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: }