—
—
—
—
—
—
—
—
—
—

              
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
package UnicodeTable;
use strict;
use IO::File;
HideShow 47 lines of Pod
=head1 NAME
UnicodeTable - Create compressed Unicode tables for C programs
=head1 SYNOPSIS
    my $table = UnicodeTable->read(
        filename => $filename,
        type     => 'Enumerated',
        map      => \%map,
    );
    my $comp = $table->compress($shift);
    $comp->dump;
=head1 DESCRIPTION
This module creates compressed tables used to lookup Unicode properties
in C programs. To compress a table, it's split into blocks of a fixed
size. Identical blocks are discovered and only unique blocks are written to
the compressed table. An additional map table is created to map original
block indices to block ids.
The map tables can then be compressed again using the same algorithm.
Powers of two are used as block sizes, so the table indices to lookup values
can be computed using bit operations.
=head1 METHODS
=head2 new
    my $table = UnicodeTable->new(
        values    => \@values,
        default   => $default,
        max       => $max,
        shift     => $shift,
        map_table => $map_table,
    );
\@values is an arrayref with the table values, $max is the maximum value.
The default value for undefined table entries is $default or 0.
$shift and $map_table are used for compressed tables.
=cut
sub new {
    my $class = shift;
    my $opts = @_ == 1 ? $_[0] : {@_};
    my $self = bless( {}, $class );
    for my $name (qw(values default max shift map_table)) {
        $self->{$name} = $opts->{$name};
    }
    $self->{default} = 0
        if !defined( $self->{default} );
    $self->{mask} = ( 1 << $self->{shift} ) - 1
        if defined( $self->{shift} );
    return $self;
}
HideShow 16 lines of Pod
=head2 read
    my $table = UnicodeTable->table(
        filename => $filename,
        type     => $type,
        map      => \%map,
        default  => $default,
    );
Reads a table from a Unicode data text file. $type is either 'Enumerated'
or 'Boolean'. \%map is a hashref that maps property values to integers.
For booleans, these integers are ORed. $default is the default value passed
to L<new>.
=cut
sub read {
    my $class = shift;
    my $opts = @_ == 1 ? $_[0] : {@_};
    my $max = 0;
    my @values;
    my $filename = $opts->{filename};
    die('filename missing') if !defined($filename);
    my $type = $opts->{type} or die('type missing');
    my $map  = $opts->{map}  or die('map missing');
    $type = lc($type);
    my $file = IO::File->new;
    $file->open( $filename, '<' )
        or die("$filename: $!\n");
    while ( my $line = $file->getline ) {
        $line =~ s/\s*(#.*)?\z//s;
        next if $line eq '';
        my ( $chars, $prop ) = split( /\s*;\s*/, $line );
        my $val = $map->{$prop};
        if ( !defined($val) ) {
            if ( $type eq 'boolean' ) {
                next;
            }
            else {
                die("unknown property '$prop'");
            }
        }
        $max = $val if $val > $max;
        if ( $chars =~ /^[0-9A-Fa-f]+\z/ ) {
            my $i = hex($chars);
            if ( $type eq 'boolean' ) {
                $values[$i] |= $val;
            }
            else {
                $values[$i] = $val;
            }
        }
        elsif ( $chars =~ /^(\w+)\.\.(\w+)\z/ ) {
            my ( $l, $r ) = ( hex($1), hex($2) );
            die("invalid range '$chars'") if $l > $r;
            for ( my $i = $l; $i <= $r; ++$i ) {
                if ( $type eq 'boolean' ) {
                    $values[$i] |= $val;
                }
                else {
                    $values[$i] = $val;
                }
            }
        }
        else {
            die("invalid range '$chars'");
        }
    }
    close($file);
    return $class->new(
        values  => \@values,
        default => $opts->{default},
        max     => $max,
    );
}
HideShow 12 lines of Pod
=head2 shift
=head2 mask
=head2 max
=head2 map_table
Accessors
=cut
sub shift {
    return $_[0]->{shift};
}
sub mask {
    return $_[0]->{mask};
}
sub max {
    return $_[0]->{max};
}
sub map_table {
    return $_[0]->{map_table};
}
HideShow 8 lines of Pod
=head2 set
    $table->set($i, $value);
Set entry at index $i to $value. Don't use with compressed tables.
=cut
sub set {
    my ( $self, $i, $value ) = @_;
    $self->{values}[$i] = $value;
    $self->{max} = $value if $value > $self->{max};
}
HideShow 8 lines of Pod
=head2 size
    my $size = $table->size;
Storage size of the table in bytes.
=cut
sub size {
    my $self = CORE::shift;
    my $max = $self->{max};
    my $bytes = $max < 0x100 ? 1 : $max < 0x10000 ? 2 : 4;
    return @{ $self->{values} } * $bytes;
}
HideShow 8 lines of Pod
=head2 lookup
    my $value = $table->lookup($i);
Lookup value at index $i. Also works with compressed tables.
=cut
sub lookup {
    my ( $self, $i ) = @_;
    my $map_table = $self->{map_table};
    if ($map_table) {
        my $shift = $self->{shift};
        my $id    = $map_table->lookup( $i >> $shift );
        my $j     = ( $id << $shift ) | ( $i & $self->{mask} );
        return $self->{values}->[$j];
    }
    else {
        my $val = $self->{values}->[$i];
        return $self->{default} if !defined($val);
        return $val;
    }
}
HideShow 9 lines of Pod
=head2 compress
    my $compressed_table = $table->compress($shift);
Returns a compressed version of this table which is linked to a second
map table. Blocks of size (1 << $shift) are used.
=cut
sub compress {
    my ( $self, $shift ) = @_;
    my $values      = $self->{values};
    my $default     = $self->{default};
    my $block_size  = 1 << $shift;
    my $block_count = 0;
    my ( @compressed, @map_values, %block_ids );
    for ( my $start = 0; $start < @$values; $start += $block_size ) {
        my @block;
        for ( my $i = $start; $i < $start + $block_size; ++$i ) {
            my $val = $values->[$i];
            $val = $default if !defined($val);
            push( @block, $val );
        }
        my $str = join( '|', @block );
        my $block_id = $block_ids{$str};
        if ( !defined($block_id) ) {
            $block_id = $block_count++;
            $block_ids{$str} = $block_id;
            push( @compressed, @block );
        }
        push( @map_values, $block_id );
    }
    # find default for map table
    my @default_block;
    for ( my $i = 0; $i < $block_size; ++$i ) {
        push( @default_block, $default );
    }
    my $str = join( '|', @default_block );
    my $default_block_id = $block_ids{$str};
    if ( !defined($default_block_id) ) {
        $default_block_id = $block_count++;
        push( @compressed, @default_block );
    }
    my $map_table = UnicodeTable->new(
        values  => \@map_values,
        default => $default_block_id,
        max     => $block_count - 1,
    );
    return UnicodeTable->new(
        values    => \@compressed,
        default   => $default,
        max       => $self->{max},
        shift     => $shift,
        map_table => $map_table,
    );
}
HideShow 9 lines of Pod
=head2 compress_map
    my $map_table = $table->compress_map($shift);
Compress the map table of a table for multi stage lookup. Returns the
compressed map table.
=cut
sub compress_map {
    my ( $self, $shift ) = @_;
    my $comp = $self->{map_table}->compress($shift);
    $self->{map_table} = $comp;
    return $comp;
}
HideShow 8 lines of Pod
=head2 dump
    $table->dump($file, $name);
Dump the table as C code to filehandle $file. The table name is $name.
=cut
sub dump {
    my ( $self, $file, $name ) = @_;
    my $values  = $self->{values};
    my $size    = @$values;
    my $uc_name = uc($name);
    print $file (<<"EOF") if $self->{shift};
#define ${uc_name}_SHIFT $self->{shift}
#define ${uc_name}_MASK  $self->{mask}
EOF
    print $file (<<"EOF");
#define ${uc_name}_SIZE  $size
EOF
    my $max           = $self->{max};
    my $bits          = $max < 0x100 ? 8 : $max < 0x10000 ? 16 : 32;
    my $pad           = length($max);
    my $vals_per_line = int( 76 / ( $pad + 2 ) );
    print $file ("static const uint${bits}_t $name\[$size] = {\n");
    my $i = 0;
    while ( $i < $size ) {
        printf $file ( "    \%${pad}d", $values->[$i] );
        my $max = $i + $vals_per_line;
        $max = $size if $max > $size;
        while ( ++$i < $max ) {
            printf $file ( ", \%${pad}d", $values->[$i] );
        }
        print $file (',') if $i < $size;
        print $file ("\n");
    }
    print $file ("};\n");
}
sub calc_sizes {
    my ( $self, $range2, $range1 ) = @_;
    for ( my $shift2 = $range2->[0]; $shift2 <= $range2->[1]; ++$shift2 ) {
        my $comp      = $self->compress($shift2);
        my $map_table = $comp->map_table;
        my $size3     = $comp->size;
        for ( my $shift1 = $range1->[0]; $shift1 <= $range1->[1]; ++$shift1 )
        {
            my $comp_map_table = $map_table->compress($shift1);
            my $size1 = $comp_map_table->map_table->size;
            my $size2 = $comp_map_table->size;
            printf(
                "shift %2d %2d: %6d + %6d + %6d = %7d bytes, %4d %4d\n",
                $shift1,                         $shift2,
                $size1,                          $size2,
                $size3,                          $size1 + $size2 + $size3,
                $comp_map_table->map_table->max, $comp_map_table->max,
            );
        }
        print("\n");
    }
}
HideShow 6 lines of Pod
=head1 AUTHOR
Nick Wellnhofer <wellnhofer@aevum.de>
=cut
1;