diff --git a/collects/rnrs/base-6.ss b/collects/rnrs/base-6.ss index 7868e58930..4084ec3a06 100644 --- a/collects/rnrs/base-6.ss +++ b/collects/rnrs/base-6.ss @@ -76,7 +76,7 @@ [r6rs:string->number string->number]) ;; 11.8 - not boolean? boolean=? + not boolean? (rename-out [r6rs:boolean=? boolean=?]) ;; 11.9 (rename-out [r5rs:pair? pair?] @@ -123,7 +123,7 @@ [r5rs:for-each for-each]) ;; 11.10 - symbol? symbol=? + symbol? (rename-out [r6rs:symbol=? symbol=?]) string->symbol symbol->string ;; 11.11 @@ -349,6 +349,22 @@ (and (regexp-match? rx:number s) (string->number (regexp-replace* #rx"[|][0-9]+" s ""))))) +(define r6rs:symbol=? + (case-lambda + [(a b) (symbol=? a b)] + [(a b . rest) (and (symbol=? a b) + (andmap (lambda (s) + (symbol=? a s)) + rest))])) + +(define r6rs:boolean=? + (case-lambda + [(a b) (boolean=? a b)] + [(a b . rest) (and (boolean=? a b) + (andmap (lambda (s) + (boolean=? a s)) + rest))])) + (define-syntax-rule (make-mapper what for for-each in-val val-length val->list list->result) (case-lambda [(proc val) (list->result diff --git a/collects/tests/r6rs/base.sls b/collects/tests/r6rs/base.sls index f5fbb6fcc1..d39521ad9e 100644 --- a/collects/tests/r6rs/base.sls +++ b/collects/tests/r6rs/base.sls @@ -1005,6 +1005,8 @@ (test (boolean=? #t #t) #t) (test (boolean=? #t #f) #f) (test (boolean=? #f #t) #f) + (test (boolean=? #t #t #f) #f) + (test (boolean=? #t #t #t #t) #t) ;; 11.9 (test (pair? '(a . b)) #t) @@ -1126,6 +1128,8 @@ (test (symbol=? 'a 'a) #t) (test (symbol=? 'a 'A) #f) (test (symbol=? 'a 'b) #f) + (test (symbol=? 'a 'a 'b) #f) + (test (symbol=? 'a 'a 'a 'a) #t) (test (symbol->string 'flying-fish) "flying-fish")