Implement VECTOR-HEAD!.

diff --git a/src/runtime/vector.scm b/src/runtime/vector.scm
index 77009353336119b23d680a37dc4c14ededee8b43..31ec0161fe82c3c4356a26782d90d2e35f8a5ecf 100644 (file)
--- a/src/runtime/vector.scm
+++ b/src/runtime/vector.scm
@@ -30,6 +30,8 @@ USA.
 \f
 (define-primitives
   (list->vector 1)
+  (primitive-make-object 2)
+  (primitive-object-set! 3)
   (subvector->list 3)
   (subvector-fill! 4)
   (subvector-move-left! 5)
@@ -77,6 +79,14 @@ USA.
 (define-integrable (vector-head vector end)
   (subvector vector 0 end))
 
+(define (vector-head! vector end)
+  (guarantee-subvector vector 0 end 'VECTOR-HEAD!)
+  (if (fix:< end (vector-length end))
+      (primitive-object-set! vector 0
+                            (primitive-make-object (ucode-type false)
+                                                   end)))
+  vector)
+
 (define (vector-tail vector start)
   (guarantee-vector vector 'VECTOR-TAIL)
   (subvector vector start (vector-length vector)))