functors: make 'final' declarations work in functors

diff --git a/basis/functors/backend/backend.factor b/basis/functors/backend/backend.factor
index dd3d891f7bd544bfa870b6bc9bb3fe51a1fd1a55..331864417e3577880f2735787aa323040e269c04 100644 (file)
--- a/basis/functors/backend/backend.factor
+++ b/basis/functors/backend/backend.factor
@@ -1,6 +1,6 @@
 USING: accessors arrays assocs generic.standard kernel
 lexer locals.types namespaces parser quotations vocabs.parser
-words ;
+words classes.tuple ;
 IN: functors.backend
 
 DEFER: functor-words
@@ -27,7 +27,11 @@ SYNTAX: FUNCTOR-SYNTAX:
 
 : define* ( word def -- ) over set-word define ;
 
-: define-declared* ( word def effect -- ) pick set-word define-declared ;
+: define-declared* ( word def effect -- )
+    pick set-word define-declared ;
 
-: define-simple-generic* ( word effect -- ) over set-word define-simple-generic ;
+: define-simple-generic* ( word effect -- )
+    over set-word define-simple-generic ;
 
+: define-tuple-class* ( class superclass slots -- )
+    pick set-word define-tuple-class ;

diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index 544c2ed1e4a10ca2c69c38d1415588816d58a47e..c756d1b83d58aa774a74f3851a9f21fba07655e6 100644 (file)
--- a/basis/functors/functors-tests.factor
+++ b/basis/functors/functors-tests.factor
@@ -1,5 +1,5 @@
-USING: classes.struct functors tools.test math words kernel
-multiline parser io.streams.string generic ;
+USING: classes.struct classes.tuple functors tools.test math
+words kernel multiline parser io.streams.string generic ;
 QUALIFIED-WITH: alien.c-types c
 IN: functors.tests
 
@@ -36,7 +36,7 @@ WW DEFINES ${W}${W}
 
 WHERE
 
-: WW ( a -- b ) \ W twice ; inline
+: WW ( a -- b ) \ W twice ;
 
 ;FUNCTOR
 
@@ -211,3 +211,44 @@ STRUCT: T-class
     }
 ] [ a-struct struct-slots ] unit-test
 
+<<
+
+FUNCTOR: define-an-inline-word ( W -- )
+
+W DEFINES ${W}
+W-W DEFINES ${W}-${W}
+
+WHERE
+
+: W ( -- ) ; inline
+: W-W ( -- ) W W ;
+
+;FUNCTOR
+
+"an-inline-word" define-an-inline-word
+
+>>
+
+[ t ] [ \ an-inline-word inline? ] unit-test
+[ f ] [ \ an-inline-word-an-inline-word inline? ] unit-test
+
+<<
+
+FUNCTOR: define-a-final-class ( T W -- )
+
+T DEFINES-CLASS ${T}
+W DEFINES ${W}
+
+WHERE
+
+TUPLE: T ; final
+
+: W ( -- ) ;
+
+;FUNCTOR
+
+"a-final-tuple" "a-word" define-a-final-class
+
+>>
+
+[ t ] [ a-final-tuple final-class? ] unit-test

diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 6678613002a18bf85a2f310a480c20ab58d318c5..1895c6e0f4b218b0c698f9e7a7ed47a830ad2549 100644 (file)
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -61,7 +61,7 @@ FUNCTOR-SYNTAX: TUPLE:
             make suffix!
         ]
     } case
-    \ define-tuple-class suffix! ;
+    \ define-tuple-class* suffix! ;
 
 FUNCTOR-SYNTAX: final
     [ word make-final ] append! ;