From 61fc6618660506cf12b796634b8c29556c21482e Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 23 May 2010 04:50:00 -0700
Subject: [PATCH] Implement VECTOR-HEAD!.

---
 src/runtime/vector.scm | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/runtime/vector.scm b/src/runtime/vector.scm
index 770093533..31ec0161f 100644
--- a/src/runtime/vector.scm
+++ b/src/runtime/vector.scm
@@ -30,6 +30,8 @@ USA.
 
 (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)))
-- 
2.25.1