// A few functions which will give the Unicode character category of a codepoint.
//
// This is therefore an ultra cut-down ICU. Boom-boom...
//
// The character classes are taken from the data in
// misc/unicode/ucd/, which is part of the ‘Unicode
// Character Database’ at and
// . This file is
// documented in
//
// This file is part of Beastie
// SPDX-FileCopyrightText: 2025 Norman Gray
// SPDX-License-Identifier: BSD-2-Clause
#define HAVE_ICU 0
// headers for this module
#include "uniprops.h"
#include
#include
#include
#define MYCU_OTHER 0
#define MYCU_UPPERCASE_LETTER 1
#define MYCU_LOWERCASE_LETTER 2
#define MYCU_OTHER_LETTER 3
#define MYCU_NUMBER 4
#define MYCU_MARK 5
#define MYCU_PUNCTUATION 6
#define MYCU_SYMBOL 7
#define MYCU_SEPARATOR 8
#define MYCU_MAX 0x10000
static const uint8_t mycu_characters[];
int mycu_is_icu_p(void)
{
return 0; // this is not ICU
}
int mycu_letter_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else {
return (mycu_characters[cp] == MYCU_UPPERCASE_LETTER
|| mycu_characters[cp] == MYCU_LOWERCASE_LETTER
|| mycu_characters[cp] == MYCU_OTHER_LETTER);
}
}
int mycu_uppercase_letter_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else {
return mycu_characters[cp] == MYCU_UPPERCASE_LETTER;
}
}
int mycu_lowercase_letter_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else {
return mycu_characters[cp] == MYCU_LOWERCASE_LETTER;
}
}
// int mycu_other_letter_p(const codepoint_t cp)
// {
// if (cp >= MYCU_MAX) {
// return 0;
// } else {
// return mycu_characters[cp] == MYCU_OTHER_LETTER;
// }
// }
int mycu_number_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else {
return mycu_characters[cp] == MYCU_NUMBER;
}
}
int mycu_alnum_p(const codepoint_t cp)
{
return mycu_letter_p(cp) || mycu_number_p(cp);
}
// This is implemented using PropList.txt, as below
// int mycu_space_p(const codepoint_t cp)
// {
// if (cp >= MYCU_MAX) {
// return 0;
// } else if (cp < 0x20) {
// // Unicode regards all of the codepoints below U+0020 as class
// // 'Cc' (‘a C0 or C1 control code’).
// // As an exception, deem characters in this range to be spaces
// // if isspace(cp) is true.
// return isspace(cp);
// } else {
// return mycu_characters[cp] == MYCU_SEPARATOR;
// }
// }
int mycu_punctuation_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else if (cp < 0x20) {
return ispunct(cp);
} else {
return mycu_characters[cp] == MYCU_PUNCTUATION;
}
}
int mycu_cntrl_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else if (cp < 0x20) {
return iscntrl(cp);
} else {
return mycu_characters[cp] == MYCU_OTHER;
}
}
int mycu_symbol_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else {
return mycu_characters[cp] == MYCU_SYMBOL;
}
}
int mycu_mark_p(const codepoint_t cp)
{
if (cp >= MYCU_MAX) {
return 0;
} else {
return mycu_characters[cp] == MYCU_MARK;
}
}
// case-mapping
struct casemap_s {
codepoint_t from;
codepoint_t to;
};
typedef const struct casemap_s* casemap_t;
static const struct casemap_s mycu_uppercase_character_map[];
static const size_t mycu_uppercase_character_map_len;
static const struct casemap_s mycu_lowercase_character_map[];
static const size_t mycu_lowercase_character_map_len;
static const struct casemap_s mycu_titlecase_character_map[];
static const size_t mycu_titlecase_character_map_len;
static int compare_casemap(const void* p_key, const void* p_member)
{
codepoint_t key = *(codepoint_t*)p_key;
casemap_t member = (casemap_t)p_member;
return key - member->from;
}
// A potential optimisation here would be to start the search in the
// middle of the Latin characters, since that's very likely where most
// of the lookups will be. More straightforward, however, is to
// simply use the ctype functions for those characters.
static int do_casefolding(const codepoint_t cp,
casemap_t map,
size_t maplen)
{
casemap_t res = bsearch(&cp, map, maplen,
sizeof(struct casemap_s), &compare_casemap);
if (res) {
return res->to;
} else {
return 0;
}
}
// each of these functions returns the original character if there is no corresponding mapping
codepoint_t mycu_uppercase_character(const codepoint_t cp)
{
if (cp < 0x80) {
return (islower(cp) ? toupper(cp) : cp);
} else {
codepoint_t new_cp = do_casefolding(cp, mycu_uppercase_character_map, mycu_uppercase_character_map_len);
return (new_cp ? new_cp : cp);
}
}
codepoint_t mycu_lowercase_character(const codepoint_t cp)
{
if (cp < 0x80) {
return (isupper(cp) ? tolower(cp) : cp);
} else {
codepoint_t new_cp = do_casefolding(cp, mycu_lowercase_character_map, mycu_lowercase_character_map_len);
return (new_cp ? new_cp : cp);
}
}
codepoint_t mycu_titlecase_character(const codepoint_t cp)
{
if (cp < 0x80) {
return (islower(cp) ? toupper(cp) : cp);
} else {
codepoint_t new_cp = do_casefolding(cp, mycu_titlecase_character_map, mycu_titlecase_character_map_len);
return (new_cp ? new_cp : cp);
}
}
struct range_s {
codepoint_t start; // start of range of mapped characters
codepoint_t end; // end of range, inclusive (=start when there is only one codepoint in the range)
};
static const uint8_t mycu_characters[MYCU_MAX] = {
#(let ((line-splitter (regexp "^([0-9A-F]+);(<[^,]+, *([^>]+)>|[^;]*);([^;]+)"))
(code-other 0) ;Cc | Cf | Cs | Co | Cn |
;Nl | No
(code-uppercase-letter 1) ;Lu | Lt
(code-lowercase-letter 2) ;Ll
(code-other-letter 3) ;Lm | Lo
(code-number 4) ;Nd
(code-mark 5) ;Mn | Mc | Me
(code-punctuation 6) ;Pc | Pd | Ps | Pe | Pi | Pf | Po
(code-symbol 7) ;Sm | Sc | Sk | So
(code-separator 8)) ;Zs | Zl | Zp
;; The format of the UnicodeData.dat file is a sequence of lines,
;; one per character, of which the basic form is (section
;; references are to https://www.unicode.org/reports/tr44/)
;;
;; field0;field1;field2;...
;;
;; or (4.2.3)
;;
;; field0;;field2;...
;; field0;;field2;...
;;
;; The relevant fields are (Table 9)
;;
;; 0: codepoint number, in hex
;; 1: name
;; 2: general category (5.7.1)
;; ...
;; 12: simple uppercase mapping
;; 13: simple lowercase mapping
;; 14: simple titlecase mapping (if null, then equal to
;; simple_uppercase_mapping)
;;
;; If field1 is of the form "" or "", then
;;
;; ‘For backward compatibility, ranges in the file UnicodeData.txt
;; are specified by entries for the start and end characters of the
;; range, rather than by the form "X..Y". The start character is
;; indicated by a range identifier, followed by a comma and the
;; string "First", in angle brackets. This entry takes the place of
;; a regular character name in field 1 for that line. The end
;; character is indicated on the next line with the same range
;; identifier, followed by a comma and the string "Last", in angle
;; brackets
(define category-lookup
(let ((ht (hash-table
"Cc" code-other
"Cf" code-other
"Cs" code-other
"Co" code-other
"Cn" code-other
"Lu" code-uppercase-letter
"Ll" code-lowercase-letter
"Lt" code-uppercase-letter ;??
"Lm" code-other-letter
"Lo" code-other-letter
"Nd" code-number
"Nl" code-other ;code-number
"No" code-other ;code-number
"Mn" code-mark
"Mc" code-mark
"Me" code-mark
"Pc" code-punctuation
"Pd" code-punctuation
"Ps" code-punctuation
"Pe" code-punctuation
"Pi" code-punctuation
"Pf" code-punctuation
"Po" code-punctuation
"Sm" code-symbol
"Sc" code-symbol
"Sk" code-symbol
"So" code-symbol
"Zs" code-separator
"Zl" code-separator
"Zp" code-separator)))
(lambda (k)
(or (ht k)
(error "Unexpected category string: ~s~%" k)))))
;(define sc (regexp ";"))
(define range-edge (regexp "<[^,]+, *([^>]+)"))
(define (printf fmt . rest)
(apply format `(#t ,fmt . ,rest)))
(define (eprintf fmt . rest)
(apply format `(,(current-error-port) ,fmt . ,rest)))
;; the following aren't defined in beastie0
(define (regexp-match re s)
(regexp-match** re s 0 2))
(define (string-split s)
(let ((slen (string-length s)))
(let loop ((i 0)
(start 0)
(res '()))
(cond ((= i slen)
(reverse (cons (substring s start i) res)))
((char=? (string-ref s i) #\;)
(loop (+ i 1)
(+ i 1)
(cons (substring s start i) res)))
(else
(loop (+ i 1)
start
res))))))
(define (get-line-data port)
;; read a line from the port, and pass back
;; (list codepoint/integer description class/number
;; lowercase-mapping/integer
;; uppercase-mapping/integer
;; titlecase-mapping/integer)
(define (to-int s)
(if (string=? s "")
#f
(string->number s 16)))
(let ((l (read-line port)))
(cond ((eof-object? l) l)
((or (= (string-length l) 0)
(char=? (string-ref l 0) #\#))
(get-line-data port))
(else
(let ((cols (list->vector (string-split l))))
;;(eprintf "l ~s~% -> cols ~s~% length ~s~%" l cols (vector-length cols))
(list (to-int (vector-ref cols 0))
(vector-ref cols 1) ; desc
(category-lookup (vector-ref cols 2)) ;class
(to-int (vector-ref cols 12))
(to-int (vector-ref cols 13))
(to-int (vector-ref cols 14))))))))
(define (finish-up to-uppercase to-lowercase to-titlecase)
(define (print-case-mapping dir m)
(printf "~%static const struct casemap_s mycu_~acase_character_map[] = {~%" dir)
(for-each (lambda (m2)
(printf " { 0x~x, 0x~x },~%" (car m2) (cdr m2)))
m)
(printf "};~%const static size_t mycu_~acase_character_map_len = ~a;~%" dir (length m)))
(printf "};~%")
(print-case-mapping "upper" (reverse to-uppercase))
(print-case-mapping "lower" (reverse to-lowercase))
(print-case-mapping "title" (reverse to-titlecase))
"//done")
(call-with-input-file "misc/unicode/ucd/UnicodeData.txt"
(lambda (infile)
(let loop ((i 0) ;line in input file
(curline #f) ;the broken-apart line we're working on
(col 0) ;the output column
(range-of-class #f) ;if non-#f, we're working inside a range
(to-lowercase '())
(to-uppercase '())
(to-titlecase '()))
(let ((line-data (or curline (get-line-data infile))))
(cond ((eof-object? line-data)
(finish-up to-uppercase to-lowercase to-titlecase))
((= col 0)
(printf " // ~x: ~s~%" i (cadr line-data))
;(printf " // ~x~%" i)
(loop i line-data 16 range-of-class
to-lowercase to-uppercase to-titlecase))
(else
(let ((cp (car line-data))
(desc (cadr line-data))
(class (caddr line-data))
(to-upper (list-ref line-data 3))
(to-lower (list-ref line-data 4))
(to-title (list-ref line-data 5)))
;; highlight characters where the to-upper and the to-title
;; aren't the same
;; (when (not (eqv? to-upper to-title))
;; (eprintf "cp ~x ~s: upper=~x title=~x~%" cp desc
;; (or to-upper 0)
;; (or to-title 0)))
(let ((next-to-lower (if to-lower
(cons (cons cp to-lower) to-lowercase)
to-lowercase))
(next-to-upper (if to-upper
(cons (cons cp to-upper) to-uppercase)
to-uppercase))
(next-to-title (cond (to-title `((,cp . ,to-title) . ,to-titlecase))
(to-upper `((,cp . ,to-upper) . ,to-titlecase))
(else to-titlecase))))
(cond ((>= cp #x10000)
(finish-up to-uppercase to-lowercase to-titlecase))
(range-of-class ;in a range
(printf " ~a," range-of-class)
(if (= i cp)
(loop (+ i 1)
#f
(- col 1)
#f
next-to-lower next-to-upper next-to-title)
(loop (+ i 1)
line-data
(- col 1)
range-of-class
next-to-lower next-to-upper next-to-title)))
((regexp-match range-edge desc)
=> (lambda (m) ;the start of a range
;; highlight the start of a range
;(eprintf "range m: cp=~s ~s~%" cp m)
(if (string=? (cadr m) "First")
(let ((next-line (get-line-data infile)))
;; the _next_ line should be the "Last" line
(let* ((desc (cadr next-line))
(m (regexp-match range-edge desc)))
(cond ((not m)
(error "unexpected (non) range end line: ~a~%"
next-line))
((string=? (cadr m) "Last")
(printf " ~a," class)
(loop (+ i 1)
next-line
(- col 1)
class
next-to-lower next-to-upper next-to-title))
(else
(error "unexpected end-of-range line: ~a~%"
next-line)))))
(error "unexpected (should-be-) range start line: ~s" next-line))))
((< i cp)
;; gap in code points
(printf " 0,")
(loop (+ i 1)
line-data
(- col 1)
#f
to-lowercase to-uppercase to-titlecase))
((= i cp)
;; ordinary line
(printf " ~a," class)
(loop (+ i 1)
#f
(- col 1)
#f
next-to-lower next-to-upper next-to-title))
(else
(error "unexpected line: ~s~%" line-data)))))))))))
;; Generate the lookup tables for certain properties.
;; We extract only the properties we need for one purpose or another.
;;
;; The files PropList.txt and DerivedCoreProperties.txt are
;; structured as a collection of blocks like
;;
;; 0009..000D ; White_Space # Cc [5] ..
;; 0020 ; White_Space # Zs SPACE
;; ...
;;
;; We have a list of possible regexps, which match the
;; "White_Space" (etc) string, and build a C table based on these.
;; The regexps in the argument to digest-proptable, below, MUST be
;; in the same order as the blocks appear in the input file.
(define (make-regexp str)
(regexp (string-append "^([0-9A-F]+)(\\.\\.([0-9A-F]+))?[ ;]*" str)))
(define blank-line (regexp "^ *$"))
(define (hexstring s)
(string->number s 16))
(define (digest-proptable expected-regexps)
(let scan-block ((relist expected-regexps))
(if (null? relist)
#f ;all done
(let ((label (caar relist))
(re (cdar relist)))
(printf "~%static const struct range_s mycu_~a_map[] = {~%" label)
(let scan-props ((l (read-line))
(found? #f)
(nentries 0) ;entries in table
(cpcount 0)) ;representing this many codepoints (for checking)
(cond ((eof-object? l)
(eprintf "unexpected end of input while scanning regexps ~s~%" regexps))
((regexp-match re l)
=> (lambda (m)
(let* ((start (hexstring (cadr m)))
(end (cond ((cadddr m) => hexstring)
(else start))))
(if (>= start #x10000)
(begin ;beyond BMP
(printf #""" { 0x10000, 0 }
};
const static size_t mycu_~a_map_len = ~a;
// total code points: ~a
"""
label
nentries
cpcount)
(scan-block (cdr relist)))
(begin
(printf " { 0x~x, 0x~x },~%" start end)
(scan-props (read-line)
#t
(+ nentries 1)
(+ cpcount (- end start) 1)))))))
((not found?)
;; still searching for the start of the block which matches the regexp
(scan-props (read-line) #f nentries cpcount))
((regexp-match blank-line l)
;; completed one block
(printf #""" { 0x10000, 0 }
};
const static size_t mycu_~a_map_len = ~a;
// total code points: ~a
"""
label
nentries
cpcount)
(scan-block (cdr relist)))
(else
;; We _oughtn't_ to get here, given the structure of the file
(eprintf "shouldn't get here!~%")
#f)))))))
(with-input-from-file "misc/unicode/ucd/PropList.txt"
(lambda ()
(digest-proptable
`(("whitespace" . ,(make-regexp "White_Space"))
("joincontrol" . ,(make-regexp "Join_Control"))
("diacritic" . ,(make-regexp "Diacritic"))
("extender" . ,(make-regexp "Extender"))))))
;; now generate the lookup table for alphabetic characters
(with-input-from-file "misc/unicode/ucd/DerivedCoreProperties.txt"
(lambda ()
(digest-proptable
`(("alphabetic" . ,(make-regexp "Alphabetic")))))))
// test whether a character is in a map or not
static int mycu_char_in_map_p(const struct range_s* map, const size_t maplen, const codepoint_t cp)
{
// deem everything outside the BMP to be non-everything
if (cp >= 0x10000) {
return 0;
}
size_t lo = 0;
size_t hi = maplen; // points at the 0x10000 entry
int range = -1;
// search for the index [range] in the array where cp >= array[range].start and cp < array[range+1].start
while (range < 0) {
size_t mid = (lo + hi)/2;
if (hi == lo) {
range = hi;
} else if (cp < map[mid].start) {
hi = mid;
} else if (cp >= map[mid+1].start) {
lo = mid;
} else {
range = mid;
}
}
return (cp >= map[range].start && cp <= map[range].end);
}
// From PropList.txt:
//
// 0009..000D ; White_Space # Cc [5] ..
// 0020 ; White_Space # Zs SPACE
// 0085 ; White_Space # Cc
// 00A0 ; White_Space # Zs NO-BREAK SPACE
// 1680 ; White_Space # Zs OGHAM SPACE MARK
// 2000..200A ; White_Space # Zs [11] EN QUAD..HAIR SPACE
// 2028 ; White_Space # Zl LINE SEPARATOR
// 2029 ; White_Space # Zp PARAGRAPH SEPARATOR
// 202F ; White_Space # Zs NARROW NO-BREAK SPACE
// 205F ; White_Space # Zs MEDIUM MATHEMATICAL SPACE
// 3000 ; White_Space # Zs IDEOGRAPHIC SPACE
//
// That is, this is the list of characters which are class Z, plus the
// five characters which POSIX says are included in isspace(3)
int mycu_space_p(const codepoint_t cp)
{
if (cp < 0x80) {
// fast path -- use isspace (which matches the map, anyway)
return isspace(cp);
} else {
return mycu_char_in_map_p(mycu_whitespace_map, mycu_whitespace_map_len, cp);
}
}
// whitespace_p matches the Unicode u_isWhitespace function,
// which is the one which (a) matches ‘Java whitespace characters’,
// and (b) does not include non-breaking spaces
// (U+00A0 NBSP, U+2007 Figure Space, U+202F Narrow NBSP).
//
// The codepoint U+FEFF ZERO WIDTH NO-BREAK SPACE is not included in this set.
//
// See https://unicode-org.github.io/icu-docs/apidoc/dev/icu4c/uchar_8h.html
int mycu_whitespace_p(const codepoint_t cp)
{
switch (cp) {
// non-breaking space characters
case 0x00a0:
case 0x2007:
case 0x202f:
return 0;
// four ASCII controls where isspace() gives the contrary answer
case 0x001c:
case 0x001d:
case 0x001e:
case 0x001f:
return 1;
default:
if (cp < 0x80) {
// fast path -- use isspace (which matches the map, anyway)
return isspace(cp);
} else {
return mycu_char_in_map_p(mycu_whitespace_map, mycu_whitespace_map_len, cp);
}
}
}
int mycu_nonbreakingspace_p(const codepoint_t cp)
{
return (cp == 0x00a0 || cp == 0x2007 || cp == 0x202f);
}
int mycu_joincontrol_p(const codepoint_t cp)
{
if (cp < 0x80) {
return 0;
} else {
return mycu_char_in_map_p(mycu_joincontrol_map, mycu_joincontrol_map_len, cp);
}
}
int mycu_diacritic_p(const codepoint_t cp)
{
if (cp < 0x80) {
// fast path
return (cp == 0x5e || cp == 0x60);
} else {
return mycu_char_in_map_p(mycu_diacritic_map, mycu_diacritic_map_len, cp);
}
}
int mycu_extender_p(const codepoint_t cp)
{
if (cp < 0x80) {
return 0;
} else {
return mycu_char_in_map_p(mycu_extender_map, mycu_extender_map_len, cp);
}
}
int mycu_alphabetic_p(const codepoint_t cp)
{
if (cp < 0x80) {
return isalpha(cp);
} else {
return mycu_char_in_map_p(mycu_alphabetic_map, mycu_alphabetic_map_len, cp);
}
}
// Test whether a character should be regarded as being included in a word.
// This is almost the same as mycu_alphabetic_p, but includes
// diacritics, extenders and join-control characters.
// See the Unicode mailing list discussion which includes
// https://www.unicode.org/mail-arch/unicode-ml/y2018-m05/0117.html
int mycu_wordcharacter_p(const codepoint_t cp)
{
// fast path
if (cp < 0x80) {
return mycu_alphabetic_p(cp);
} else {
return mycu_alphabetic_p(cp)
|| mycu_diacritic_p(cp)
|| mycu_extender_p(cp)
|| mycu_joincontrol_p(cp);
}
}