functors: make 'final' declarations work in functors

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 ;

basis/functors/functors-tests.factor

@@ -1,5 +1,5 @@
-USING: classes.struct functors tools.test math words kernel
+USING: classes.struct classes.tuple functors tools.test math
-multiline parser io.streams.string generic ;
+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

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! ;