#!/usr/bin/perl
my $copyright = <<'END';
// Copyright (C) 2026 Olly Betts
//
// 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.
//
// You should have received a copy of the GNU General Public License
// along with this program; if not, see
// <https://www.gnu.org/licenses/>.
END

use strict;
use warnings;

my $DEBUG_OVERLAP = 0;

if (@ARGV != 3) {
    die "Syntax: $0 UNICODEDATA_FILE UNICODE_VERSION OUTPUT_FILE\n";
}

# We split the codepoint space into a series of equal-sized pages (with that
# size being a power of two).
#
# For each page, we look at the categories and deltas to lower and to upper
# case and perform a multi-level lookup which allows us to store the required
# data in much less space than encoding it as a flat array would allow.
#
# This is the power of two to use as the size:
my $page_size_bits = 8;

# Overlap the page data in page_map[] to reduce encoded size.  This will also
# tend to reduce cache pressure and so tend to be faster.
my $overlap = 1; # FIXME Not currently fully hooked up when false.

# Encode pages which are all the same category (and have no case deltas)
# as special values so we don't need to store page data for them.  The size
# saving from this is reduced by overlapping pages.  It requires 30 special
# values for use in pages[] which can make the difference between being able
# to use unsigned char instead of short there (e.g. it does for Unicode 17.0.0
# with $page_size_bits==8).
my $special_case_all_same = 0;

my ($unicodedata_file, $unicode_version, $output_file) = @ARGV;
my $page_size = 1 << $page_size_bits;

my %category_name = qw(
    Cn UNASSIGNED
    Lu UPPERCASE_LETTER
    Ll LOWERCASE_LETTER
    Lt TITLECASE_LETTER
    Lm MODIFIER_LETTER
    Lo OTHER_LETTER
    Mn NON_SPACING_MARK
    Me ENCLOSING_MARK
    Mc COMBINING_SPACING_MARK
    Nd DECIMAL_DIGIT_NUMBER
    Nl LETTER_NUMBER
    No OTHER_NUMBER
    Zs SPACE_SEPARATOR
    Zl LINE_SEPARATOR
    Zp PARAGRAPH_SEPARATOR
    Cc CONTROL
    Cf FORMAT
    Co PRIVATE_USE
    Cs SURROGATE
    Pc CONNECTOR_PUNCTUATION
    Pd DASH_PUNCTUATION
    Ps OPEN_PUNCTUATION
    Pe CLOSE_PUNCTUATION
    Pi INITIAL_QUOTE_PUNCTUATION
    Pf FINAL_QUOTE_PUNCTUATION
    Po OTHER_PUNCTUATION
    Sm MATH_SYMBOL
    Sc CURRENCY_SYMBOL
    Sk MODIFIER_SYMBOL
    So OTHER_SYMBOL
);

my $UNASSIGNED = 'Cn;0;0';
my @data;
open my $in, '<', $unicodedata_file or die $!;
while (<$in>) {
    my @f = split ';';
    my $codepoint = hex($f[0]);
    my $category = $f[2];
    exists $category_name{$category}
        or die "Unknown category '$category' for U+$f[0]\n";
    my $upper_delta = $f[12] ne '' ? hex($f[12]) - $codepoint : 0;
    my $lower_delta = $f[13] ne '' ? hex($f[13]) - $codepoint : 0;
    $codepoint >= scalar @data
        or die "Unicode data not in ascending order\n";
    my $e = "$category;$upper_delta;$lower_delta";
    if ($f[1] =~ /, Last>$/) {
        $data[-1] eq $e or die "Last data for U+$f[0] differs from First\n";
        for my $i (scalar(@data) .. $codepoint) {
           $data[$i] = $e;
        }
    } else {
        for my $i (scalar(@data) .. $codepoint - 1) {
           $data[$i] = $UNASSIGNED;
        }
        $data[$codepoint] = $e;
    }
}
close $in or die $!;

# At runtime, we first test if the codepoint is greater than
# $highest_assigned_codepoint and return UNASSIGNED if it is, so the values at
# the end of the final page won't be used.  We pad with copies of
# highest_assigned_codepoint's data to allow it to be encoded as a page which
# is all the same.
my $highest_assigned_codepoint = $#data;
for ((($highest_assigned_codepoint) & ($page_size - 1)) + 1 .. $page_size - 1) {
    push @data, $data[-1];
}
(scalar(@data) & ($page_size - 1)) == 0 or die "Padding final page failed\n";

open my $out, '>', $output_file or die $!;

print $out <<"END";
// Data tables for Unicode $unicode_version - generated by $0

$copyright
#include <config.h>

#include <xapian/unicode.h>

static constexpr unsigned PAGE_SIZE_BITS = $page_size_bits;

END

my @page;

my @uses;
my @page_map;
my %page_data;
my $p = 0;
my $n = 0;
my %char_info;
my @char_info;
for (my $b = 0; $b < scalar @data; $b += $page_size) {
    my $d = join("\t", @data[$b .. ($b + $page_size - 1)]);
    my $times = $page_size - 1;
    if ($special_case_all_same &&
        $d =~ /^(([A-Z][a-z]);0;0)(?:\t\1){$times}$/) {
        # All codepoints in the page have the same category and no case deltas.
        push @page, "${2}_";
    } else {
        for (@data[$b .. ($b + $page_size - 1)]) {
            if (!exists $char_info{$_}) {
                push @char_info, $_;
                $char_info{$_} = $n++;
            }
        }
        if (exists $page_data{$d}) {
            push @page, $page_data{$d};
            ++$uses[$page_data{$d}];
        } else {
            push @page, $p;
            ++$uses[$p];
            push @page_map, $d;
            $page_data{$d} = $p++;
        }
    }
}
print "page[] has ", scalar(@page), " entries ($p unique)\n";

my $page_type = 'unsigned char';
my $encode_all_same = undef;
if ($special_case_all_same) {
    # Encode as 0xe0-0xfd.
    $encode_all_same = '0xe0 | ';
}
my $page_type_width = 1;
if ($p >= 0xe0) {
    warn "$p unique page[] entries, too many to fit in a byte\n";
}
if ($p >= 0xe0 || $overlap) {
    if ($special_case_all_same) {
        $page_type = 'short';
        # Encode as negative values.
        $encode_all_same = '~';
    } else {
        $page_type = 'unsigned short';
        $encode_all_same = undef;
    }
    $page_type_width = 2;
}

for (sort keys %category_name) {
    my $name = $category_name{$_};
    print $out "static constexpr int $_ = Xapian::Unicode::$name;\n";
}
print $out "\n";

if (defined $encode_all_same) {
    # Many pages are comprised entirely of codepoints from a single category
    # with no upper or lower case version, and we can easily avoid storing a
    # page table for such pages.  In Unicode 17.0.0, this covers 4195 out of
    # 4352 pages (which all have one of Cn, Co, Cs, Lo, Sm, So as their
    # category) leaving 156 pages which we actually need to store.
    for (sort keys %category_name) {
        print $out "static constexpr $page_type ${_}_ = $encode_all_same$_;\n";
    }
    print $out "\n";
}

for (qw(TOLOWER TOUPPER)) {
    print $out "static constexpr auto $_ = ",
               "Xapian::Unicode::Internal::INFO_${_}_MASK;\n";
}
print $out "\n";

# Use `* 256` instead of `<< 8` to avoid `-Wshift-negative-value` when D is
# negative (GCC warning active in C++11 to C++17 modes).
print $out "#define U(C,D) C | TOUPPER | (D * 256)\n";
print $out "#define L(C,D) C | TOLOWER | (D * 256)\n";
print $out "#define B(C,D) C | TOUPPER | TOLOWER | (D * 256)\n";
print $out "\n";

my $min_delta = 0;
my $max_delta = 0;
print $out "static const int char_info[] = {\n";
for my $d (@char_info) {
    my ($category, $upper_delta, $lower_delta) = split ';', $d;
    if ($upper_delta == 0 && $lower_delta == 0) {
        print $out "    $category";
    } elsif ($lower_delta == 0) {
        print $out "    U($category, ", -$upper_delta, ")";
        -$upper_delta > $max_delta and $max_delta = -$upper_delta;
        -$upper_delta < $min_delta and $min_delta = -$upper_delta;
    } elsif ($upper_delta == 0) {
        print $out "    L($category, $lower_delta)";
        $lower_delta > $max_delta and $max_delta = $lower_delta;
        $lower_delta < $min_delta and $min_delta = $lower_delta;
    } else {
        ($upper_delta + $lower_delta == 0)
            or die "upper_delta/lower_delta combination not handled\n";
        print $out "    B($category, $lower_delta)";
        $lower_delta > $max_delta and $max_delta = $lower_delta;
        $lower_delta < $min_delta and $min_delta = $lower_delta;
    }
    print $out ",\n";
}
print $out "};\n\n";
print "char_info has ", scalar(@char_info), " entries\n";

my $delta_range = $max_delta - $min_delta;
print "$min_delta <= delta <= $max_delta (range $delta_range)\n";

$min_delta >= -(1<<23) or die "min delta won't fit in 24-bit signed int\n";
$max_delta < (1<<23) or die "max delta won't fit in 24-bit signed int\n";

for (my $z = scalar(@page_map) - 1; $z >= 0; --$z) {
    my $new = '';
    for my $d (split("\t", $page_map[$z])) {
        exists $char_info{$d} or die "No %char_info entry for '$d'\n";
        $new .= chr($char_info{$d});
    }
    (length($new) == $page_size) or
        die "Page $z not expected size (".length($new)." != $page_size)\n";
    $page_map[$z] = $new;
}

my $merged = '';
my %is_start;
my @to_start;
if (0) {
    # Put the ASCII block first.
    $merged = $page_map[0];
    $page_map[0] = undef;
    $to_start[0] = 0;
    $is_start{0} = 0;
}
my $q = 0;
my $N = scalar @page_map;
next_page: {
    my $mlen = length($merged);
    my $c = $mlen - $page_size;

    # We already deduplicated pages, and we use a greedy algorithm so it
    # shouldn't be possible to have a complete overlap.  If we didn't
    # always pick one of the remaining pages with the largest overlap then this
    # code might be useful.
    if (0) {
        # First check for any pages which now have a complete overlap.  Note
        # that the order we check for these in doesn't make a difference.
        complete_overlap: for (my $z = 0; $z < $N; ++$z) {
            my $new = $page_map[$z];
            defined $new or next;
            # We only need to check for overlaps which include at least some of
            # the last $msize bytes since overlaps before that would already
            # have been found on previous passes.
            my $J = $c - $page_size + 1;
            for (my $j = ($J < 0 ? 0 : $J); $j <= $c; ++$j) {
                if (substr($merged, $j, $page_size) eq $new) {
                    print "entirely a substring \@", $j - $mlen, "\n"
                        if $DEBUG_OVERLAP;
                    $to_start[$z] = $j;
                    $is_start{$j} = $z;
                    $page_map[$z] = undef;
                    next complete_overlap;
                }
            }
        }
    }

    # Check for partial overlaps at the end of $merged.
    #
    # We use a greedy algorithm which picks the longest overlap at each stage
    # (if there are multiple longest, we currently pick the last just because
    # that gives a smaller output).  If we find a partial overlap, we update
    # $merged and restart because the end of $merged will have changed so there
    # might now be a longer overlap.
    for (my $j = $c + 1; $j < $mlen; ++$j) {
        # At least for Unicode 17, empirically we get a slightly smaller result
        # which is slightly faster at runtime if we run this $z loop backwards
        # and the one below forwards.
        for (my $z = $N - 1; $z >= 0; --$z) {
        #for (my $z = 0; $z < $N; ++$z) {
            my $new = $page_map[$z];
            defined $new or next;
            my $o = $mlen - $j;
            if (substr($merged, $j, $o) eq substr($new, 0, $o)) {
                print "overlap of $o bytes\n" if $DEBUG_OVERLAP;
                $merged .= substr($new, $o);
                $to_start[$z] = length($merged) - $page_size;
                $is_start{length($merged) - $page_size} = $z;
                $page_map[$z] = undef;
                goto next_page;
            }
        }
    }

    # No remaining blocks overlap.  Pick a block to just append, or exit if
    # we've dealt with all the blocks.
    #for (my $z = $N - 1; $z >= 0; --$z) {
    for (my $z = 0; $z < $N; ++$z) {
        my $new = $page_map[$z];
        defined $new or next;
        print "no overlap\n" if $DEBUG_OVERLAP;
        $to_start[$z] = length($merged);
        $is_start{length($merged)} = $z;
        $merged .= $new;
        $page_map[$z] = undef;
        goto next_page;
    }
    # Done!
}
print "merged size ", length($merged), " / ", $page_size * scalar(@page_map);
print " (", 100*length($merged) / ($page_size * scalar(@page_map)), "%)\n";

my $g = scalar %char_info;
print "page_map has ", scalar(@page_map), " * $page_size entries ($g unique)\n";
$g < 256 or die "$g unique page_map entries, too many to fit in a byte\n";

print "total table size = ",
    "$page_type_width * ", scalar(@page), " + ",
    length($merged), " + 4 * ", scalar(@char_info), " = ",
    $page_type_width * scalar(@page) +
    length($merged) + 4 * scalar(@char_info), "\n";

print $out "static const $page_type page[] = {";
my $i = 0;
for (@page) {
    if ($i++ % 8 == 0) {
        print $out "\n    ";
    } else {
        print $out " ";
    }
    print $out (/^[A-Z]/ ? $_ : $to_start[$_]), ",";
}
print $out "};\n\n";

print $out "static const unsigned char page_map[] = {";
for ($i = 0; $i < length $merged; ++$i) {
    if (exists $is_start{$i}) {
        print $out "\n" if $i > 0;
        my $q = $is_start{$i};
        my $uses = $uses[$q] // 0;
        if ($uses != 1) {
            print $out "\n    // Page $q ($uses uses)";
        } else {
            print $out "\n    // Page $q";
        }
        print $out "\n    ";
    } else {
        if ($i % 8 == 0) {
            print $out "\n    ";
        } else {
            print $out " ";
        }
    }
    print $out ord(substr($merged, $i, 1)), ",";
}
print $out "\n};\n\n";

my $threshold = sprintf("0x%x", $highest_assigned_codepoint);
print $out <<"END";
/** Get information about a Unicode codepoint.
 *
 *  The bottom 5 bits of the returned value are the category code.
 *
 *  The top 24 bits give a signed delta to apply for case changes.
 *
 *  If bit INFO_LOWER_MASK set, add delta to convert to lower case.
 *
 *  If bit INFO_UPPER_MASK set, subtract delta to convert to upper case.
 */
int
Xapian::Unicode::Internal::get_character_info(unsigned ch) noexcept
{
    if (rare(ch > $threshold)) {
        // Categorise non-Unicode values as UNASSIGNED with no case variants.
        return UNASSIGNED;
    }
    auto p = page[int(ch) >> PAGE_SIZE_BITS];
END
if (defined $encode_all_same) {
    if ($page_type eq 'short') {
        print $out <<"END";
    if (p < 0) {
        // All codepoints in this page have the same category (and no upper or
        // lower case delta).
        return ~p;
    }
END
    } else {
        print $out <<"END";
    if (p >= 0xe0) {
        // All codepoints in this page have the same category (and no upper or
        // lower case delta).
        return p & 0x1f;
    }
END
    }
}
print $out <<"END";
    return char_info[page_map[p + ((ch) & ((1 << PAGE_SIZE_BITS) - 1))]];
}
END

close $out or die $!;
