growable vocabulary: make 'contract' generic so that only real vectors clear popped...

diff --git a/basis/bit-vectors/bit-vectors.factor b/basis/bit-vectors/bit-vectors.factor
index cdfe48b164b4715740b36250f7aea8bff2aae952..7febe6fc1b37bb672fa08e28eb70524a2be8a165 100644 (file)
--- a/basis/bit-vectors/bit-vectors.factor
+++ b/basis/bit-vectors/bit-vectors.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.\r
+! Copyright (C) 2008, 2009 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: arrays kernel kernel.private math sequences\r
 sequences.private growable bit-arrays prettyprint.custom\r
@@ -9,6 +9,7 @@ IN: bit-vectors
 \r
 SYNTAX: ?V{ \ } [ >bit-vector ] parse-literal ;\r
 \r
+M: bit-vector contract 2drop ;\r
 M: bit-vector >pprint-sequence ;\r
 M: bit-vector pprint-delims drop \ ?V{ \ } ;\r
 M: bit-vector pprint* pprint-object ;\r

diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor
index e4534e5948308ba282027600d78174499bb37ae1..6635fbeaf24797d6a12aa4124493ffd025870506 100644 (file)
--- a/basis/specialized-vectors/functor/functor.factor
+++ b/basis/specialized-vectors/functor/functor.factor
@@ -19,6 +19,8 @@ WHERE
 
 V A <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 8ce45ccc15345577d1d6013cd6f1139a4bff2997..7347b9462883c3f34c672fa6c7e7559d341c98e8 100755 (executable)
--- 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" <struct-array> 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 5aaf2c2ea63da53092e26644fdf9d5eef8376318..a033de5e14cb25543f29030d86d01de2e7f2bc2e 100755 (executable)
--- 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>> [ * <byte-array> ] 2keep struct-array boa ; inline
 
+M: struct-array resize ( n seq -- newseq )
+    [ [ element-size>> * ] [ underlying>> ] bi resize ] [ element-size>> ] 2bi
+    struct-array boa ;
+
 : <struct-array> ( length c-type -- struct-array )
     heap-size [ * <byte-array> ] 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 (file)
index 0000000..368b054
--- /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: <struct-vector>
+{ $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 <struct-vector> } ;
+
+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 (file)
index 0000000..cff65d3
--- /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" <c-object>
+    [ set-point-y ] keep
+    [ set-point-x ] keep ;
+
+[ ] [ 1 "point" <struct-vector> "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 (file)
index 0000000..252a46d
--- /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 } ;
+
+: <struct-vector> ( capacity c-type -- struct-vector )
+    [ <struct-array> 0 ] keep struct-vector boa ; inline
+
+M: struct-vector new-sequence
+    [ c-type>> <struct-array> ] [ [ >fixnum ] [ c-type>> ] bi ] 2bi
+    struct-vector boa ;
+
+M: struct-vector contract 2drop ;
+
+M: struct-array new-resizable c-type>> <struct-vector> ;
+
+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 c273cea867a857fa196bd84a7993c151ad2b15fc..fc3d9501c777cd1463509ce3adaad37b4c3f01a2 100644 (file)
--- 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?\r
     over byte-vector? [ sequence= ] [ 2drop f ] if ;\r
 \r
+M: byte-vector contract 2drop ;\r
+\r
 M: byte-array like\r
     #! If we have an byte-array, we're done.\r
     #! If we have a byte-vector, and it's at full capacity,\r

diff --git a/core/growable/growable.factor b/core/growable/growable.factor
index 684aab115837760949281fdbf0971e364338f547..754a3293d1dada28cf8fee3d51d9890f7cf96d7d 100644 (file)
--- 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