diff --git a/basis/tuple-arrays/tuple-arrays-docs.factor b/basis/tuple-arrays/tuple-arrays-docs.factor index 5e70e15aa7..72a5ae4df3 100644 --- a/basis/tuple-arrays/tuple-arrays-docs.factor +++ b/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 }" diff --git a/basis/tuple-arrays/tuple-arrays-tests.factor b/basis/tuple-arrays/tuple-arrays-tests.factor index 2eeae20aa1..0fbf0eeaa0 100644 --- a/basis/tuple-arrays/tuple-arrays-tests.factor +++ b/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 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 first bing>> ] unit-test [ f ] [ 1 first bong>> ] unit-test -TUPLE: broken x ; +TUPLE: broken x ; final : broken ( -- ) ; TUPLE-ARRAY: broken -[ 100 ] [ 100 length ] unit-test \ No newline at end of file +[ 100 ] [ 100 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 \ No newline at end of file diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor index aea51f7820..1a3091c1e2 100644 --- a/basis/tuple-arrays/tuple-arrays.factor +++ b/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 ; + ] ; @@ -29,6 +31,13 @@ MACRO: write-tuple ( class -- quot ) [ tuple-arity iota [ '[ [ _ ] 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 } diff --git a/extra/benchmark/tuple-arrays/tuple-arrays.factor b/extra/benchmark/tuple-arrays/tuple-arrays.factor index 701db77135..80c31553c1 100644 --- a/extra/benchmark/tuple-arrays/tuple-arrays.factor +++ b/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