Changeset 29954 in project


Ignore:
Timestamp:
10/25/13 00:08:28 (8 years ago)
Author:
evhan
Message:

r7rs: Extended-arity char*? and string*? comparators

Location:
release/4/r7rs/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/r7rs/trunk/scheme.base-interface.scm

    r29599 r29954  
    3333  char-ready?
    3434  char->integer integer->char
    35   char<? char>? char<=? char>=?
     35  |#
     36  char=? char<? char>? char<=? char>=?
     37  #|
    3638  char?
    3739  close-input-port close-output-port
     
    182184  string-map
    183185  string-ref string-set!
     186  |#
    184187  string=? string<? string>? string<=? string>=?
     188  #|
    185189  string?
    186190  substring
  • release/4/r7rs/trunk/scheme.base.scm

    r29599 r29954  
    11(module scheme.base ()
    22
    3 (import (except scheme syntax-rules cond-expand member))
     3(import (except scheme syntax-rules cond-expand
     4                       assoc list-set! list-tail member
     5                       char=? char<? char>? char<=? char>=?
     6                       string=? string<? string>? string<=? string>=?))
     7(import (prefix (only scheme char=? char<? char>? char<=? char>=?
     8                             string=? string<? string>? string<=? string>=?)
     9                %))
    410(import (except chicken with-exception-handler raise quotient remainder modulo))
    511(import numbers)
     
    223229
    224230;;;
     231;;; 6.6 Characters
     232;;;
     233
     234(define-syntax define-extended-arity-comparator
     235  (syntax-rules ()
     236    ((_ name comparator check-type)
     237     (define name
     238       (let ((cmp comparator))
     239         (lambda (o1 o2 . os)
     240           (check-type o1 'name)
     241           (let lp ((o1 o1) (o2 o2) (os os) (eq #t))
     242             (check-type o2 'name)
     243             (if (null? os)
     244                 (and eq (cmp o1 o2))
     245                 (lp o2 (car os) (cdr os) (and eq (cmp o1 o2)))))))))))
     246
     247(: char=? (char char #!rest char -> boolean))
     248(: char<? (char char #!rest char -> boolean))
     249(: char>? (char char #!rest char -> boolean))
     250(: char<=? (char char #!rest char -> boolean))
     251(: char>=? (char char #!rest char -> boolean))
     252
     253(define-extended-arity-comparator char=? %char=? ##sys#check-char)
     254(define-extended-arity-comparator char>? %char>? ##sys#check-char)
     255(define-extended-arity-comparator char<? %char<? ##sys#check-char)
     256(define-extended-arity-comparator char<=? %char<=? ##sys#check-char)
     257(define-extended-arity-comparator char>=? %char>=? ##sys#check-char)
     258
     259;;;
     260;;; 6.7 Strings
     261;;;
     262
     263(: string=? (string string #!rest string -> boolean))
     264(: string<? (string string #!rest string -> boolean))
     265(: string>? (string string #!rest string -> boolean))
     266(: string<=? (string string #!rest string -> boolean))
     267(: string>=? (string string #!rest string -> boolean))
     268
     269(define-extended-arity-comparator string=? %string=? ##sys#check-string)
     270(define-extended-arity-comparator string<? %string<? ##sys#check-string)
     271(define-extended-arity-comparator string>? %string>? ##sys#check-string)
     272(define-extended-arity-comparator string<=? %string<=? ##sys#check-string)
     273(define-extended-arity-comparator string>=? %string>=? ##sys#check-string)
     274
     275;;;
    225276;;; 6.11. Exceptions
    226277;;;
  • release/4/r7rs/trunk/tests/run.scm

    r29599 r29954  
    299299   (test '((3 8 2 8)) (list b))
    300300   (test '((1 8 2 8)) (list a))))
     301
     302(test-group "6.6: characters"
     303  (test-group "char*?"
     304    (test-error "arity" (char=? #\a))
     305    (test-error "type check" (char=? #\a #\a 1))
     306    (test-error "no shortcutting" (char=? #\a #\b 1))
     307    (test #t (char=? #\a #\a))
     308    (test #f (char=? #\a #\b))
     309    (test #t (char=? #\a #\a #\a))
     310    (test #f (char=? #\a #\b #\a))
     311    (test #f (char=? #\a #\a #\b))
     312    (test #t (char=? #\a #\a #\a #\a))
     313    (test #f (char=? #\a #\b #\a #\a))
     314    (test #f (char=? #\a #\a #\a #\b))
     315    (test #t (char<? #\a #\b #\c))
     316    (test #f (char<? #\a #\b #\b))
     317    (test #t (char<=? #\a #\b #\b))
     318    (test #f (char<=? #\a #\b #\a))
     319    (test #t (char>? #\c #\b #\a))
     320    (test #f (char>? #\a #\a #\a))
     321    (test #t (char>=? #\b #\b #\a))
     322    (test #f (char>=? #\b #\a #\b))))
     323
     324(test-group "6.7: strings"
     325  (test-group "string*?"
     326    (test-error "arity" (string=? "a"))
     327    (test-error "type check" (string=? "a" "a" 1))
     328    (test-error "no shortcutting" (string=? "a" "b" 1))
     329    (test #t (string=? "a" "a"))
     330    (test #f (string=? "a" "b"))
     331    (test #t (string=? "a" "a" "a"))
     332    (test #f (string=? "a" "b" "a"))
     333    (test #f (string=? "a" "a" "b"))
     334    (test #t (string=? "a" "a" "a" "a"))
     335    (test #f (string=? "a" "b" "a" "a"))
     336    (test #f (string=? "a" "a" "a" "b"))
     337    (test #t (string<? "a" "b" "c"))
     338    (test #f (string<? "a" "b" "b"))
     339    (test #t (string<=? "a" "b" "b"))
     340    (test #f (string<=? "a" "b" "a"))
     341    (test #t (string>? "c" "b" "a"))
     342    (test #f (string>? "c" "b" "b"))
     343    (test #t (string>=? "b" "b" "a"))
     344    (test #f (string>=? "b" "a" "b"))))
    301345
    302346(define-syntax catch
Note: See TracChangeset for help on using the changeset viewer.