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

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

BIN
src/ikarus.boot
View File

Binary file not shown.

36
src/ikarus.core.ss
View File

@ -165,42 +165,6 @@
(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 (primitive-set! 'gensym->unique-string
(lambda (x) (lambda (x)
(unless (symbol? x) (unless (symbol? x)

25
src/ikarus.lists.ss
View File

@ -1,11 +1,11 @@
(library (ikarus lists) (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 memq memv member assq assv assoc
map for-each andmap ormap) map for-each andmap ormap)
(import (import
(only (scheme) $car $cdr $fx+ $fxadd1 $fxsub1 $fxzero? $fx>=) (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 memq memv member assq assv assoc
map for-each andmap ormap)) map for-each andmap ormap))
@ -17,6 +17,8 @@
ls ls
(f x (cdr ls))))))) (f x (cdr ls)))))))
(define list (lambda x x))
(define list? (define list?
(letrec ([race (letrec ([race
(lambda (h t) (lambda (h t)
@ -29,6 +31,25 @@
(null? h)))]) (null? h)))])
(lambda (x) (race x x)))) (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 (define length
(letrec ([race (letrec ([race
(lambda (h t ls n) (lambda (h t ls n)