conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added vector-sort!

This commit is contained in:
Abdulaziz Ghuloum 2007-09-09 23:58:00 -04:00
parent 375b738ccb
commit 18b4a78045
4 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

16
src/ikarus.sort.ss
View File

@ -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)))))
)

1
src/makefile.ss
View File

@ -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]

4
src/todo-r6rs.ss
View File

@ -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]