tuple-arrays: require that base type be final

basis/tuple-arrays/tuple-arrays-docs.factor

@@ -3,20 +3,24 @@ USING: help.markup help.syntax sequences ;
 
 HELP: TUPLE-ARRAY:
 { $syntax "TUPLE-ARRAY: class" }
+{ $values { "class" "a final tuple class" } }
 { $description "Generates a new data type in the current vocabulary named " { $snippet { $emphasis "class" } "-array" } " for holding instances of " { $snippet "class" } ", which must be a tuple class word. Together with the class itself, this also generates words named " { $snippet "<" { $emphasis "class" } "-array>" } " and " { $snippet ">" { $emphasis "class" } "-array" } ", for creating new instances of this tuple array type." } ;
 
 ARTICLE: "tuple-arrays" "Tuple arrays"
-"The " { $vocab-link "tuple-arrays" } " vocabulary implements space-efficient unboxed tuple arrays. Whereas an ordinary array of tuples would consist of pointers to heap-allocated objects, a tuple array stores its elements inline. Calling " { $link nth } " copies an element into a new tuple, and calling " { $link set-nth } " copies an existing tuple's slots into an array."
+"The " { $vocab-link "tuple-arrays" } " vocabulary implements space-efficient unboxed tuple arrays. Whereas an ordinary array of tuples would consist of references to heap-allocated objects, a tuple array stores its elements as values."
 $nl
-"Since value semantics differ from reference semantics, it is best to use tuple arrays with tuples where all slots are declared " { $link read-only } "."
+"Calling " { $link nth } " copies an element into a new tuple, and calling " { $link set-nth } " copies an existing tuple's slots into an array."
+$nl
+"Since value semantics are incompatible with inheritance, the base type of a tuple array must be declared " { $link POSTPONE: final } ". A best practice that is not enforced is to have all slots in the tuple declared " { $link read-only } "."
+$nl
+"Tuple arrays do not get updated if tuples are redefined to add or remove slots, so caution should be exercised when doing interactive development on code that uses tuple arrays."
 $nl
-"Tuple arrays should not be used with inheritance; storing an instance of a subclass in a tuple array will slice off the subclass slots, and getting the same value out again will yield an instance of the superclass. Also, tuple arrays do not get updated if tuples are redefined to add or remove slots, so caution should be exercised when doing interactive development on code that uses tuple arrays."
 { $subsections POSTPONE: TUPLE-ARRAY: }
 "An example:"
 { $example
   "USE: tuple-arrays"
   "IN: scratchpad"
-  "TUPLE: point x y ;"
+  "TUPLE: point x y ; final"
   "TUPLE-ARRAY: point"
   "{ T{ point f 1 2 } T{ point f 1 3 } T{ point f 2 3 } } >point-array first short."
   "T{ point f 1 2 }"

basis/tuple-arrays/tuple-arrays-tests.factor

@@ -1,9 +1,9 @@
 USING: tuple-arrays sequences tools.test namespaces kernel
-math accessors ;
+math accessors classes.tuple eval ;
 IN: tuple-arrays.tests
 
 SYMBOL: mat
-TUPLE: foo bar ;
+TUPLE: foo bar ; final
 C: <foo> foo
 TUPLE-ARRAY: foo
 
@@ -18,15 +18,27 @@ TUPLE-ARRAY: foo
 [ T{ foo } ] [ mat get first ] unit-test
 [ T{ foo f 1 } ] [ T{ foo f 1 } 0 mat get [ set-nth ] keep first ] unit-test
 
-TUPLE: baz { bing integer } bong ;
+TUPLE: baz { bing integer } bong ; final
 TUPLE-ARRAY: baz
 
 [ 0 ] [ 1 <baz-array> first bing>> ] unit-test
 [ f ] [ 1 <baz-array> first bong>> ] unit-test
 
-TUPLE: broken x ;
+TUPLE: broken x ; final
 : broken ( -- ) ;
 
 TUPLE-ARRAY: broken
 
-[ 100 ] [ 100 <broken-array> length ] unit-test
+[ 100 ] [ 100 <broken-array> length ] unit-test
+
+! Can't define a tuple array for a non-tuple class
+[ "IN: tuple-arrays.tests USING: tuple-arrays words ; TUPLE-ARRAY: word" eval( -- ) ]
+[ error>> not-a-tuple? ]
+must-fail-with
+
+! Can't define a tuple array for a non-final class
+TUPLE: non-final x ;
+
+[ "IN: tuple-arrays.tests USE: tuple-arrays TUPLE-ARRAY: non-final" eval( -- ) ]
+[ error>> not-final? ]
+must-fail-with

basis/tuple-arrays/tuple-arrays.factor

@@ -1,11 +1,13 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators.smart fry functors kernel
 kernel.private macros sequences combinators sequences.private
-stack-checker parser math classes.tuple.private ;
+stack-checker parser math classes.tuple classes.tuple.private ;
 FROM: inverse => undo ;
 IN: tuple-arrays
 
+ERROR: not-final class ;
+
 <PRIVATE
 
 MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ;
@@ -29,6 +31,13 @@ MACRO: write-tuple ( class -- quot )
     [ tuple-arity iota <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
     bi '[ _ dip @ ] ;
 
+: check-final ( class -- )
+    {
+        { [ dup tuple-class? not ] [ not-a-tuple ] }
+        { [ dup final-class? not ] [ not-final ] }
+        [ drop ]
+    } cond ;
+
 PRIVATE>
 
 FUNCTOR: define-tuple-array ( CLASS -- )
@@ -43,6 +52,8 @@ CLASS-array? IS ${CLASS-array}?
 
 WHERE
 
+CLASS check-final
+
 TUPLE: CLASS-array
 { seq array read-only }
 { n array-capacity read-only }

extra/benchmark/tuple-arrays/tuple-arrays.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.functions tuple-arrays accessors fry sequences
 prettyprint ;
 IN: benchmark.tuple-arrays
 
-TUPLE: point { x float } { y float } { z float } ;
+TUPLE: point { x float } { y float } { z float } ; final
 
 TUPLE-ARRAY: point