implemented assoc
This commit is contained in:
parent
f6a95c07d2
commit
e97b39a39a
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -1020,6 +1020,35 @@
|
||||||
(lambda (x ls)
|
(lambda (x ls)
|
||||||
(race x ls ls 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
|
(primitive-set! 'string->symbol
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(unless (string? x)
|
(unless (string? x)
|
||||||
|
|
|
@ -57,7 +57,7 @@
|
||||||
remprop putprop getprop property-list
|
remprop putprop getprop property-list
|
||||||
apply
|
apply
|
||||||
map for-each andmap ormap
|
map for-each andmap ormap
|
||||||
memq memv assq
|
memq memv assq assoc
|
||||||
eq? equal?
|
eq? equal?
|
||||||
reverse
|
reverse
|
||||||
string->symbol symbol->string oblist
|
string->symbol symbol->string oblist
|
||||||
|
|
Loading…
Reference in New Issue