Data type cleanups

core/bit-vectors/bit-vectors-docs.factor

@@ -28,6 +28,6 @@ HELP: >bit vector
 { $description "Outputs a freshly-allocated bit vector with the same elements as a given sequence." } ;
 
 HELP: bit-array>vector
-{ $values { "bit-array" "an array" } { "capacity" "a non-negative integer" } { "bit-vector" bit-vector } }
+{ $values { "bit-array" "an array" } { "length" "a non-negative integer" } { "bit-vector" bit-vector } }
 { $description "Creates a new bit vector using the array for underlying storage with the specified initial length." }
 { $warning "This word is in the " { $vocab-link "bit-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >bit-vector } " instead." } ;

core/bootstrap/image/image.factor

@@ -320,24 +320,33 @@ M: quotation '
 ! Vectors and sbufs
 
 M: vector '
-    dup underlying ' swap length
-    vector type-number object tag-number [
-        emit-fixnum ! length
+    dup length swap underlying '
+    tuple type-number tuple tag-number [
+        4 emit-fixnum
+        vector ' emit
+        f ' emit
         emit ! array ptr
+        emit-fixnum ! length
     ] emit-object ;
 
 M: sbuf '
-    dup underlying ' swap length
-    sbuf type-number object tag-number [
-        emit-fixnum ! length
+    dup length swap underlying '
+    tuple type-number tuple tag-number [
+        4 emit-fixnum
+        sbuf ' emit
+        f ' emit
         emit ! array ptr
+        emit-fixnum ! length
     ] emit-object ;
 
 ! Hashes
 
 M: hashtable '
     [ hash-array ' ] keep
-    hashtable type-number object tag-number [
+    tuple type-number tuple tag-number [
+        5 emit-fixnum
+        hashtable ' emit
+        f ' emit
         dup hash-count emit-fixnum
         hash-deleted emit-fixnum
         emit ! array ptr

core/bootstrap/layouts/layouts.factor

@@ -8,7 +8,7 @@ BIN: 111 tag-mask set
 8 num-tags set
 3 tag-bits set
 
-23 num-types set
+20 num-types set
 
 H{
     { fixnum      BIN: 000 }
@@ -24,17 +24,14 @@ H{
 tag-numbers get H{
     { array 8 }
     { wrapper 9 }
-    { hashtable 10 }
-    { vector 11 }
+    { float-array 10 }
+    { callstack 11 }
     { string 12 }
-    { sbuf 13 }
+    { curry 13 }
     { quotation 14 }
     { dll 15 }
     { alien 16 }
     { word 17 }
     { byte-array 18 }
     { bit-array 19 }
-    { float-array 20 }
-    { curry 21 }
-    { callstack 22 }
 } union type-numbers set

core/bootstrap/primitives.factor

@@ -22,7 +22,9 @@ crossref off
        { "arm" "arm" }
    } at "/bootstrap.factor" 3append parse-file
 
-! Now we have ( syntax-quot arch-quot ) on the stack
+"resource:core/bootstrap/layouts/layouts.factor" parse-file
+
+! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
 
 ! Bring up a bare cross-compiling vocabulary.
 "syntax" vocab vocab-words bootstrap-syntax set
@@ -30,6 +32,7 @@ H{ } clone dictionary set
 H{ } clone changed-words set
 [ drop ] recompile-hook set
 
+call
 call
 call
 
@@ -180,41 +183,6 @@ num-types get f <array> builtins set
     }
 } define-builtin
 
-"hashtable" "hashtables" create "hashtable?" "hashtables" create
-{
-    {
-        { "array-capacity" "sequences.private" }
-        "count"
-        { "hash-count" "hashtables.private" }
-        { "set-hash-count" "hashtables.private" }
-    } {
-        { "array-capacity" "sequences.private" }
-        "deleted"
-        { "hash-deleted" "hashtables.private" }
-        { "set-hash-deleted" "hashtables.private" }
-    } {
-        { "array" "arrays" }
-        "array"
-        { "hash-array" "hashtables.private" }
-        { "set-hash-array" "hashtables.private" }
-    }
-} define-builtin
-
-"vector" "vectors" create "vector?" "vectors" create
-{
-    {
-        { "array-capacity" "sequences.private" }
-        "fill"
-        { "length" "sequences" }
-        { "set-fill" "growable" }
-    } {
-        { "array" "arrays" }
-        "underlying"
-        { "underlying" "growable" }
-        { "set-underlying" "growable" }
-    }
-} define-builtin
-
 "string" "strings" create "string?" "strings" create
 {
     {
@@ -225,22 +193,6 @@ num-types get f <array> builtins set
     }
 } define-builtin
 
-"sbuf" "sbufs" create "sbuf?" "sbufs" create
-{
-    {
-        { "array-capacity" "sequences.private" }
-        "length"
-        { "length" "sequences" }
-        { "set-fill" "growable" }
-    }
-    {
-        { "string" "strings" }
-        "underlying"
-        { "underlying" "growable" }
-        { "set-underlying" "growable" }
-    }
-} define-builtin
-
 "quotation" "quotations" create "quotation?" "quotations" create
 {
     {
@@ -387,6 +339,56 @@ builtins get num-tags get tail f union-class define-class
 2array >tuple 1quotation define-inline
 
 ! Some tuple classes
+"hashtable" "hashtables" create
+{
+    {
+        { "array-capacity" "sequences.private" }
+        "count"
+        { "hash-count" "hashtables.private" }
+        { "set-hash-count" "hashtables.private" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "deleted"
+        { "hash-deleted" "hashtables.private" }
+        { "set-hash-deleted" "hashtables.private" }
+    } {
+        { "array" "arrays" }
+        "array"
+        { "hash-array" "hashtables.private" }
+        { "set-hash-array" "hashtables.private" }
+    }
+} define-tuple-class
+
+"sbuf" "sbufs" create
+{
+    {
+        { "string" "strings" }
+        "underlying"
+        { "underlying" "growable" }
+        { "set-underlying" "growable" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "length"
+        { "length" "sequences" }
+        { "set-fill" "growable" }
+    }
+} define-tuple-class
+
+"vector" "vectors" create
+{
+    {
+        { "array" "arrays" }
+        "underlying"
+        { "underlying" "growable" }
+        { "set-underlying" "growable" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "fill"
+        { "length" "sequences" }
+        { "set-fill" "growable" }
+    }
+} define-tuple-class
+
 "byte-vector" "byte-vectors" create
 {
     {
@@ -440,7 +442,6 @@ builtins get num-tags get tail f union-class define-class
     { "(execute)" "words.private" }
     { "(call)" "kernel.private" }
     { "uncurry" "kernel.private" }
-    { "string>sbuf" "sbufs.private" }
     { "bignum>fixnum" "math.private" }
     { "float>fixnum" "math.private" }
     { "fixnum>bignum" "math.private" }
@@ -593,7 +594,6 @@ builtins get num-tags get tail f union-class define-class
     { "set-char-slot" "strings.private" }
     { "resize-array" "arrays" }
     { "resize-string" "strings" }
-    { "(hashtable)" "hashtables.private" }
     { "<array>" "arrays" }
     { "begin-scan" "memory" }
     { "next-object" "memory" }
@@ -608,7 +608,6 @@ builtins get num-tags get tail f union-class define-class
     { "fclose" "io.streams.c" }
     { "<wrapper>" "kernel" }
     { "(clone)" "kernel" }
-    { "array>vector" "vectors.private" }
     { "<string>" "strings" }
     { "(>tuple)" "tuples.private" }
     { "array>quotation" "quotations.private" }

core/byte-vectors/byte-vectors-docs.factor

@@ -23,12 +23,12 @@ HELP: <byte-vector>
 { $values { "n" "a positive integer specifying initial capacity" } { "vector" vector } }
 { $description "Creates a new byte vector that can hold " { $snippet "n" } " bytes before resizing." } ;
 
-HELP: >byte vector
+HELP: >byte-vector
 { $values { "seq" "a sequence" } { "vector" vector } }
 { $description "Outputs a freshly-allocated byte vector with the same elements as a given sequence." }
 { $errors "Throws an error if the sequence contains elements other than integers." } ;
 
 HELP: byte-array>vector
-{ $values { "byte-array" "an array" } { "capacity" "a non-negative integer" } { "byte-vector" byte-vector } }
+{ $values { "byte-array" "an array" } { "length" "a non-negative integer" } { "byte-vector" byte-vector } }
 { $description "Creates a new byte vector using the array for underlying storage with the specified initial length." }
 { $warning "This word is in the " { $vocab-link "byte-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >byte-vector } " instead." } ;

core/float-vectors/float-vectors-docs.factor

@@ -0,0 +1,34 @@
+USING: arrays float-arrays help.markup help.syntax kernel
+float-vectors.private combinators ;
+IN: float-vectors
+
+ARTICLE: "float-vectors" "Float vectors"
+"A float vector is a resizable mutable sequence of unsigned floats. The literal syntax is covered in " { $link "syntax-float-vectors" } ". Float vector words are found in the " { $vocab-link "float-vectors" } " vocabulary."
+$nl
+"Float vectors form a class:"
+{ $subsection float-vector }
+{ $subsection float-vector? }
+"Creating float vectors:"
+{ $subsection >float-vector }
+{ $subsection <float-vector> }
+"If you don't care about initial capacity, a more elegant way to create a new float vector is to write:"
+{ $code "BV{ } clone" } ;
+
+ABOUT: "float-vectors"
+
+HELP: float-vector
+{ $description "The class of resizable float vectors. See " { $link "syntax-float-vectors" } " for syntax and " { $link "float-vectors" } " for general information." } ;
+
+HELP: <float-vector>
+{ $values { "n" "a positive integer specifying initial capacity" } { "vector" vector } }
+{ $description "Creates a new float vector that can hold " { $snippet "n" } " floats before resizing." } ;
+
+HELP: >float-vector
+{ $values { "seq" "a sequence" } { "vector" vector } }
+{ $description "Outputs a freshly-allocated float vector with the same elements as a given sequence." }
+{ $errors "Throws an error if the sequence contains elements other than real numbers." } ;
+
+HELP: float-array>vector
+{ $values { "float-array" "an array" } { "length" "a non-negative integer" } { "float-vector" float-vector } }
+{ $description "Creates a new float vector using the array for underlying storage with the specified initial length." }
+{ $warning "This word is in the " { $vocab-link "float-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >float-vector } " instead." } ;

core/hashtables/hashtables.factor

@@ -122,7 +122,7 @@ IN: hashtables
 PRIVATE>
 
 : <hashtable> ( n -- hash )
-    (hashtable) [ reset-hash ] keep ;
+    hashtable construct-empty [ reset-hash ] keep ;
 
 M: hashtable at* ( key hash -- value ? )
     key@ [ 3 fixnum+fast slot t ] [ 2drop f f ] if ;

core/prettyprint/backend/backend.factor

@@ -155,6 +155,7 @@ GENERIC: >pprint-sequence ( obj -- seq )
 
 M: object >pprint-sequence ;
 
+M: vector >pprint-sequence ;
 M: hashtable >pprint-sequence >alist ;
 M: tuple >pprint-sequence tuple>array ;
 M: wrapper >pprint-sequence wrapped 1array ;

core/sbufs/sbufs.factor

@@ -1,9 +1,16 @@
 ! Copyright (C) 2004, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math strings kernel.private sequences.private
-sequences strings growable strings.private sbufs.private ;
+USING: kernel math strings sequences.private sequences strings
+growable strings.private ;
 IN: sbufs
 
+<PRIVATE
+
+: string>sbuf ( string length -- sbuf )
+    sbuf construct-boa ; inline
+
+PRIVATE>
+
 : <sbuf> ( n -- sbuf ) 0 <string> 0 string>sbuf ; inline
 
 M: sbuf set-nth-unsafe

core/vectors/vectors-docs.factor

@@ -30,7 +30,7 @@ HELP: >vector
 { $values { "seq" "a sequence" } { "vector" vector } }
 { $description "Outputs a freshly-allocated vector with the same elements as a given sequence." } ;
 
-HELP: array>vector ( array length -- vector )
+HELP: array>vector
 { $values { "array" "an array" } { "length" "a non-negative integer" } { "vector" vector } }
 { $description "Creates a new vector using the array for underlying storage with the specified initial length." }
 { $warning "This word is in the " { $vocab-link "vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >vector } " instead." } ;

core/vectors/vectors.factor

@@ -1,10 +1,15 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel kernel.private math
-math.private sequences sequences.private vectors.private
-growable ;
+USING: arrays kernel math sequences sequences.private growable ;
 IN: vectors
 
+<PRIVATE
+
+: array>vector ( byte-array capacity -- byte-vector )
+    vector construct-boa ; inline
+
+PRIVATE>
+
 : <vector> ( n -- vector ) f <array> 0 array>vector ; inline
 
 : >vector ( seq -- vector ) V{ } clone-like ;

vm/data_gc.c

@@ -177,12 +177,6 @@ CELL unaligned_object_size(CELL pointer)
 		return sizeof(F_QUOTATION);
 	case WORD_TYPE:
 		return sizeof(F_WORD);
-	case HASHTABLE_TYPE:
-		return sizeof(F_HASHTABLE);
-	case VECTOR_TYPE:
-		return sizeof(F_VECTOR);
-	case SBUF_TYPE:
-		return sizeof(F_SBUF);
 	case RATIO_TYPE:
 		return sizeof(F_RATIO);
 	case FLOAT_TYPE:

vm/layouts.h

@@ -52,21 +52,18 @@ typedef signed long long s64;
 /*** Header types ***/
 #define ARRAY_TYPE 8
 #define WRAPPER_TYPE 9
-#define HASHTABLE_TYPE 10
-#define VECTOR_TYPE 11
+#define FLOAT_ARRAY_TYPE 10
+#define CALLSTACK_TYPE 11
 #define STRING_TYPE 12
-#define SBUF_TYPE 13
+#define CURRY_TYPE 13
 #define QUOTATION_TYPE 14
 #define DLL_TYPE 15
 #define ALIEN_TYPE 16
 #define WORD_TYPE 17
 #define BYTE_ARRAY_TYPE 18
 #define BIT_ARRAY_TYPE 19
-#define FLOAT_ARRAY_TYPE 20
-#define CURRY_TYPE 21
-#define CALLSTACK_TYPE 22
 
-#define TYPE_COUNT 23
+#define TYPE_COUNT 20
 
 INLINE bool immediate_p(CELL obj)
 {
@@ -103,16 +100,6 @@ typedef F_ARRAY F_BIT_ARRAY;
 
 typedef F_ARRAY F_FLOAT_ARRAY;
 
-/* Assembly code makes assumptions about the layout of this struct */
-typedef struct {
-	/* always tag_header(VECTOR_TYPE) */
-	CELL header;
-	/* tagged */
-	CELL top;
-	/* tagged */
-	CELL array;
-} F_VECTOR;
-
 /* Assembly code makes assumptions about the layout of this struct */
 typedef struct {
 	CELL header;
@@ -122,28 +109,6 @@ typedef struct {
 	CELL hashcode;
 } F_STRING;
 
-/* Assembly code makes assumptions about the layout of this struct */
-typedef struct {
-	/* always tag_header(SBUF_TYPE) */
-	CELL header;
-	/* tagged */
-	CELL top;
-	/* tagged */
-	CELL string;
-} F_SBUF;
-
-/* Assembly code makes assumptions about the layout of this struct */
-typedef struct {
-	/* always tag_header(HASHTABLE_TYPE) */
-	CELL header;
-	/* tagged */
-	CELL count;
-        /* tagged */
-        CELL deleted;
-	/* tagged */
-	CELL array;
-} F_HASHTABLE;
-
 /* The compiled code heap is structured into blocks. */
 typedef struct
 {

vm/primitives.c

@@ -4,7 +4,6 @@ void *primitives[] = {
 	primitive_execute,
 	primitive_call,
 	primitive_uncurry,
-	primitive_string_to_sbuf,
 	primitive_bignum_to_fixnum,
 	primitive_float_to_fixnum,
 	primitive_fixnum_to_bignum,
@@ -157,7 +156,6 @@ void *primitives[] = {
 	primitive_set_char_slot,
 	primitive_resize_array,
 	primitive_resize_string,
-	primitive_hashtable,
 	primitive_array,
 	primitive_begin_scan,
 	primitive_next_object,
@@ -172,7 +170,6 @@ void *primitives[] = {
 	primitive_fclose,
 	primitive_wrapper,
 	primitive_clone,
-	primitive_array_to_vector,
 	primitive_string,
 	primitive_to_tuple,
 	primitive_array_to_quotation,

vm/types.c

@@ -34,31 +34,6 @@ DEFINE_PRIMITIVE(clone)
 	drepl(clone(dpeek()));
 }
 
-DEFINE_PRIMITIVE(array_to_vector)
-{
-	F_VECTOR *vector = allot_object(VECTOR_TYPE,sizeof(F_VECTOR));
-	vector->top = dpop();
-	vector->array = dpop();
-	dpush(tag_object(vector));
-}
-
-DEFINE_PRIMITIVE(string_to_sbuf)
-{
-	F_SBUF *sbuf = allot_object(SBUF_TYPE,sizeof(F_SBUF));
-	sbuf->top = dpop();
-	sbuf->string = dpop();
-	dpush(tag_object(sbuf));
-}
-
-DEFINE_PRIMITIVE(hashtable)
-{
-	F_HASHTABLE* hash = allot_object(HASHTABLE_TYPE,sizeof(F_HASHTABLE));
-	hash->count = F;
-	hash->deleted = F;
-	hash->array = F;
-	dpush(tag_object(hash));
-}
-
 F_WORD *allot_word(CELL vocab, CELL name)
 {
 	REGISTER_ROOT(vocab);

vm/types.h

@@ -138,8 +138,6 @@ DECLARE_PRIMITIVE(resize_byte_array);
 DECLARE_PRIMITIVE(resize_bit_array);
 DECLARE_PRIMITIVE(resize_float_array);
 
-DECLARE_PRIMITIVE(array_to_vector);
-
 F_STRING* allot_string_internal(CELL capacity);
 F_STRING* allot_string(CELL capacity, CELL fill);
 DECLARE_PRIMITIVE(string);
@@ -171,10 +169,6 @@ DECLARE_PRIMITIVE(string_to_u16_alien);
 DECLARE_PRIMITIVE(char_slot);
 DECLARE_PRIMITIVE(set_char_slot);
 
-DECLARE_PRIMITIVE(string_to_sbuf);
-
-DECLARE_PRIMITIVE(hashtable);
-
 F_WORD *allot_word(CELL vocab, CELL name);
 DECLARE_PRIMITIVE(word);
 DECLARE_PRIMITIVE(word_xt);