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

* moved list?, reverse, and last-pair to ikarus.lists

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 05:24:37 -04:00
parent 67561089ae
commit 4a24e5ed28
3 changed files with 55 additions and 51 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.

49
src/ikarus.core.ss
View File

@ -65,55 +65,6 @@
(primitive-set! 'list?
(letrec ([race
(lambda (h t)
(if (pair? h)
(let ([h ($cdr h)])
(if (pair? h)
(and (not (eq? h t))
(race ($cdr h) ($cdr t)))
(null? h)))
(null? h)))])
(lambda (x) (race x x))))
(primitive-set! 'reverse
(letrec ([race
(lambda (h t ls ac)
(if (pair? h)
(let ([h ($cdr h)] [ac (cons ($car h) ac)])
(if (pair? h)
(if (not (eq? h t))
(race ($cdr h) ($cdr t) ls (cons ($car h) ac))
(error 'reverse "~s is a circular list" ls))
(if (null? h)
ac
(error 'reverse "~s is not a proper list" ls))))
(if (null? h)
ac
(error 'reverse "~s is not a proper list" ls))))])
(lambda (x)
(race x x x '()))))
(primitive-set! 'last-pair
(letrec ([race
(lambda (h t ls last)
(if (pair? h)
(let ([h ($cdr h)] [last h])
(if (pair? h)
(if (not (eq? h t))
(race ($cdr h) ($cdr t) ls h)
(error 'last-pair "~s is a circular list" ls))
last))
last))])
(lambda (x)
(if (pair? x)
(let ([d (cdr x)])
(race d d x x))
(error 'last-pair "~s is not a pair" x)))))
(primitive-set! 'memq
(letrec ([race
(lambda (h t ls x)

57
src/ikarus.lists.ss
View File

@ -1,7 +1,10 @@
(library (ikarus lists)
(export $memq)
(import (ikarus))
(export $memq list? reverse last-pair)
(import
(only (scheme) $car $cdr)
(except (ikarus) list? reverse last-pair))
(define $memq
(lambda (x ls)
@ -10,6 +13,56 @@
(if (eq? x (car ls))
ls
(f x (cdr ls)))))))
(define list?
(letrec ([race
(lambda (h t)
(if (pair? h)
(let ([h ($cdr h)])
(if (pair? h)
(and (not (eq? h t))
(race ($cdr h) ($cdr t)))
(null? h)))
(null? h)))])
(lambda (x) (race x x))))
(define reverse
(letrec ([race
(lambda (h t ls ac)
(if (pair? h)
(let ([h ($cdr h)] [ac (cons ($car h) ac)])
(if (pair? h)
(if (not (eq? h t))
(race ($cdr h) ($cdr t) ls (cons ($car h) ac))
(error 'reverse "~s is a circular list" ls))
(if (null? h)
ac
(error 'reverse "~s is not a proper list" ls))))
(if (null? h)
ac
(error 'reverse "~s is not a proper list" ls))))])
(lambda (x)
(race x x x '()))))
(define last-pair
(letrec ([race
(lambda (h t ls last)
(if (pair? h)
(let ([h ($cdr h)] [last h])
(if (pair? h)
(if (not (eq? h t))
(race ($cdr h) ($cdr t) ls h)
(error 'last-pair "~s is a circular list" ls))
last))
last))])
(lambda (x)
(if (pair? x)
(let ([d (cdr x)])
(race d d x x))
(error 'last-pair "~s is not a pair" x)))))
)