blob: c0353834a2b7fce7be11f84a5ca9022f88575133 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
;
; Copyright © 2018 Keith Packard <keithp@keithp.com>
;
; 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)
|
