* moved vector to ikarus.vectors

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 05:19:31 -04:00
parent d09192f506
commit 7f02ac9da7
3 changed files with 26 additions and 23 deletions

Binary file not shown.

View File

@ -70,24 +70,6 @@
(f x (cdr ls))))))) (f x (cdr ls)))))))
(primitive-set! 'vector
;;; FIXME: add case-lambda
(letrec ([length
(lambda (ls n)
(cond
[(null? ls) n]
[else (length ($cdr ls) ($fx+ n 1))]))]
[loop
(lambda (v ls i n)
(cond
[($fx= i n) v]
[else
($vector-set! v i ($car ls))
(loop v ($cdr ls) ($fx+ i 1) n)]))])
(lambda ls
(let ([n (length ls 0)])
(let ([v (make-vector n)])
(loop v ls 0 n))))))
(primitive-set! 'list? (primitive-set! 'list?

View File

@ -1,12 +1,12 @@
(library (ikarus vectors) (library (ikarus vectors)
(export make-vector vector-length vector-ref vector-set!) (export make-vector vector vector-length vector-ref vector-set!)
(import (import
(except (ikarus) make-vector vector-length vector-ref (except (ikarus) make-vector vector
vector-set!) vector-length vector-ref vector-set!)
(only (scheme) (only (scheme)
$fx= $fx>= $fx< $fx<= $fx+ $vector-set! $vector-ref $fx= $fx>= $fx< $fx<= $fx+ $car $cdr
$make-vector $vector-length)) $vector-set! $vector-ref $make-vector $vector-length))
(define vector-length (define vector-length
@ -31,6 +31,27 @@
(error 'make-vector "~s is not a valid length" n)) (error 'make-vector "~s is not a valid length" n))
(fill! ($make-vector n) 0 n fill)]))) (fill! ($make-vector n) 0 n fill)])))
(define vector
;;; FIXME: add case-lambda
(letrec ([length
(lambda (ls n)
(cond
[(null? ls) n]
[else (length ($cdr ls) ($fx+ n 1))]))]
[loop
(lambda (v ls i n)
(cond
[($fx= i n) v]
[else
($vector-set! v i ($car ls))
(loop v ($cdr ls) ($fx+ i 1) n)]))])
(lambda ls
(let ([n (length ls 0)])
(let ([v (make-vector n)])
(loop v ls 0 n))))))
(define vector-ref (define vector-ref
(lambda (v i) (lambda (v i)
(unless (vector? v) (unless (vector? v)