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

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

18
src/ikarus.core.ss
View File

@ -70,24 +70,6 @@
(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?

31
src/ikarus.vectors.ss
View File

@ -1,12 +1,12 @@
(library (ikarus vectors)
(export make-vector vector-length vector-ref vector-set!)
(export make-vector vector vector-length vector-ref vector-set!)
(import
(except (ikarus) make-vector vector-length vector-ref
vector-set!)
(except (ikarus) make-vector vector
vector-length vector-ref vector-set!)
(only (scheme)
$fx= $fx>= $fx< $fx<= $fx+ $vector-set! $vector-ref
$make-vector $vector-length))
$fx= $fx>= $fx< $fx<= $fx+ $car $cdr
$vector-set! $vector-ref $make-vector $vector-length))
(define vector-length
@ -31,6 +31,27 @@
(error 'make-vector "~s is not a valid length" n))
(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
(lambda (v i)
(unless (vector? v)