array refactoring; started hashtable refactoring

Makefile

@@ -1,5 +1,5 @@
 CC = gcc
-DEFAULT_CFLAGS = -Wall -g $(SITE_CFLAGS)
+DEFAULT_CFLAGS = -Wall -Os -fomit-frame-pointer $(SITE_CFLAGS)
 DEFAULT_LIBS = -lm
 
 STRIP = strip
@@ -68,7 +68,7 @@ solaris:
 
 f: $(OBJS)
 	$(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)
-	#$(STRIP) $@
+	$(STRIP) $@
 
 clean:
 	rm -f $(OBJS)

TODO.FACTOR.txt

@@ -17,6 +17,9 @@
 
 + ffi:
 
+- value type structs
+- unicode strings
+- out parameters
 - figure out how to load an image referring to missing libraries
 - is signed -vs- unsigned pointers an issue?
 - bitfields in C structs
@@ -49,13 +52,12 @@
 + kernel:
 
 - ppc register decls
-- do partial objects cause problems?
-- remove sbufs
 - cat, reverse-cat primitives
 - first-class hashtables
 
 + misc:
 
+- make-vector and make-string should not need a reverse step
 - perhaps /i should work with all numbers
 - jedit ==> jedit-word, jedit takes a file name
 - browser responder for word links in HTTPd

examples/grad-demo.factor

@@ -0,0 +1,45 @@
+! Gradient rendering demo.
+!
+! To run this code, bootstrap Factor like so:
+!
+! ./f boot.image.le32
+!     -libraries:sdl:name=libSDL.so
+!     -libraries:sdl-gfx:name=libSDL_gfx.so
+!     -libraries:sdl-ttf:name=libSDL_ttf.so
+!
+! (But all on one line)
+!
+! Then, start Factor as usual (./f factor.image) and enter this
+! at the listener:
+!
+! "examples/grad-demo.factor" run-file
+
+IN: grad-demo
+USE: streams
+USE: sdl
+USE: sdl-event
+USE: sdl-gfx
+USE: sdl-video
+USE: sdl-ttf
+USE: namespaces
+USE: math
+USE: kernel
+USE: test
+USE: compiler
+USE: strings
+USE: alien
+USE: prettyprint
+USE: lists
+
+: draw-grad ( -- )
+    [ over rgb ] with-pixels ; compiled
+
+: grad-demo ( -- )
+    640 480 0 SDL_HWSURFACE [
+        TTF_Init
+        [ draw-grad ] with-surface
+        <event> event-loop
+        SDL_Quit
+    ] with-screen ;
+
+grad-demo

examples/mandel.factor

@@ -32,7 +32,7 @@ USE: test
 
 : scale 255 * >fixnum ;
 
-: scale-rgb ( r g b -- n )
+: scale-rgb ( r g b a -- n )
     scale
     swap scale 8 shift bitor
     swap scale 16 shift bitor
@@ -44,10 +44,10 @@ USE: test
 : <color-map> ( nb-cols -- map )
     [
         dup [
-            dup 360 * over 1 + / 360 / sat val
+            dup 360 * pick 1 + / 360 / sat val
             hsv>rgb 1.0 scale-rgb ,
         ] repeat
-    ] make-list list>vector nip ;
+    ] make-vector nip ;
 
 : absq >rect swap sq swap sq + ; inline
 
@@ -72,7 +72,7 @@ SYMBOL: center
     height get 150000 zoom-fact get * / y-inc set
     nb-iter get max-color min <color-map> cols set ;
 
-: c ( #{ i j }# -- c )
+: c ( i j -- c )
     >r
     x-inc get * center get real x-inc get width get 2 / * - + >float
     r>
@@ -89,7 +89,7 @@ SYMBOL: center
     ] with-pixels ; compiled
 
 : mandel ( -- )
-    640 480 32 SDL_HWSURFACE [
+    640 480 0 SDL_HWSURFACE [
         [
             0.8 zoom-fact set
             -0.65 center set

library/arrays.factor

@@ -0,0 +1,53 @@
+! :folding=none:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2005 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: kernel-internals
+USE: generic
+USE: math-internals
+USE: kernel
+
+! An array is a range of memory storing pointers to other
+! objects. Arrays are not used directly, and their access words
+! are not bounds checked. Examples of abstractions built on
+! arrays include vectors, hashtables, and tuples.
+
+! These words are unsafe. I'd say "do not call them", but that
+! Java-esque. By all means, do use arrays if you need something
+! low-level... but be aware that vectors are usually a better
+! choice.
+
+BUILTIN: array 8
+
+: array-capacity   ( array -- n )   1 integer-slot ; inline
+: vector-array     ( vec -- array ) 2 slot ; inline
+: set-vector-array ( array vec -- ) 2 set-slot ; inline
+
+: array-nth ( n array -- obj )
+    swap 2 fixnum+ slot ; inline
+
+: set-array-nth ( obj n array -- )
+    swap 2 fixnum+ set-slot ; inline

library/bootstrap/boot-stage2.factor

@@ -48,6 +48,7 @@ USE: namespaces
     "/version.factor"
     "/library/stack.factor"
     "/library/combinators.factor"
+    "/library/arrays.factor"
     "/library/kernel.factor"
     "/library/cons.factor"
     "/library/assoc.factor"

library/bootstrap/boot.factor

@@ -42,6 +42,7 @@ USE: hashtables
     "/version.factor" parse-resource append,
     "/library/stack.factor" parse-resource append,
     "/library/combinators.factor" parse-resource append,
+    "/library/arrays.factor" parse-resource append,
     "/library/kernel.factor" parse-resource append,
     "/library/cons.factor" parse-resource append,
     "/library/assoc.factor" parse-resource append,

library/bootstrap/init-stage2.factor

@@ -114,6 +114,5 @@ unparse write " words total" print
 ! Save a bit of space
 global [ stdio off ] bind
 
-garbage-collection
 "factor.image" save-image
 0 exit*

library/bootstrap/primitives.factor

@@ -59,8 +59,6 @@ vocabularies get [
     [[ "kernel" "ifte" ]]
     [[ "lists" "cons" ]]
     [[ "vectors" "<vector>" ]]
-    [[ "vectors" "vector-nth" ]]
-    [[ "vectors" "set-vector-nth" ]]
     [[ "strings" "str-nth" ]]
     [[ "strings" "str-compare" ]]
     [[ "strings" "str=" ]]

library/hashtables.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -25,13 +25,24 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-IN: hashtables
+IN: kernel-internals
 USE: generic
 USE: kernel
 USE: lists
 USE: math
 USE: vectors
 
+: hash-array vector-array ; inline
+: bucket-count >vector hash-array array-capacity ; inline
+
+: hash-bucket ( n hash -- alist )
+    swap >fixnum swap >vector hash-array array-nth ; inline
+
+: set-hash-bucket ( obj n hash -- )
+    >r >fixnum r> hash-array set-array-nth ; inline
+
+IN: hashtables
+
 ! Note that the length of a hashtable vector must not change
 ! for the lifetime of the hashtable, otherwise problems will
 ! occur. Do not use vector words with hashtables.
@@ -48,13 +59,13 @@ PREDICATE: vector hashtable ( obj -- ? )
 
 : (hashcode) ( key table -- index )
     #! Compute the index of the bucket for a key.
-    >r hashcode r> vector-length rem ; inline
+    >r hashcode r> bucket-count rem ; inline
 
 : hash* ( key table -- [[ key value ]] )
     #! Look up a value in the hashtable. First the bucket is
     #! determined using the hash function, then the association
     #! list therein is searched linearly.
-    2dup (hashcode) swap vector-nth assoc* ;
+    2dup (hashcode) swap hash-bucket assoc* ;
 
 : hash ( key table -- value )
     #! Unlike hash*, this word cannot distinglish between an
@@ -67,9 +78,9 @@ PREDICATE: vector hashtable ( obj -- ? )
         2dup (hashcode)
     r> pick >r
         over >r
-            >r swap vector-nth r> call
+            >r swap hash-bucket r> call
         r>
-    r> set-vector-nth ; inline
+    r> set-hash-bucket ; inline
     
 : set-hash ( value key table -- )
     #! Store the value in the hashtable. Either replaces an
@@ -85,12 +96,6 @@ PREDICATE: vector hashtable ( obj -- ? )
     #! Apply the code to each key/value pair of the hashtable.
     swap [ swap dup >r each r> ] vector-each drop ; inline
 
-: hash-subset ( hash code -- hash )
-    #! Return a new hashtable containing all key/value pairs
-    #! for which the predicate yielded a true value. The
-    #! predicate must have stack effect ( obj -- ? ).
-    swap [ swap dup >r subset r> swap ] vector-map nip ; inline
-
 : hash-keys ( hash -- list )
     #! Push a list of keys in a hashtable.
     [ ] swap [ car swons ] hash-each ;

library/inference/branches.factor

@@ -73,7 +73,7 @@ USE: prettyprint
 : unify-stacks ( list -- stack )
     #! Replace differing literals in stacks with unknown
     #! results.
-    unify-lengths vector-transpose [ unify-results ] vector-map ;
+    unify-lengths vector-transpose [ unify-results ] vector-map ; 
 
 : balanced? ( list -- ? )
     #! Check if a list of [[ instack outstack ]] pairs is
@@ -104,7 +104,7 @@ USE: prettyprint
     ] unless* ;
 
 : unify-effects ( list -- )
-    filter-terminators  dup datastack-effect callstack-effect ;
+    filter-terminators dup datastack-effect callstack-effect ;
 
 SYMBOL: cloned
 

library/inference/types.factor

@@ -63,15 +63,15 @@ USE: prettyprint
     \ >string \ string infer-check
 ] "infer" set-word-property
 
-\ slot [
-    [ object fixnum ] ensure-d
-    dataflow-drop, pop-d literal-value
-    peek-d value-class builtin-supertypes dup length 1 = [
-        cons \ slot [ [ object ] [ object ] ] (consume/produce)
-    ] [
-        "slot called without static type knowledge" throw
-    ] ifte
-] "infer" set-word-property
+! \ slot [
+!     [ object fixnum ] ensure-d
+!     dataflow-drop, pop-d literal-value
+!     peek-d value-class builtin-supertypes dup length 1 = [
+!         cons \ slot [ [ object ] [ object ] ] (consume/produce)
+!     ] [
+!         "slot called without static type knowledge" throw
+!     ] ifte
+! ] "infer" set-word-property
 
 : type-value-map ( value -- )
     num-types [ dup builtin-type pick swons cons ] project

library/kernel.factor

@@ -31,9 +31,9 @@ USE: kernel
 USE: vectors
 
 : dispatch ( n vtable -- )
-    #! This word is unsafe in compiled code since n is not
-    #! bounds-checked. Do not call it directly.
-    vector-nth call ;
+    #! This word is unsafe since n is not bounds-checked. Do not
+    #! call it directly.
+    vector-array array-nth call ;
 
 IN: kernel
 

library/namespaces.factor

@@ -153,6 +153,11 @@ SYMBOL: list-buffer
     #! was called.
     make-rlist reverse ; inline
 
+: make-vector ( quot -- list )
+    #! Return a vector whose entries are in the same order that
+    #! , was called.
+    make-list list>vector ; inline
+
 : , ( obj -- )
     #! Append an object to the currently constructing list.
     list-buffer cons@ ;

library/primitives.factor

@@ -55,8 +55,6 @@ USE: words
     [ ifte                   [ [ object general-list general-list ] [ ] ] ]
     [ cons                   [ [ object object ] [ cons ] ] ]
     [ <vector>               [ [ integer ] [ vector ] ] ]
-    [ vector-nth             [ [ integer vector ] [ object ] ] ]
-    [ set-vector-nth         [ [ object integer vector ] [ ] ] ]
     [ str-nth                [ [ integer string ] [ integer ] ] ]
     [ str-compare            [ [ string string ] [ integer ] ] ]
     [ str=                   [ [ string string ] [ boolean ] ] ]
@@ -222,7 +220,7 @@ USE: words
     [ set-slot               [ [ object object fixnum ] [ ] ] ]
     [ integer-slot           [ [ object fixnum ] [ integer ] ] ]
     [ set-integer-slot       [ [ integer object fixnum ] [ ] ] ]
-    [ grow-array             [ [ integer array ] [ integer ] ] ]
+    [ grow-array             [ [ integer array ] [ object ] ] ]
 ] [
     2unlist dup string? [
         "stack-effect" set-word-property

library/test/vectors.factor

@@ -6,10 +6,12 @@ USE: test
 USE: vectors
 USE: strings
 USE: namespaces
+USE: kernel-internals
 
 [ [ t f t ] vector-length ] unit-test-fails
 [ 3 ] [ { t f t } vector-length ] unit-test
 
+[ -3 { } vector-nth ] unit-test-fails
 [ 3 { } vector-nth ] unit-test-fails
 [ 3 #{ 1 2 }# vector-nth ] unit-test-fails
 
@@ -74,3 +76,9 @@ unit-test
 [ "funny-stack" get vector-pop ] unit-test-fails
 [ ] [ "funky" "funny-stack" get vector-push ] unit-test
 [ "funky" ] [ "funny-stack" get vector-pop ] unit-test
+
+[ t ] [
+    10 <vector> dup vector-array array-capacity
+    >r vector-clone vector-array array-capacity r>
+    =
+] unit-test

library/ui/console.factor

@@ -83,6 +83,9 @@ SYMBOL: input-line
 SYMBOL: console-font
 #! Font height.
 SYMBOL: line-height
+#! If this is on, the console will be redrawn on the next event
+#! refresh cycle.
+SYMBOL: redraw-console
 
 #! The font size is hardcoded here.
 : char-width 8 ;
@@ -174,8 +177,10 @@ SYMBOL: line-height
         0 y set
         clear-display
         draw-lines
-        draw-current
-        draw-input
+        height get y get - line-height get >= [
+            draw-current
+            draw-input
+        ] when
         draw-scrollbar
     ] with-surface ;
 
@@ -186,7 +191,7 @@ SYMBOL: line-height
     lines get vector-push scroll-to-bottom ;
 
 : console-write ( text -- )
-    "\n" split1 [       
+    "\n" split1 [
         swap output-line get sbuf-append
         output-line get empty-buffer add-line
     ] when*
@@ -215,7 +220,7 @@ M: console-stream fflush ( stream -- )
 
 M: console-stream fauto-flush ( stream -- )
     [
-        console get [ draw-console ] bind
+        console get [ redraw-console on ] bind
     ] bind ;
 
 M: console-stream freadln ( stream -- line )
@@ -280,10 +285,10 @@ SYMBOL: keymap
 
 M: key-down-event handle-event ( event -- ? )
     dup keyboard-event>binding keymap get hash [
-        call draw-console
+        call redraw-console on
     ] [
         dup input-key? [
-            keyboard-event-unicode user-input draw-console
+            keyboard-event-unicode user-input redraw-console on
         ] [
             drop
         ] ifte
@@ -296,10 +301,10 @@ SYMBOL: drag-start-line
 
 : scrollbar-click ( y -- )
     dup scrollbar-top < [
-        drop page-scroll-up draw-console
+        drop page-scroll-up redraw-console on
     ] [
         dup scrollbar-bottom > [
-            drop page-scroll-down draw-console
+            drop page-scroll-down redraw-console on
         ] [
             drag-start-y set
             first-line get drag-start-line set
@@ -323,7 +328,7 @@ M: motion-event handle-event ( event -- ? )
         motion-event-y drag-start-y get -
         height get / total-lines * drag-start-line get +
         >fixnum fix-first-line first-line set
-        draw-console
+        redraw-console on
     ] [
         drop
     ] ifte t ;
@@ -332,7 +337,7 @@ M: resize-event handle-event ( event -- ? )
     dup resize-event-w swap resize-event-h
     0 SDL_HWSURFACE SDL_RESIZABLE bitor init-screen
     scroll-to-bottom
-    draw-console t ;
+    redraw-console on t ;
 
 M: quit-event handle-event ( event -- ? )
     drop f ;
@@ -366,6 +371,7 @@ M: alien handle-event ( event -- ? )
     SDL_EnableKeyRepeat drop ;
 
 : console-loop ( -- )
+    redraw-console get [ draw-console redraw-console off ] when
     check-event [ console-loop ] when ;
 
 : console-quit ( -- )
@@ -395,7 +401,7 @@ IN: shells
         ] callcc0
 
         console get [
-            draw-console
+            redraw-console on
             console-loop
             console-quit
         ] bind

library/vectors.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -25,41 +25,66 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+IN: vectors
 USE: generic
 USE: kernel
 USE: lists
 USE: math
-
-IN: errors
-DEFER: throw
-
-IN: kernel-internals
-
-BUILTIN: array 8
-
-! UNSAFE!
-: array-capacity   ( array -- n )   1 integer-slot ; inline
-: vector-array     ( vec -- array ) 2 slot ; inline
-: set-vector-array ( array vec -- ) 2 set-slot ; inline
-
-: grow-vector-array ( len vec -- )
-    [ vector-array grow-array ] keep set-vector-array ; inline
-
-: (set-vector-length) ( len vec -- ) 1 set-integer-slot ; inline
-
-IN: vectors
+USE: kernel-internals
+USE: errors
+USE: math-internals
 
 BUILTIN: vector 11
 
 : vector-length ( vec -- len ) >vector 1 integer-slot ; inline
 
-: set-vector-length ( len vec -- )
-    >vector over 0 < [
-        "Vector length must be positive" throw 2drop
+IN: kernel-internals
+
+: (set-vector-length) ( len vec -- ) 1 set-integer-slot ; inline
+
+: assert-positive ( fx -- )
+    0 fixnum<
+    [ "Vector index must be positive" throw ] when ; inline
+
+: assert-bounds ( fx vec -- )
+    over assert-positive
+    vector-length fixnum>=
+    [ "Vector index out of bounds" throw ] when ; inline
+
+: grow-capacity ( len vec -- )
+    #! If the vector cannot accomodate len elements, resize it
+    #! to exactly len.
+    [ vector-array grow-array ] keep set-vector-array ; inline
+
+: ensure-capacity ( n vec -- )
+    #! If n is beyond the vector's length, increase the length,
+    #! growing the array if necessary, with an optimistic
+    #! doubling of its size.
+    2dup vector-length fixnum>= [
+        >r 1 fixnum+ r>
+        2dup vector-array array-capacity fixnum> [
+            over 2 fixnum* over grow-capacity
+        ] when
+        (set-vector-length)
     ] [
-        2dup (set-vector-length) grow-vector-array
+        2drop
     ] ifte ; inline
 
+IN: vectors
+
+: vector-nth ( n vec -- obj )
+    swap >fixnum swap >vector
+    2dup assert-bounds vector-array array-nth ;
+
+: set-vector-nth ( obj n vec -- )
+    swap >fixnum dup assert-positive swap >vector
+    2dup ensure-capacity vector-array
+    set-array-nth ;
+
+: set-vector-length ( len vec -- )
+    swap >fixnum dup assert-positive swap >vector
+    2dup grow-capacity (set-vector-length) ;
+
 : empty-vector ( len -- vec )
     #! Creates a vector with 'len' elements set to f. Unlike
     #! <vector>, which gives an empty vector with a certain

native/array.h

@@ -21,17 +21,5 @@ F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity);
 #define ASIZE(pointer) align8(sizeof(F_ARRAY) + \
 	((F_ARRAY*)(pointer))->capacity * CELLS)
 
-/* untagged & unchecked */
-INLINE CELL array_nth(F_ARRAY* array, CELL index)
-{
-	return get(AREF(array,index));
-}
-
-/* untagged & unchecked  */
-INLINE void set_array_nth(F_ARRAY* array, CELL index, CELL value)
-{
-	put(AREF(array,index),value);
-}
-
 void fixup_array(F_ARRAY* array);
 void collect_array(F_ARRAY* array);

native/gc.c

@@ -119,7 +119,7 @@ void primitive_gc(void)
 	fflush(stderr);
 
 	flip_zones();
-	scan = active.here = active.base;
+	scan = active.base;
 	collect_roots();
 	collect_io_tasks();
 	/* collect literal objects referenced from compiled code */

native/image.c

@@ -115,6 +115,8 @@ bool save_image(char* filename)
 
 void primitive_save_image(void)
 {
-	F_STRING* filename = untag_string(dpop());
+	F_STRING* filename;
+	primitive_gc();
+	filename = untag_string(dpop());
 	save_image(to_c_string(filename));
 }

native/memory.c

@@ -87,6 +87,7 @@ void flip_zones()
 	ZONE z = active;
 	active = prior;
 	prior = z;
+	active.here = active.base;
 }
 
 bool in_zone(ZONE* z, CELL pointer)

native/primitives.c

@@ -9,8 +9,6 @@ void* primitives[] = {
 	primitive_ifte,
 	primitive_cons,
 	primitive_vector,
-	primitive_vector_nth,
-	primitive_set_vector_nth,
 	primitive_string_nth,
 	primitive_string_compare,
 	primitive_string_eq,

native/primitives.h

@@ -1,4 +1,4 @@
 extern void* primitives[];
-#define PRIMITIVE_COUNT 195
+#define PRIMITIVE_COUNT 194
 
 CELL primitive_to_xt(CELL primitive);

native/unix/signal.c

@@ -9,6 +9,8 @@ void signal_handler(int signal, siginfo_t* siginfo, void* uap)
 		fprintf(stderr,"active.here  = %ld\n",active.here);
 		fprintf(stderr,"active.limit = %ld\n",active.limit);
 		fflush(stderr);
+		flip_zones();
+		dump_stacks();
 		exit(1);
 	}
 	else

native/vector.c

@@ -22,47 +22,6 @@ void primitive_to_vector(void)
 	type_check(VECTOR_TYPE,dpeek());
 }
 
-void primitive_vector_nth(void)
-{
-	F_VECTOR* vector = untag_vector(dpop());
-	CELL index = to_fixnum(dpop());
-
-	if(index < 0 || index >= vector->top)
-		range_error(tag_object(vector),0,tag_fixnum(index),vector->top);
-	dpush(array_nth(untag_array(vector->array),index));
-}
-
-void vector_ensure_capacity(F_VECTOR* vector, CELL index)
-{
-	F_ARRAY* array = untag_array(vector->array);
-	CELL capacity = array->capacity;
-	if(index >= capacity)
-		array = grow_array(array,index * 2 + 1,F);
-	vector->top = index + 1;
-	vector->array = tag_object(array);
-}
-
-void primitive_set_vector_nth(void)
-{
-	F_VECTOR* vector;
-	F_FIXNUM index;
-	CELL value;
-
-	maybe_garbage_collection();
-
-	vector = untag_vector(dpop());
-	index = to_fixnum(dpop());
-	value = dpop();
-
-	if(index < 0)
-		range_error(tag_object(vector),0,tag_fixnum(index),vector->top);
-	else if(index >= vector->top)
-		vector_ensure_capacity(vector,index);
-
-	/* the following does not check bounds! */
-	set_array_nth(untag_array(vector->array),index,value);
-}
-
 void fixup_vector(F_VECTOR* vector)
 {
 	data_fixup(&vector->array);

native/vector.h

@@ -17,8 +17,5 @@ F_VECTOR* vector(F_FIXNUM capacity);
 
 void primitive_vector(void);
 void primitive_to_vector(void);
-void primitive_vector_nth(void);
-void vector_ensure_capacity(F_VECTOR* vector, CELL index);
-void primitive_set_vector_nth(void);
 void fixup_vector(F_VECTOR* vector);
 void collect_vector(F_VECTOR* vector);