added eqv? and memv
This commit is contained in:
parent
71f98ef203
commit
0048c829b3
BIN
lib/ikarus.boot
BIN
lib/ikarus.boot
Binary file not shown.
|
@ -709,6 +709,11 @@ reference-implementation:
|
||||||
|
|
||||||
(primitive-set! 'eq? (lambda (x y) (eq? x y)))
|
(primitive-set! 'eq? (lambda (x y) (eq? x y)))
|
||||||
|
|
||||||
|
(primitive-set! 'eqv?
|
||||||
|
(lambda (x y)
|
||||||
|
(or (eq? x y)
|
||||||
|
(and (number? x) (number? y) (= x y)))))
|
||||||
|
|
||||||
(primitive-set! 'set-car!
|
(primitive-set! 'set-car!
|
||||||
(lambda (x y)
|
(lambda (x y)
|
||||||
(unless (pair? x)
|
(unless (pair? x)
|
||||||
|
@ -872,7 +877,30 @@ reference-implementation:
|
||||||
|
|
||||||
#|BUG: memv should be defined in terms of eqv? now that we have
|
#|BUG: memv should be defined in terms of eqv? now that we have
|
||||||
bignums.|#
|
bignums.|#
|
||||||
(primitive-set! 'memv memq)
|
|
||||||
|
(primitive-set! 'memv
|
||||||
|
(letrec ([race
|
||||||
|
(lambda (h t ls x)
|
||||||
|
(if (pair? h)
|
||||||
|
(if (eqv? ($car h) x)
|
||||||
|
h
|
||||||
|
(let ([h ($cdr h)])
|
||||||
|
(if (pair? h)
|
||||||
|
(if (eqv? ($car h) x)
|
||||||
|
h
|
||||||
|
(if (not (eq? h t))
|
||||||
|
(race ($cdr h) ($cdr t) ls x)
|
||||||
|
(error 'memv "circular list ~s" ls)))
|
||||||
|
(if (null? h)
|
||||||
|
'#f
|
||||||
|
(error 'memv "~s is not a proper list" ls)))))
|
||||||
|
(if (null? h)
|
||||||
|
'#f
|
||||||
|
(error 'memv "~s is not a proper list" ls))))])
|
||||||
|
(lambda (x ls)
|
||||||
|
(race ls ls ls x))))
|
||||||
|
|
||||||
|
|
||||||
(primitive-set! 'vector-memv vector-memq)
|
(primitive-set! 'vector-memv vector-memq)
|
||||||
|
|
||||||
(primitive-set! 'list->string
|
(primitive-set! 'list->string
|
||||||
|
|
|
@ -58,7 +58,7 @@
|
||||||
apply
|
apply
|
||||||
map for-each andmap ormap
|
map for-each andmap ormap
|
||||||
memq memv assq assoc
|
memq memv assq assoc
|
||||||
eq? equal?
|
eq? eqv? equal?
|
||||||
reverse
|
reverse
|
||||||
string->symbol symbol->string oblist
|
string->symbol symbol->string oblist
|
||||||
top-level-value set-top-level-value! top-level-bound?
|
top-level-value set-top-level-value! top-level-bound?
|
||||||
|
|
Loading…
Reference in New Issue