diff --git a/src/ikarus.boot b/src/ikarus.boot index 6da89e5..6ca16dc 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.core.ss b/src/ikarus.core.ss index 61c75d8..44d375b 100644 --- a/src/ikarus.core.ss +++ b/src/ikarus.core.ss @@ -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 diff --git a/src/ikarus.lists.ss b/src/ikarus.lists.ss index 616baaf..51fe17a 100644 --- a/src/ikarus.lists.ss +++ b/src/ikarus.lists.ss @@ -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)