diff --git a/basis/bit-vectors/bit-vectors.factor b/basis/bit-vectors/bit-vectors.factor index cdfe48b164..7febe6fc1b 100644 --- a/basis/bit-vectors/bit-vectors.factor +++ b/basis/bit-vectors/bit-vectors.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel kernel.private math sequences sequences.private growable bit-arrays prettyprint.custom @@ -9,6 +9,7 @@ IN: bit-vectors SYNTAX: ?V{ \ } [ >bit-vector ] parse-literal ; +M: bit-vector contract 2drop ; M: bit-vector >pprint-sequence ; M: bit-vector pprint-delims drop \ ?V{ \ } ; M: bit-vector pprint* pprint-object ; diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor index e4534e5948..6635fbeaf2 100644 --- a/basis/specialized-vectors/functor/functor.factor +++ b/basis/specialized-vectors/functor/functor.factor @@ -19,6 +19,8 @@ WHERE V A vectors.functor:define-vector +M: V contract 2drop ; + M: V pprint-delims drop \ V{ \ } ; M: V >pprint-sequence ; diff --git a/basis/struct-arrays/struct-arrays-tests.factor b/basis/struct-arrays/struct-arrays-tests.factor index 8ce45ccc15..7347b94628 100755 --- a/basis/struct-arrays/struct-arrays-tests.factor +++ b/basis/struct-arrays/struct-arrays-tests.factor @@ -35,4 +35,6 @@ C-STRUCT: test-struct 10 "test-struct" malloc-struct-array &free drop ] with-destructors -] unit-test \ No newline at end of file +] unit-test + +[ 15 ] [ 15 10 "point" resize length ] unit-test \ No newline at end of file diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor index 5aaf2c2ea6..a033de5e14 100755 --- a/basis/struct-arrays/struct-arrays.factor +++ b/basis/struct-arrays/struct-arrays.factor @@ -20,6 +20,10 @@ M: struct-array set-nth-unsafe M: struct-array new-sequence element-size>> [ * ] 2keep struct-array boa ; inline +M: struct-array resize ( n seq -- newseq ) + [ [ element-size>> * ] [ underlying>> ] bi resize ] [ element-size>> ] 2bi + struct-array boa ; + : ( length c-type -- struct-array ) heap-size [ * ] 2keep struct-array boa ; inline diff --git a/basis/struct-vectors/struct-vectors-docs.factor b/basis/struct-vectors/struct-vectors-docs.factor new file mode 100644 index 0000000000..368b054565 --- /dev/null +++ b/basis/struct-vectors/struct-vectors-docs.factor @@ -0,0 +1,16 @@ +IN: struct-vectors +USING: help.markup help.syntax alien strings math ; + +HELP: struct-vector +{ $class-description "The class of growable C struct and union arrays." } ; + +HELP: +{ $values { "capacity" integer } { "c-type" string } { "struct-vector" struct-vector } } +{ $description "Creates a new vector with the given initial capacity." } ; + +ARTICLE: "struct-vectors" "C struct and union vectors" +"The " { $vocab-link "struct-vectors" } " vocabulary implements vectors specialized for holding C struct and union values. These are growable versions of " { $vocab-link "struct-arrays" } "." +{ $subsection struct-vector } +{ $subsection } ; + +ABOUT: "struct-vectors" diff --git a/basis/struct-vectors/struct-vectors-tests.factor b/basis/struct-vectors/struct-vectors-tests.factor new file mode 100644 index 0000000000..cff65d3371 --- /dev/null +++ b/basis/struct-vectors/struct-vectors-tests.factor @@ -0,0 +1,20 @@ +IN: struct-vectors.tests +USING: struct-vectors tools.test alien.c-types kernel sequences ; + +C-STRUCT: point + { "float" "x" } + { "float" "y" } ; + +: make-point ( x y -- point ) + "point" + [ set-point-y ] keep + [ set-point-x ] keep ; + +[ ] [ 1 "point" "v" set ] unit-test + +[ 1.5 6.0 ] [ + 1.0 2.0 make-point "v" get push + 3.0 4.5 make-point "v" get push + 1.5 6.0 make-point "v" get push + "v" get pop [ point-x ] [ point-y ] bi +] unit-test \ No newline at end of file diff --git a/basis/struct-vectors/struct-vectors.factor b/basis/struct-vectors/struct-vectors.factor new file mode 100644 index 0000000000..252a46d640 --- /dev/null +++ b/basis/struct-vectors/struct-vectors.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors byte-arrays growable kernel math sequences +sequences.private struct-arrays ; +IN: struct-vectors + +TUPLE: struct-vector +{ underlying struct-array } +{ length array-capacity } +{ c-type read-only } ; + +: ( capacity c-type -- struct-vector ) + [ 0 ] keep struct-vector boa ; inline + +M: struct-vector new-sequence + [ c-type>> ] [ [ >fixnum ] [ c-type>> ] bi ] 2bi + struct-vector boa ; + +M: struct-vector contract 2drop ; + +M: struct-array new-resizable c-type>> ; + +INSTANCE: struct-vector growable \ No newline at end of file diff --git a/core/byte-vectors/byte-vectors.factor b/core/byte-vectors/byte-vectors.factor index c273cea867..fc3d9501c7 100644 --- a/core/byte-vectors/byte-vectors.factor +++ b/core/byte-vectors/byte-vectors.factor @@ -26,6 +26,8 @@ M: byte-vector new-sequence M: byte-vector equal? over byte-vector? [ sequence= ] [ 2drop f ] if ; +M: byte-vector contract 2drop ; + M: byte-array like #! If we have an byte-array, we're done. #! If we have a byte-vector, and it's at full capacity, diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 684aab1158..754a3293d1 100644 --- a/core/growable/growable.factor +++ b/core/growable/growable.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel kernel.private math math.private sequences sequences.private ; @@ -18,10 +18,12 @@ M: growable set-nth-unsafe underlying>> set-nth-unsafe ; : expand ( len seq -- ) [ resize ] change-underlying drop ; inline -: contract ( len seq -- ) +GENERIC: contract ( len seq -- ) + +M: growable contract ( len seq -- ) [ length ] keep [ [ 0 ] 2dip set-nth-unsafe ] curry - (each-integer) ; inline + (each-integer) ; : growable-check ( n seq -- n seq ) over 0 < [ bounds-error ] when ; inline