suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

change 'case' to use equal?

Browse Source
This commit is contained in:
Jon Zeppieri 2012-11-25 18:23:02 -05:00 committed by Matthew Flatt
parent 43e7150fdf
commit 486e95049f
3 changed files with 88 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/racket/private/case.rkt
View File

@ -10,7 +10,7 @@
(define-syntax (case stx)
(syntax-case* stx (else) (λ (a b) (free-identifier=? a (datum->syntax stx 'else)))
(syntax-case stx (else)
;; Empty case
[(_ v) (syntax/loc stx (#%expression (begin v (void))))]
@ -96,8 +96,8 @@
(define-syntax (case/sequential-test stx)
(syntax-case stx ()
[(_ v ()) #'#f]
[(_ v (k)) #`(eqv? v 'k)]
[(_ v (k ks ...)) #`(if (eqv? v 'k)
[(_ v (k)) #`(equal? v 'k)]
[(_ v (k ks ...)) #`(if (equal? v 'k)
#t
(case/sequential-test v (ks ...)))]))
@ -145,7 +145,7 @@
(define interval-index caddr)
(define (partition-constants stx)
(define h (make-hasheqv))
(define h (make-hash))
(define (duplicate? x)
(not (eq? (hash-ref h x nothing) nothing)))
@ -163,7 +163,7 @@
[else (let inner ([f f] [s s] [c c] [o o] [ys (syntax->list (car xs))])
(cond [(null? ys) (loop f s c o (add1 idx) (cdr xs))]
[else
(let ([y (syntax-e (car ys))])
(let ([y (syntax->datum (car ys))])
(cond [(duplicate? y) (inner f s c o (cdr ys))]
[(fixnum? y) (inner (add f y idx) s c o (cdr ys))]
[(symbol? y) (inner f (add s y idx) c o (cdr ys))]
@ -205,7 +205,7 @@
(dispatch-hashable tmp-stx symbol-alist make-immutable-hasheq else-exp))
(define (dispatch-other tmp-stx other-alist else-exp)
(dispatch-hashable tmp-stx other-alist make-immutable-hasheqv else-exp))
(dispatch-hashable tmp-stx other-alist make-immutable-hash else-exp))
(define (test-for-symbol tmp-stx alist)
(define (contains? pred)

2
collects/scribblings/reference/syntax.scrbl
View File

@ -2132,7 +2132,7 @@ position with respect to the original @racket[or] form.
Evaluates @racket[val-expr] and uses the result to select a
@racket[case-clause]. The selected clause is the first one with a
@racket[datum] whose @racket[quote]d form is @racket[eqv?] to the
@racket[datum] whose @racket[quote]d form is @racket[equal?] to the
result of @racket[val-expr]. If no such @racket[datum] is present, the
@racket[else] @racket[case-clause] is selected; if no @racket[else]
@racket[case-clause] is present, either, then the result of the

81
collects/tests/racket/syntax.rktl
View File

@ -457,6 +457,87 @@
(test (void) f 'gigante)
(test (void) f 0))
(let ()
;; This test uses string-copy to avoid interning string literals.
(define (f x)
(define y
(if (string? x)
(string-copy x)
x))
(case y
[("low") 0]
[("one") 1]
[("middle") 2]
[("upper" #t) 3]
[("high" "big" "up-there" "more") 4]
[("extreme" "massive" "huge" "gigantic" #f) 5]))
(test 0 f "low")
(test 1 f "one")
(test 2 f "middle")
(test 3 f "upper")
(test 3 f #t)
(test 4 f "high")
(test 4 f "big")
(test 4 f "up-there")
(test 4 f "more")
(test 5 f "extreme")
(test 5 f "massive")
(test 5 f "huge")
(test 5 f #f)
(test 5 f "gigantic")
(test (void) f "gigante")
(test (void) f 'gigante)
(test (void) f 0))
(let ()
(define (f x)
(case x
[("zero" #"zero" (z . 0) (z e r o) #(z e r o) #&zero
#hash((z . "z") (e . "e") (r . "r") (o . "o"))
#s(z e r o))
0]
[("one" #"one" (o . 1) (o n e) #(o n e) #&one
#hash((o . "o") (n . "n") (e . "e"))
#s(o n e))
1]
[("two" #"two" (t . 2) (t w o) #(t w o) #&two
#hash((t . "t") (w . "w") (o . "o"))
#s(t w o))
2]
[("three" #"three" (t . 3) (t h r e e) #(t h r e e) #&three
#hash((t . "t") (h . "h") (r . "e") (e . "e") (e . "e"))
#s(t h r e e))
3]
[("four" #"four" (f . 4) (f o u r) #(f o u r) #&four
#hash((f . "f") (o . "o") (u . "u") (r . "r"))
#s(f o u r))
4]
[("five" #"five" (f . 5) (f i v e) #(f i v e) #&five
#hash((f . "f") (i . "i") (v . "v") (e . "e"))
#s(f i v e))
5]
[("six" #"six" (s . 6) (s i x) #(s i x) #&six
#hash((s . "s") (i . "i") (x . "x"))
#s(s i x))
6]
[("seven" #"seven" (s . 7) (s e v e n) #(s e v e n) #&seven
#hash((s . "s") (e . "e") (v . "v") (e . "e") (n . "n"))
#s(s e v e n))
7]
[("eight" #"eight" (e . 8) (e i g h t) #(e i g h t) #&eight
#hash((e . "e") (i . "i") (g . "g") (h . "h") (t . "t"))
#s(e i g h t))
8]))
(test 8 f "eight")
(test 7 f #"seven")
(test 6 f (cons 's 6))
(test 5 f '(f i v e))
(test 4 f '#(f o u r))
(test 3 f (box 'three))
(test 2 f (hash 't "t" 'w "w" 'o "o"))
(test 1 f #s(o n e))
(test (void) f #f))
(test #t 'and (and (= 2 2) (> 2 1)))
(test #f 'and (and (= 2 2) (< 2 1)))
(test '(f g) 'and (and 1 2 'c '(f g)))