; ; Copyright © 2018 Keith Packard ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation, either version 2 of the License, or ; (at your option) any later version. ; ; This program is distributed in the hope that it will be useful, but ; WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ; General Public License for more details. ; ; Char primitives placed in ROM (define char? integer?) (_??_ (char? #\q) #t) (_??_ (char? "h") #f) (define (char-upper-case? c) (<= #\A c #\Z)) (_??_ (char-upper-case? #\a) #f) (_??_ (char-upper-case? #\B) #t) (_??_ (char-upper-case? #\0) #f) (_??_ (char-upper-case? #\space) #f) (define (char-lower-case? c) (<= #\a c #\a)) (_??_ (char-lower-case? #\a) #t) (_??_ (char-lower-case? #\B) #f) (_??_ (char-lower-case? #\0) #f) (_??_ (char-lower-case? #\space) #f) (define (char-alphabetic? c) (or (char-upper-case? c) (char-lower-case? c))) (_??_ (char-alphabetic? #\a) #t) (_??_ (char-alphabetic? #\B) #t) (_??_ (char-alphabetic? #\0) #f) (_??_ (char-alphabetic? #\space) #f) (define (char-numeric? c) (<= #\0 c #\9)) (_??_ (char-numeric? #\a) #f) (_??_ (char-numeric? #\B) #f) (_??_ (char-numeric? #\0) #t) (_??_ (char-numeric? #\space) #f) (define (char-whitespace? c) (or (<= #\tab c #\return) (= #\space c))) (_??_ (char-whitespace? #\a) #f) (_??_ (char-whitespace? #\B) #f) (_??_ (char-whitespace? #\0) #f) (_??_ (char-whitespace? #\space) #t) (define char->integer (macro (v) v)) (define integer->char char->integer) (define (char-upcase c) (if (char-lower-case? c) (+ c (- #\A #\a)) c)) (_??_ (char-upcase #\a) #\A) (_??_ (char-upcase #\B) #\B) (_??_ (char-upcase #\0) #\0) (_??_ (char-upcase #\space) #\space) (define (char-downcase c) (if (char-upper-case? c) (+ c (- #\a #\A)) c)) (_??_ (char-downcase #\a) #\a) (_??_ (char-downcase #\B) #\b) (_??_ (char-downcase #\0) #\0) (_??_ (char-downcase #\space) #\space) (define (digit-value c) (if (char-numeric? c) (- c #\0) #f) ) (_??_ (digit-value #\1) 1) (_??_ (digit-value #\a) #f)