* Added vector-sort!

src/ikarus.sort.ss

@@ -1,9 +1,9 @@
 
 (library (ikarus.sort)
-  (export list-sort vector-sort)
+  (export list-sort vector-sort vector-sort!)
   (import 
     (ikarus system $fx)
-    (except (ikarus) list-sort vector-sort))
+    (except (ikarus) list-sort vector-sort vector-sort!))
   
 
   (define (merge1 <? a1 ls1 ls2) 
@@ -72,6 +72,18 @@
       (error 'vector-sort "~s is not a vector" v))
     (list->vector 
       (sort-tail <? (vector->list v) (vector-length v))))
+
+  (define (vector-sort! <? v) 
+    (unless (procedure? <?)
+      (error 'vector-sort! "~s is not a procedure" <?))
+    (unless (vector? v)
+      (error 'vector-sort! "~s is not a vector" v))
+    (let f ([i 0] [v v] 
+            [ls (sort-tail <? (vector->list v) (vector-length v))])
+      (unless (null? ls) 
+        (vector-set! v i (car ls))
+        (f (fx+ i 1) v (cdr ls)))))
+    
   )
 
 

src/makefile.ss

@@ -326,6 +326,7 @@
     [member                  i r]
     [list-sort               i]
     [vector-sort             i]
+    [vector-sort!            i]
     [bwp-object?             i]
     [weak-cons               i]
     [weak-pair?              i]

src/todo-r6rs.ss

@@ -14,11 +14,11 @@
     [sc (rnrs syntax-case (6))]
     [fi (rnrs files (6))]
     [ne (null-environment)]
+    [sr (rnrs sorting (6))]
     [ba (rnrs base (6))]
     [ls (rnrs lists (6))]
     [is (rnrs io simple (6))]
     [bv (rnrs bytevectors (6))]
-    [sr (rnrs sorting (6))]
     [uc (rnrs unicode (6))]
     [ex (rnrs exceptions (6))]
     [bw (rnrs arithmetic bitwise (6))]
@@ -686,7 +686,7 @@
     ;;;
     [list-sort                                  C sr]
     [vector-sort                                C sr]
-    [vector-sort!                               S sr]
+    [vector-sort!                               C sr]
     ;;;
     [file-exists?                               C fi]
     [delete-file                                C fi]