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

* moved length and list-ref to ikarus.lists

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 05:29:35 -04:00
parent 6a381a70f8
commit 4a6f340ce2
3 changed files with 43 additions and 41 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.

37
src/ikarus.core.ss
View File

@ -70,43 +70,6 @@
(primitive-set! 'length
(letrec ([race
(lambda (h t ls n)
(if (pair? h)
(let ([h ($cdr h)])
(if (pair? h)
(if (not (eq? h t))
(race ($cdr h) ($cdr t) ls ($fx+ n 2))
(error 'length "circular list ~s" ls))
(if (null? h)
($fx+ n 1)
(error 'length "~s is not a proper list" ls))))
(if (null? h)
n
(error 'length "~s is not a proper list" ls))))])
(lambda (ls)
(race ls ls ls 0))))
(primitive-set! 'list-ref
(lambda (list index)
(define f
(lambda (ls i)
(cond
[($fxzero? i)
(if (pair? ls)
($car ls)
(error 'list-ref "index ~s is out of range for ~s" index list))]
[(pair? ls)
(f ($cdr ls) ($fxsub1 i))]
[(null? ls)
(error 'list-rec "index ~s is out of range for ~s" index list)]
[else (error 'list-ref "~s is not a list" list)])))
(unless (and (fixnum? index) ($fx>= index 0))
(error 'list-ref "~s is not a valid index" index))
(f list index)))

45
src/ikarus.lists.ss
View File

@ -1,10 +1,12 @@
(library (ikarus lists) (library (ikarus lists)
(export $memq list? reverse last-pair memq memv member) (export $memq list? length list-ref reverse last-pair
memq memv member)
(import (import
(only (scheme) $car $cdr) (only (scheme) $car $cdr $fx+ $fxsub1 $fxzero? $fx>=)
(except (ikarus) list? reverse last-pair memq memv member)) (except (ikarus) list? reverse last-pair memq memv member
length list-ref))
(define $memq (define $memq
(lambda (x ls) (lambda (x ls)
@ -26,6 +28,41 @@
(null? h)))]) (null? h)))])
(lambda (x) (race x x)))) (lambda (x) (race x x))))
(define length
(letrec ([race
(lambda (h t ls n)
(if (pair? h)
(let ([h ($cdr h)])
(if (pair? h)
(if (not (eq? h t))
(race ($cdr h) ($cdr t) ls ($fx+ n 2))
(error 'length "circular list ~s" ls))
(if (null? h)
($fx+ n 1)
(error 'length "~s is not a proper list" ls))))
(if (null? h)
n
(error 'length "~s is not a proper list" ls))))])
(lambda (ls)
(race ls ls ls 0))))
(define list-ref
(lambda (list index)
(define f
(lambda (ls i)
(cond
[($fxzero? i)
(if (pair? ls)
($car ls)
(error 'list-ref "index ~s is out of range for ~s" index list))]
[(pair? ls)
(f ($cdr ls) ($fxsub1 i))]
[(null? ls)
(error 'list-rec "index ~s is out of range for ~s" index list)]
[else (error 'list-ref "~s is not a list" list)])))
(unless (and (fixnum? index) ($fx>= index 0))
(error 'list-ref "~s is not a valid index" index))
(f list index)))
(define reverse (define reverse
(letrec ([race (letrec ([race
@ -128,5 +165,7 @@
(lambda (x ls) (lambda (x ls)
(race ls ls ls x)))) (race ls ls ls x))))
) )