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

implemented assoc

This commit is contained in:
Abdulaziz Ghuloum 2006-11-28 06:54:07 -05:00
parent f6a95c07d2
commit e97b39a39a
3 changed files with 30 additions and 1 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.

29
src/libcore.ss
View File

@ -1020,6 +1020,35 @@
(lambda (x ls)
(race x ls ls ls))))
(primitive-set! 'assoc
(letrec ([race
(lambda (x h t ls)
(if (pair? h)
(let ([a ($car h)] [h ($cdr h)])
(if (pair? a)
(if (equal? ($car a) x)
a
(if (pair? h)
(if (not (eq? h t))
(let ([a ($car h)])
(if (pair? a)
(if (equal? ($car a) x)
a
(race x ($cdr h) ($cdr t) ls))
(error 'assoc "malformed alist ~s"
ls)))
(error 'assoc "circular list ~s" ls))
(if (null? h)
#f
(error 'assoc "~s is not a proper list" ls))))
(error 'assoc "malformed alist ~s" ls)))
(if (null? h)
#f
(error 'assoc "~s is not a proper list" ls))))])
(lambda (x ls)
(race x ls ls ls))))
(primitive-set! 'string->symbol
(lambda (x)
(unless (string? x)

2
src/makefile.ss
View File

@ -57,7 +57,7 @@
remprop putprop getprop property-list
apply
map for-each andmap ormap
memq memv assq
memq memv assq assoc
eq? equal?
reverse
string->symbol symbol->string oblist