// 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 <https://www.unicode.org/ucd/> and
// <https://www.unicode.org/Public/UCD/latest/>.  This file is
// documented in <https://www.unicode.org/reports/tr44/>
//
// This file is part of Beastie <https://purl.org/nxg/dist/beastie>
// SPDX-FileCopyrightText: 2025 Norman Gray <https://nxg.me.uk>
// SPDX-License-Identifier: BSD-2-Clause

#define HAVE_ICU 0
// headers for this module
#include "uniprops.h"

#include <stdint.h>
#include <stdlib.h>
#include <ctype.h>

#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;<rangename, First>;field2;...
   ;;    field0;<rangename, Last>;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 "<blah, First>" or "<blah, Last>", 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] <control-0009>..<control-000D>
   ;;    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] <control-0009>..<control-000D>
// 0020          ; White_Space # Zs       SPACE
// 0085          ; White_Space # Cc       <control-0085>
// 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);
    }
}
