~tim/scheme-vm

c5110102ce2df2d78a0c87f293edf20f5a3984e7 — Tim Morgan 2 years ago 11e2819
Add more char functions
2 files changed, 50 insertions(+), 13 deletions(-)

M lib/scheme/base.scm
M spec/lib/char-spec.scm
M lib/scheme/base.scm => lib/scheme/base.scm +35 -13
@@ 24,20 24,12 @@
   caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
   case
   cdr
   char?
   char=?
   char<?
   char<=?
   char>?
   char>=?
   char-ci=?
   char-ci<?
   char-ci<=?
   char-ci>?
   char-ci>=?
   char->integer
   char-downcase
   char-upcase
   char-alphabetic? char-numeric? char-whitespace?
   char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>?
   char-downcase char-upcase
   char-lower-case? char-upper-case?
   char<=? char<? char=? char>=? char>? char?
   cond
   cons
   define


@@ 537,6 529,36 @@
    (define (char-ci>=? . chars)
      (apply char>=? (map char-downcase chars)))

    (define (char-upper-case? c)
      (if (char? c)
        (let ((i (char->integer c)))
          (and (>= i 65) (<= i 90)))))

    (define (char-lower-case? c)
      (if (char? c)
        (let ((i (char->integer c)))
          (and (>= i 97) (<= i 122)))))

    (define (char-alphabetic? c)
      (if (char? c)
        (let ((i (char->integer c)))
          (or
            (and (>= i 65) (<= i 90))
            (and (>= i 97) (<= i 122))))))

    (define (char-numeric? c)
      (if (char? c)
        (let ((i (char->integer c)))
          (and (>= i 48) (<= i 57)))))

    (define (char-whitespace? c)
      (if (char? c)
        (let ((i (char->integer c)))
          (or
            (and (>= i 9) (<= i 13))
            (= i 32)
            (= i 133)))))

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

M spec/lib/char-spec.scm => spec/lib/char-spec.scm +15 -0
@@ 49,3 49,18 @@
(assert (char-ci>=? #\b #\A))
(assert (char-ci>=? #\b #\B))
(assert (not (char-ci>=? #\a #\B)))

(assert (char-alphabetic? #\a))
(assert (not (char-alphabetic? #\1)))

(assert (char-numeric? #\1))
(assert (not (char-numeric? #\a)))

(assert (char-whitespace? #\space))
(assert (not (char-whitespace? #\a)))

(assert (char-upper-case? #\A))
(assert (not (char-upper-case? #\a)))

(assert (char-lower-case? #\a))
(assert (not (char-lower-case? #\A)))