symbol=? and boolean=? now accept 2+ args.
This commit is contained in:
parent
acc9940379
commit
9f623124d5
|
@ -247,26 +247,48 @@
|
||||||
(= (imag-part x) (imag-part y)))]
|
(= (imag-part x) (imag-part y)))]
|
||||||
[else #f])))
|
[else #f])))
|
||||||
|
|
||||||
(define boolean=?
|
|
||||||
(lambda (x y)
|
(define-syntax define-pred
|
||||||
(if (sys:boolean? x)
|
(syntax-rules ()
|
||||||
(if (sys:eq? x y)
|
[(_ name pred? msg)
|
||||||
#t
|
(begin
|
||||||
(if (sys:boolean? y)
|
(define (err x) (die 'name msg x))
|
||||||
#f
|
(define (g rest)
|
||||||
(die 'boolean=? "not a boolean" y)))
|
(if (sys:pair? rest)
|
||||||
(die 'boolean=? "not a boolean" x))))
|
(let ([a (car rest)])
|
||||||
|
(if (pred? a)
|
||||||
|
(g (cdr rest))
|
||||||
(define symbol=?
|
(err a)))
|
||||||
(lambda (x y)
|
#f))
|
||||||
(if (sys:symbol? x)
|
(define (f x rest)
|
||||||
(if (sys:eq? x y)
|
(if (sys:pair? rest)
|
||||||
#t
|
(let ([a (car rest)])
|
||||||
(if (sys:symbol? y)
|
(if (sys:eq? x a)
|
||||||
#f
|
(f x (cdr rest))
|
||||||
(die 'symbol=? "not a symbol" y)))
|
(if (pred? a)
|
||||||
(die 'symbol=? "not a symbol" x))))
|
(g (cdr rest))
|
||||||
|
(err a))))
|
||||||
|
#t))
|
||||||
|
(define name
|
||||||
|
(case-lambda
|
||||||
|
[(x y)
|
||||||
|
(if (pred? x)
|
||||||
|
(if (sys:eq? x y)
|
||||||
|
#t
|
||||||
|
(if (pred? y)
|
||||||
|
#f
|
||||||
|
(err y)))
|
||||||
|
(err x))]
|
||||||
|
[(x y z . rest)
|
||||||
|
(if (pred? x)
|
||||||
|
(if (sys:eq? x y)
|
||||||
|
(if (sys:eq? x z)
|
||||||
|
(f x rest)
|
||||||
|
(if (pred? z) #f (err z)))
|
||||||
|
(if (pred? y) #f (err y)))
|
||||||
|
(err x))])))]))
|
||||||
|
(define-pred symbol=? sys:symbol? "not a symbol")
|
||||||
|
(define-pred boolean=? sys:boolean? "not a boolean")
|
||||||
|
|
||||||
(module (equal?)
|
(module (equal?)
|
||||||
(define vector-loop
|
(define vector-loop
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1547
|
1548
|
||||||
|
|
Loading…
Reference in New Issue