* moved list and make-list to ikarus.lists

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 06:12:47 -04:00
parent 8188c51d20
commit 3f5556cd28
3 changed files with 24 additions and 39 deletions

Binary file not shown.

View File

@ -161,44 +161,8 @@
[(f a0 a1 . ls)
(fixandgo f a0 a1 ls ls ($cdr ls))]))
apply))
(let ()
(define f
(lambda (n fill ls)
(cond
[($fxzero? n) ls]
[else
(f ($fxsub1 n) fill (cons fill ls))])))
(primitive-set! 'make-list
(case-lambda
[(n)
(if (and (fixnum? n) ($fx>= n 0))
(f n (void) '())
(error 'make-list "~s is not a valid length" n))]
[(n fill)
(if (and (fixnum? n) ($fx>= n 0))
(f n fill '())
(error 'make-list "~s is not a valid length" n))])))
(primitive-set! 'list (lambda x x))
(primitive-set! 'gensym->unique-string

View File

@ -1,11 +1,11 @@
(library (ikarus lists)
(export $memq list? append length list-ref reverse last-pair
(export $memq list? list make-list append length list-ref reverse last-pair
memq memv member assq assv assoc
map for-each andmap ormap)
(import
(only (scheme) $car $cdr $fx+ $fxadd1 $fxsub1 $fxzero? $fx>=)
(except (ikarus) list? append reverse last-pair length list-ref
(except (ikarus) list? list make-list append reverse last-pair length list-ref
memq memv member assq assv assoc
map for-each andmap ormap))
@ -17,6 +17,8 @@
ls
(f x (cdr ls)))))))
(define list (lambda x x))
(define list?
(letrec ([race
(lambda (h t)
@ -28,7 +30,26 @@
(null? h)))
(null? h)))])
(lambda (x) (race x x))))
(module (make-list)
(define f
(lambda (n fill ls)
(cond
[($fxzero? n) ls]
[else
(f ($fxsub1 n) fill (cons fill ls))])))
(define make-list
(case-lambda
[(n)
(if (and (fixnum? n) ($fx>= n 0))
(f n (void) '())
(error 'make-list "~s is not a valid length" n))]
[(n fill)
(if (and (fixnum? n) ($fx>= n 0))
(f n fill '())
(error 'make-list "~s is not a valid length" n))])))
(define length
(letrec ([race
(lambda (h t ls n)