~tim/scheme-vm

11e2819bb80b0c33f7be66e7f29ec0d28788ef4c — Tim Morgan 2 years ago 7b78189
Add case insensitive char comparision functions
2 files changed, 41 insertions(+), 0 deletions(-)

M lib/scheme/base.scm
M spec/lib/char-spec.scm
M lib/scheme/base.scm => lib/scheme/base.scm +22 -0
@@ 30,6 30,11 @@
   char<=?
   char>?
   char>=?
   char-ci=?
   char-ci<?
   char-ci<=?
   char-ci>?
   char-ci>=?
   char->integer
   char-downcase
   char-upcase


@@ 515,6 520,23 @@
    (define (char>=? a b)
      (or (char>? a b) (char=? a b)))

    (define map '()) ; temporary

    (define (char-ci=? . chars)
      (apply char=? (map char-downcase chars)))

    (define (char-ci<? . chars)
      (apply char<? (map char-downcase chars)))

    (define (char-ci<=? . chars)
      (apply char<=? (map char-downcase chars)))

    (define (char-ci>? . chars)
      (apply char>? (map char-downcase chars)))

    (define (char-ci>=? . chars)
      (apply char>=? (map char-downcase chars)))

    (define (equal? a b)
      (cond
       ((and (boolean? a) (boolean? b)) (eq? a b))

M spec/lib/char-spec.scm => spec/lib/char-spec.scm +19 -0
@@ 15,18 15,37 @@
(assert (char=? #\a #\a))
(assert (not (char=? #\a #\b)))

(assert (char-ci=? #\a #\A))
(assert (not (char-ci=? #\a #\b)))

(assert (char<? #\a #\b))
(assert (not (char<? #\a #\a)))
(assert (not (char<? #\b #\a)))

(assert (char-ci<? #\a #\B))
(assert (not (char-ci<? #\a #\A)))
(assert (not (char-ci<? #\b #\A)))

(assert (char<=? #\a #\b))
(assert (char<=? #\a #\a))
(assert (not (char<=? #\b #\a)))

(assert (char-ci<=? #\a #\B))
(assert (char-ci<=? #\a #\A))
(assert (not (char-ci<=? #\b #\A)))

(assert (char>? #\b #\a))
(assert (not (char>? #\b #\b)))
(assert (not (char>? #\a #\b)))

(assert (char-ci>? #\b #\A))
(assert (not (char-ci>? #\b #\B)))
(assert (not (char-ci>? #\a #\B)))

(assert (char>=? #\b #\a))
(assert (char>=? #\b #\b))
(assert (not (char>=? #\a #\b)))

(assert (char-ci>=? #\b #\A))
(assert (char-ci>=? #\b #\B))
(assert (not (char-ci>=? #\a #\B)))