mirror of
git://xwords.git.sourceforge.net/gitroot/xwords/xwords
synced 2024-12-28 09:58:30 +01:00
857 lines
24 KiB
Perl
Executable file
857 lines
24 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
##############################################################################
|
|
# adapted from C++ code Copyright (C) 2000 Falk Hueffner
|
|
# This version Copyright (C) 2002 Eric House (xwords@eehouse.org)
|
|
#
|
|
# 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, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
|
# USA
|
|
##############################################################################
|
|
|
|
# inputs: 0. Name of file mapping letters to 0..31 values. In English
|
|
# case just contains A..Z. This will be used to translate the tries
|
|
# on output.
|
|
# 1. Max number of bytes per binary output file.
|
|
#
|
|
# 2. Basename of binary files for output.
|
|
|
|
# 3. Name of file to which to write the number of the
|
|
# startNode, since I'm not rewriting a bunch of code to expect Falk's
|
|
# '*' node at the start.
|
|
#
|
|
|
|
# In STDIN, the text file to be compressed. It absolutely
|
|
# must be sorted. The sort doesn't have to follow the order in the
|
|
# map file, however.
|
|
|
|
# This is meant eventually to be runnable as part of a cgi system for
|
|
# letting users generate Crosswords dicts online.
|
|
|
|
|
|
|
|
use strict;
|
|
use POSIX;
|
|
|
|
my $gFirstDiff;
|
|
my @gCurrentWord;
|
|
my $gCurrentWord; # save so can check for sortedness
|
|
my $gDone = 0;
|
|
my @gInputStrings;
|
|
my $gNeedsSort = 1; # read from cmd line eventually
|
|
my @gNodes; # final array of nodes
|
|
my $gNBytesPerOutfile = 0xFFFFFFFF;
|
|
my $gTableFile;
|
|
my $gOutFileBase;
|
|
my $gStartNodeOut;
|
|
my $gInFileName;
|
|
my $gKillIfMissing = 1;
|
|
my $gTermChar = '/n';
|
|
my $gDumpText = 0; # dump the dict as text after?
|
|
my $gCountFile;
|
|
my $gBytesPerNodeFile; # where to write whether node size 3 or 4
|
|
my $gWordCount = 0;
|
|
my %gTableHash;
|
|
my $gBlankIndex;
|
|
my @gRevMap;
|
|
my $debug = 0;
|
|
my %gSubsHash;
|
|
my $gForceFour = 0; # use four bytes regardless of need?
|
|
my $gNBytesPerNode;
|
|
my $gUseUnicode;
|
|
|
|
main();
|
|
|
|
exit;
|
|
|
|
##############################################################################
|
|
|
|
sub main() {
|
|
|
|
if ( !parseARGV() ) {
|
|
usage();
|
|
exit();
|
|
}
|
|
|
|
makeTableHash();
|
|
|
|
my $infile;
|
|
|
|
if ( $gInFileName ) {
|
|
open $infile, "<$gInFileName";
|
|
} else {
|
|
$infile = \*STDIN;
|
|
}
|
|
|
|
@gInputStrings = parseAndSort( $infile );
|
|
if ( $gInFileName ) {
|
|
close $infile;
|
|
}
|
|
|
|
# Do I need this stupid thing? Better to move the first row to
|
|
# the front of the array and patch everything else. Or fix the
|
|
# non-palm dictionary format to include the offset of the first
|
|
# node.
|
|
|
|
my $dummyNode = 0xFFFFFFFF;
|
|
@gNodes = ( $dummyNode );
|
|
|
|
readNextWord();
|
|
|
|
my $firstRootChildOffset = buildNode(0);
|
|
|
|
moveTopToFront( \$firstRootChildOffset );
|
|
|
|
if ( $gStartNodeOut ) {
|
|
writeOutStartNode( $gStartNodeOut, $firstRootChildOffset );
|
|
}
|
|
|
|
print STDERR "\n... dumping table ...\n" if $debug;
|
|
printNodes( \@gNodes, "done with main" ) if $debug;
|
|
|
|
# write out the number of nodes if requested
|
|
if ( $gCountFile ) {
|
|
open OFILE, "> $gCountFile";
|
|
print OFILE pack( "N", $gWordCount );
|
|
close OFILE;
|
|
print STDERR "wrote out: got $gWordCount words\n";
|
|
}
|
|
|
|
if ( $gOutFileBase ) {
|
|
emitNodes( $gNBytesPerOutfile, $gOutFileBase );
|
|
}
|
|
|
|
if ( $gDumpText && @gNodes > 0 ) {
|
|
printOneLevel( $firstRootChildOffset, "" );
|
|
}
|
|
|
|
if ( $gBytesPerNodeFile ) {
|
|
open OFILE, "> $gBytesPerNodeFile";
|
|
print OFILE $gNBytesPerNode;
|
|
close OFILE;
|
|
}
|
|
print STDERR "Used $gNBytesPerNode per node.\n";
|
|
} # main
|
|
|
|
# We now have an array of nodes with the last subarray being the
|
|
# logical top of the tree. Move them to the start, fixing all fco
|
|
# refs, so that legacy code like Palm can assume top==0.
|
|
#
|
|
# Note: It'd probably be a bit faster to integrate this with emitNodes
|
|
# -- unless I need to have an in-memory list that can be used for
|
|
# lookups. But that's best for debugging, so keep it this way for now.
|
|
#
|
|
# Also Note: the first node is a dummy that can and should be tossed
|
|
# now.
|
|
|
|
sub moveTopToFront($) {
|
|
my ( $firstRef ) = @_;
|
|
|
|
my $firstChild = ${$firstRef};
|
|
${$firstRef} = 0;
|
|
my @lastSub;
|
|
|
|
if ( $firstChild > 0 ) {
|
|
# remove the last (the root) subarray
|
|
@lastSub = splice( @gNodes, $firstChild );
|
|
} else {
|
|
die "there should be no words!!" if $gWordCount != 0;
|
|
}
|
|
# remove the first (garbage) node
|
|
shift @gNodes;
|
|
|
|
my $diff;
|
|
if ( $firstChild > 0 ) {
|
|
# -1 because all move down by 1; see prev line
|
|
$diff = @lastSub - 1;
|
|
die "something wrong with len\n" if $diff < 0;
|
|
} else {
|
|
$diff = 0;
|
|
}
|
|
|
|
# stick it on the front
|
|
splice( @gNodes, 0, 0, @lastSub);
|
|
|
|
# We add $diff to everything. There's no subtracting because
|
|
# nobody had any refs to the top list.
|
|
|
|
for ( my $i = 0; $i < @gNodes; ++$i ) {
|
|
my $fco = TrieNodeGetFirstChildOffset( $gNodes[$i] );
|
|
if ( $fco != 0 ) { # 0 means NONE, not 0th!!
|
|
TrieNodeSetFirstChildOffset( \$gNodes[$i], $fco+$diff );
|
|
}
|
|
}
|
|
} # moveTopToFront
|
|
|
|
|
|
sub buildNode {
|
|
my ( $depth ) = @_;
|
|
|
|
if ( @gCurrentWord == $depth ) {
|
|
# End of word reached. If the next word isn't a continuation
|
|
# of the current one, then we've reached the bottom of the
|
|
# recursion tree.
|
|
readNextWord();
|
|
if ($gFirstDiff < $depth || $gDone) {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
my @newedges;
|
|
|
|
do {
|
|
my $letter = $gCurrentWord[$depth];
|
|
my $isTerminal = @gCurrentWord - 1 == $depth ? 1:0;
|
|
|
|
my $nodeOffset = buildNode($depth+1);
|
|
my $newNode = MakeTrieNode($letter, $isTerminal, $nodeOffset);
|
|
push( @newedges, $newNode );
|
|
|
|
} while ( ($gFirstDiff == $depth) && !$gDone);
|
|
|
|
TrieNodeSetIsLastSibling( \@newedges[@newedges-1], 1 );
|
|
|
|
return addNodes( \@newedges );
|
|
} # buildNode
|
|
|
|
sub addNodes {
|
|
my ( $newedgesR ) = @_;
|
|
|
|
my $found = findSubArray( $newedgesR );
|
|
|
|
if ( $found >= 0 ) {
|
|
die "0 is an invalid match!!!" if $found == 0;
|
|
return $found;
|
|
} else {
|
|
|
|
my $firstFreeIndex = @gNodes;
|
|
|
|
print STDERR "adding...\n" if $debug;
|
|
printNodes( $newedgesR ) if $debug;
|
|
|
|
push @gNodes, (@{$newedgesR});
|
|
|
|
registerSubArray( $newedgesR, $firstFreeIndex );
|
|
return $firstFreeIndex;
|
|
}
|
|
} # addNodes
|
|
|
|
sub printNode {
|
|
my ( $index, $node ) = @_;
|
|
|
|
print STDERR "[$index] ";
|
|
|
|
my $letter = TrieNodeGetLetter($node);
|
|
printf( STDERR
|
|
"letter=%d(%s); isTerminal=%d; isLastSib=%d; fco=%d;\n",
|
|
$letter, "" . $gRevMap[$letter],
|
|
TrieNodeGetIsTerminal($node),
|
|
TrieNodeGetIsLastSibling($node),
|
|
TrieNodeGetFirstChildOffset($node));
|
|
} # printNode
|
|
|
|
sub printNodes {
|
|
my ( $nodesR, $name ) = @_;
|
|
|
|
my $len = @{$nodesR};
|
|
# print "printNodes($name): len = $len\n";
|
|
|
|
for ( my $i = 0; $i < $len; ++$i ) {
|
|
my $node = ${$nodesR}[$i];
|
|
printNode( $i, $node );
|
|
}
|
|
|
|
}
|
|
|
|
|
|
# Hashing. We'll keep a hash of offsets into the existing nodes
|
|
# array, and as the key use a string that represents the entire sub
|
|
# array. Since the key is what we're matching for, there should never
|
|
# be more than one value per hash and so we don't need buckets.
|
|
# Return -1 if there's no match.
|
|
|
|
sub findSubArray {
|
|
my ( $newedgesR ) = @_;
|
|
|
|
my $key = join('', @{$newedgesR});
|
|
|
|
if ( exists( $gSubsHash{$key} ) ) {
|
|
return $gSubsHash{$key};
|
|
} else {
|
|
return -1;
|
|
}
|
|
} # findSubArray
|
|
|
|
# add to the hash
|
|
sub registerSubArray {
|
|
my ( $edgesR, $nodeLoc ) = @_;
|
|
|
|
my $key = join( '', @{$edgesR} );
|
|
|
|
if ( exists $gSubsHash{$key} ) {
|
|
die "entry for key shouldn't exist!!";
|
|
} else {
|
|
$gSubsHash{$key} = $nodeLoc;
|
|
}
|
|
|
|
} # registerSubArray
|
|
|
|
sub toWord($) {
|
|
my ( $tileARef ) = @_;
|
|
my $word = "";
|
|
|
|
foreach my $tile (@$tileARef) {
|
|
foreach my $letter (keys (%gTableHash) ) {
|
|
if ( $tile == $gTableHash{$letter} ) {
|
|
$word .= $letter;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
return $word;
|
|
}
|
|
|
|
sub readNextWord() {
|
|
my @word;
|
|
|
|
if ( !$gDone ) {
|
|
$gDone = @gInputStrings == 0;
|
|
if ( !$gDone ) {
|
|
@word = @{shift @gInputStrings};
|
|
} else {
|
|
print STDERR "gDone set to true\n" if $debug;
|
|
}
|
|
|
|
print STDERR "got word: ", join(',',@word), "\n" if $debug;
|
|
}
|
|
my $numCommonLetters = 0;
|
|
my $len = @word;
|
|
if ( @gCurrentWord < $len ) {
|
|
$len = @gCurrentWord;
|
|
}
|
|
|
|
while ( @gCurrentWord[$numCommonLetters] eq @word[$numCommonLetters]
|
|
&& $numCommonLetters < $len) {
|
|
++$numCommonLetters;
|
|
}
|
|
|
|
$gFirstDiff = $numCommonLetters;
|
|
if ( #$debug &&
|
|
@gCurrentWord > 0 && @word > 0
|
|
&& !firstBeforeSecond( \@gCurrentWord, \@word ) ) {
|
|
die "words ", join(",",@gCurrentWord), " (" . toWord(\@gCurrentWord) .
|
|
") and " . join(",", @word) . " (" . toWord(\@word) .
|
|
") out of order";
|
|
}
|
|
@gCurrentWord = @word;
|
|
} # readNextWord
|
|
|
|
sub firstBeforeSecond {
|
|
my ( $firstR, $secondR ) = @_;
|
|
|
|
for ( my $i = 0; ; ++$i ) {
|
|
|
|
# if we reach the end of the first word/list, we're done.
|
|
if ( $i == @{$firstR} ) {
|
|
die "duplicate!!!" if $i == @{$secondR};
|
|
return 1;
|
|
# but if we reach the second end first, we've failed
|
|
} elsif ( $i == @{$secondR} ) {
|
|
return 0;
|
|
}
|
|
|
|
my $diff = ${$firstR}[$i] <=> ${$secondR}[$i];
|
|
|
|
if ( $diff == 0 ) {
|
|
next;
|
|
} else {
|
|
return $diff < 0;
|
|
}
|
|
}
|
|
} # firstBeforeSecond
|
|
|
|
# passed to sort. Should remain unprototyped for effeciency's sake
|
|
|
|
sub cmpWords {
|
|
|
|
my $lenA = @{$a};
|
|
my $lenB = @{$b};
|
|
my $min = $lenA > $lenB? $lenB: $lenA;
|
|
|
|
for ( my $i = 0; $i < $min; ++$i ) {
|
|
my $ac = ${$a}[$i];
|
|
my $bc = ${$b}[$i];
|
|
|
|
my $res = $ac <=> $bc;
|
|
|
|
if ( $res != 0 ) {
|
|
return $res; # we're done
|
|
}
|
|
}
|
|
|
|
# If we got here, they match up to their common length. Longer is
|
|
# greater.
|
|
my $res = @{$a} <=> @{$b};
|
|
return $res; # which is longer?
|
|
} # cmpWords
|
|
|
|
sub parseAndSort() {
|
|
my ( $infile ) = @_;
|
|
|
|
my @wordlist;
|
|
my @word;
|
|
|
|
my $lastWord;
|
|
WORDLOOP:
|
|
for ( ; ; ) {
|
|
|
|
my $dropWord = 0;
|
|
splice @word; # empty it
|
|
|
|
# for each byte
|
|
for ( ; ; ) {
|
|
my $byt = getc($infile);
|
|
|
|
if ( $byt eq undef ) {
|
|
last WORDLOOP;
|
|
} elsif ( $byt eq $gTermChar ) {
|
|
if ( !$dropWord ) {
|
|
push @wordlist, [ @word ];
|
|
++$gWordCount;
|
|
}
|
|
$lastWord = "";
|
|
next WORDLOOP;
|
|
} elsif ( exists( $gTableHash{$byt} ) ) {
|
|
if ( !$dropWord ) {
|
|
push @word, $gTableHash{$byt};
|
|
die "word too long" if @word > 15;
|
|
if ( $gKillIfMissing ) {
|
|
$lastWord .= $byt;
|
|
}
|
|
}
|
|
} elsif ($gKillIfMissing) {
|
|
die "$0: chr $byt (", $byt+0, ") not in map file $gTableFile\n"
|
|
. "last word was $lastWord\n";
|
|
} else {
|
|
$dropWord = 1;
|
|
splice @word; # lose anything we already have
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( $gNeedsSort && ($gWordCount > 0) ) {
|
|
print STDERR "starting sort...\n" if $debug;
|
|
@wordlist = sort cmpWords @wordlist;
|
|
print STDERR "sort finished\n" if $debug;
|
|
}
|
|
|
|
print STDERR "length of list is ", @wordlist + 0, ".\n" if $debug;
|
|
|
|
return @wordlist;
|
|
} # parseAndSort
|
|
|
|
# Print binary representation of trie array. This isn't used yet, but
|
|
# eventually it'll want to dump to multiple files appropriate for Palm
|
|
# that can be catenated together on other platforms. There'll need to
|
|
# be a file giving the offset of the first node too. Also, might want
|
|
# to move to 4-byte representation when the input can't otherwise be
|
|
# handled.
|
|
|
|
sub dumpNodes {
|
|
|
|
for ( my $i = 0; $i < @gNodes; ++$i ) {
|
|
my $node = $gNodes[$i];
|
|
my $bstr = pack( "I", $node );
|
|
print STDOUT $bstr;
|
|
}
|
|
}
|
|
|
|
##############################################################################
|
|
# Little node-field setters and getters to hide what bits represent
|
|
# what.
|
|
#
|
|
# high bit (31) is ACCEPTING bit
|
|
# next bit (30) is LAST_SIBLING bit
|
|
# next 6 bits (29-24) are tile bit (allowing alphabets of 64 letters)
|
|
# final 24 bits (23-0) are the index of the first child (fco)
|
|
#
|
|
##############################################################################
|
|
|
|
sub TrieNodeSetIsTerminal {
|
|
my ( $nodeR, $isTerminal ) = @_;
|
|
|
|
if ( $isTerminal ) {
|
|
${$nodeR} |= (1 << 31);
|
|
} else {
|
|
${$nodeR} &= ~(1 << 31);
|
|
}
|
|
}
|
|
|
|
sub TrieNodeGetIsTerminal {
|
|
my ( $node ) = @_;
|
|
return ($node & (1 << 31)) != 0;
|
|
}
|
|
|
|
sub TrieNodeSetIsLastSibling {
|
|
my ( $nodeR, $isLastSibling ) = @_;
|
|
if ( $isLastSibling ) {
|
|
${$nodeR} |= (1 << 30);
|
|
} else {
|
|
${$nodeR} &= ~(1 << 30);
|
|
}
|
|
}
|
|
|
|
sub TrieNodeGetIsLastSibling {
|
|
my ( $node ) = @_;
|
|
return ($node & (1 << 30)) != 0;
|
|
}
|
|
|
|
sub TrieNodeSetLetter {
|
|
my ( $nodeR, $letter ) = @_;
|
|
|
|
die "$0: letter ", $letter, " too big" if $letter >= 64;
|
|
|
|
my $mask = ~(0x3F << 24);
|
|
${$nodeR} &= $mask; # clear all the bits
|
|
${$nodeR} |= ($letter << 24); # set new ones
|
|
}
|
|
|
|
sub TrieNodeGetLetter {
|
|
my ( $node ) = @_;
|
|
$node >>= 24;
|
|
$node &= 0x3F; # is 3f ok for 3-byte case???
|
|
return $node;
|
|
}
|
|
|
|
sub TrieNodeSetFirstChildOffset {
|
|
my ( $nodeR, $fco ) = @_;
|
|
|
|
die "$0: $fco larger than 24 bits" if ($fco & 0xFF000000) != 0;
|
|
|
|
my $mask = ~0x00FFFFFF;
|
|
${$nodeR} &= $mask; # clear all the bits
|
|
${$nodeR} |= $fco; # set new ones
|
|
}
|
|
|
|
sub TrieNodeGetFirstChildOffset {
|
|
my ( $node ) = @_;
|
|
$node &= 0x00FFFFFF; # 24 bits
|
|
return $node;
|
|
}
|
|
|
|
|
|
sub MakeTrieNode {
|
|
my ( $letter, $isTerminal, $firstChildOffset, $isLastSibling ) = @_;
|
|
my $result = 0;
|
|
|
|
TrieNodeSetIsTerminal( \$result, $isTerminal );
|
|
TrieNodeSetIsLastSibling( \$result, $isLastSibling );
|
|
TrieNodeSetLetter( \$result, $letter );
|
|
TrieNodeSetFirstChildOffset( \$result, $firstChildOffset );
|
|
|
|
return $result;
|
|
} # MakeTrieNode
|
|
|
|
# Caller may need to know the offset of the first top-level node.
|
|
# Write it here.
|
|
sub writeOutStartNode {
|
|
my ( $startNodeOut, $firstRootChildOffset ) = @_;
|
|
|
|
open NODEOUT, ">$startNodeOut";
|
|
print NODEOUT pack( "N", $firstRootChildOffset );
|
|
close NODEOUT;
|
|
} # writeOutStartNode
|
|
|
|
# build the hash for translating. I'm using a hash assuming it'll be
|
|
# fast. Key is the letter; value is the 0..31 value to be output.
|
|
sub makeTableHash {
|
|
my $i;
|
|
open TABLEFILE, "< $gTableFile";
|
|
|
|
splice @gRevMap; # empty it
|
|
|
|
for ( $i = 0; ; ++$i ) {
|
|
my $ch = getc(TABLEFILE);
|
|
if ( $ch eq undef ) {
|
|
last;
|
|
}
|
|
|
|
if ( $gUseUnicode ) { # skip the first byte each time: tmp HACK!!!
|
|
$ch = getc(TABLEFILE);
|
|
}
|
|
if ( $ch eq undef ) {
|
|
last;
|
|
}
|
|
|
|
push @gRevMap, $ch;
|
|
|
|
if ( ord($ch) == 0 ) { # blank
|
|
$gBlankIndex = $i;
|
|
next; # we want to increment i when blank seen since
|
|
# it is a tile value
|
|
}
|
|
|
|
die "$0: $gTableFile too large\n" if $i > 64;
|
|
die "$0: only blank (0) can be 64th char\n" if ($i == 64 && $ch != 0);
|
|
|
|
$gTableHash{$ch} = $i;
|
|
}
|
|
|
|
close TABLEFILE;
|
|
} # makeTableHash
|
|
|
|
# emitNodes. "input" is $gNodes. From it we write up to
|
|
# $nBytesPerOutfile to files named $outFileBase0..n, mapping the
|
|
# letter field down to 5 bits with a hash built from $tableFile. If
|
|
# at any point we encounter a letter not in the hash we fail with an
|
|
# error.
|
|
|
|
sub emitNodes($$) {
|
|
my ( $nBytesPerOutfile, $outFileBase ) = @_;
|
|
|
|
# now do the emit.
|
|
|
|
# is 17 bits enough?
|
|
printf STDERR ("There are %d (0x%x) nodes in this DAWG.\n",
|
|
0 + @gNodes, 0 + @gNodes );
|
|
my $nTiles = 0 + keys(%gTableHash); # blank is not included in this count!
|
|
if ( @gNodes > 0x1FFFF || $gForceFour || $nTiles > 32 ) {
|
|
$gNBytesPerNode = 4;
|
|
} elsif ( $nTiles < 32 ) {
|
|
$gNBytesPerNode = 3;
|
|
} else {
|
|
if ( $gBlankIndex == 32 ) { # blank
|
|
print STDERR "blank's at 32; 3-byte-nodes still ok\n";
|
|
$gNBytesPerNode = 3;
|
|
} else {
|
|
die "$0: move blank to last position in info.txt for smaller DAWG";
|
|
}
|
|
}
|
|
|
|
my $nextIndex = 0;
|
|
my $nextFileNum = 0;
|
|
|
|
for ( $nextFileNum = 0; ; ++$nextFileNum ) {
|
|
|
|
if ( $nextIndex >= @gNodes ) {
|
|
last; # we're done
|
|
}
|
|
|
|
die "Too many outfiles; infinite loop?" if $nextFileNum > 99;
|
|
|
|
my $outName = sprintf("${outFileBase}_%03d.bin", $nextFileNum);
|
|
open OUTFILE, "> $outName";
|
|
binmode( OUTFILE );
|
|
my $curSize = 0;
|
|
|
|
while ( $nextIndex < @gNodes ) {
|
|
|
|
# scan to find the next terminal
|
|
my $i;
|
|
for ( $i = $nextIndex;
|
|
!TrieNodeGetIsLastSibling($gNodes[$i]);
|
|
++$i ) {
|
|
|
|
# do nothing but a sanity check
|
|
if ( $i >= @gNodes) {
|
|
die "bad trie format: last node not last sibling" ;
|
|
}
|
|
|
|
}
|
|
++$i; # move beyond the terminal
|
|
my $nextSize = ($i - $nextIndex) * $gNBytesPerNode;
|
|
if ($curSize + $nextSize > $nBytesPerOutfile) {
|
|
last;
|
|
} else {
|
|
# emit the subarray
|
|
while ( $nextIndex < $i ) {
|
|
outputNode( $gNodes[$nextIndex], $gNBytesPerNode,
|
|
\*OUTFILE );
|
|
++$nextIndex;
|
|
}
|
|
$curSize += $nextSize;
|
|
}
|
|
}
|
|
|
|
close OUTFILE;
|
|
}
|
|
|
|
} # emitNodes
|
|
|
|
sub printWord {
|
|
my ( $str ) = @_;
|
|
|
|
print STDERR "$str\n";
|
|
}
|
|
|
|
# print out the entire dictionary, as text, to STDERR.
|
|
|
|
sub printOneLevel {
|
|
|
|
my ( $index, $str ) = @_;
|
|
|
|
for ( ; ; ) {
|
|
|
|
my $newStr = $str;
|
|
my $node = $gNodes[$index++];
|
|
|
|
my $lindx = $gRevMap[TrieNodeGetLetter($node)];
|
|
|
|
if ( ord($lindx) >= 0x20 ) {
|
|
$newStr .= "$lindx";
|
|
} else {
|
|
print STDERR "sub space" if $debug;
|
|
$newStr .= "\\" . chr('0'+$lindx);
|
|
}
|
|
|
|
if ( TrieNodeGetIsTerminal($node) ) {
|
|
printWord( $newStr );
|
|
}
|
|
|
|
my $fco = TrieNodeGetFirstChildOffset( $node );
|
|
if ( $fco != 0 ) {
|
|
printOneLevel( $fco, $newStr );
|
|
}
|
|
|
|
if ( TrieNodeGetIsLastSibling($node) ) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub outputNode ($$$) {
|
|
my ( $node, $nBytes, $outfile ) = @_;
|
|
|
|
my $fco = TrieNodeGetFirstChildOffset($node);
|
|
my $fourthByte;
|
|
|
|
if ( $nBytes == 4 ) {
|
|
$fourthByte = $fco >> 16;
|
|
die "$0: fco too big" if $fourthByte > 0xFF;
|
|
$fco &= 0xFFFF;
|
|
}
|
|
|
|
# Formats are different depending on whether it's to have 3- or
|
|
# 4-byte nodes.
|
|
|
|
# Here's what the three-byte node looks like. 16 bits plus one
|
|
# burried in the last byte for the next node address, five for a
|
|
# character/tile and one each for accepting and last-edge.
|
|
|
|
# 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
|
|
# |-------- 16 bits of next node address -------| | | | |-tile indx-|
|
|
# | | |
|
|
# accepting bit ---+ | |
|
|
# last edge bit ------+ |
|
|
# ---- last bit (17th on next node addr)---------+
|
|
|
|
# The four-byte format adds a byte at the right end for
|
|
# addressing, but removes the extra bit (5) in order to let the
|
|
# chars field be six bits. Bits 7 and 6 remain the same.
|
|
|
|
# write the fco (less that one bit). We want two bytes worth
|
|
# in three-byte mode, and three in four-byte mode
|
|
|
|
# first two bytes are low-word of fco, regardless of format
|
|
for ( my $i = 1; $i >= 0; --$i ) {
|
|
my $tmp = ($fco >> ($i * 8)) & 0xFF;
|
|
print $outfile pack( "C", $tmp );
|
|
}
|
|
$fco >>= 16; # it should now be 1 or 0
|
|
die "fco not 1 or 0" if $fco > 1;
|
|
|
|
my $chIn5 = TrieNodeGetLetter($node);
|
|
my $bits = $chIn5;
|
|
die "$0: char $bits too big" if $bits > 0x1F && $nBytes == 3;
|
|
|
|
if ( TrieNodeGetIsLastSibling($node) ) {
|
|
$bits |= 0x40;
|
|
}
|
|
if ( TrieNodeGetIsTerminal($node) ) {
|
|
$bits |= 0x80;
|
|
}
|
|
|
|
# We set the 17th next-node bit only in 3-byte case (where char is
|
|
# 5 bits)
|
|
if ( $nBytes == 3 && $fco != 0 ) {
|
|
$bits |= 0x20;
|
|
}
|
|
print $outfile pack( "C", $bits );
|
|
|
|
# the final byte, if in use
|
|
if ( $nBytes == 4 ) {
|
|
print $outfile pack( "C", $fourthByte );
|
|
}
|
|
} # outputNode
|
|
|
|
sub usage {
|
|
print STDERR "usage: $0 \n"
|
|
. "\t[-b bytesPerFile] (default = 0xFFFFFFFF)\n"
|
|
. "\t-m mapFile\n"
|
|
. "\t-mn mapFile (unicode)\n"
|
|
. "\t-ob outFileBase\n"
|
|
. "\t-sn start node out file\n"
|
|
. "\t[-if input file name] -- default = stdin\n"
|
|
. "\t[-term ch] (word terminator -- default = '\\0'\n"
|
|
. "\t[-nosort] (input already sorted in accord with -m; " .
|
|
" default=sort'\n"
|
|
. "\t[-dump] (write dictionary as text to STDERR for testing)\n"
|
|
. "\t[-force4](use 4 bytes per node regardless of need)\n"
|
|
. "\t[-r] (reject words with letters not in mapfile)\n"
|
|
. "\t[-k] (kill if any letters no in mapfile -- default)\n"
|
|
. "\t[-debug] (print a bunch of stuff)\n"
|
|
;
|
|
|
|
} # usage
|
|
|
|
sub parseARGV {
|
|
|
|
my $arg;
|
|
while ( my $arg = shift(@ARGV) ) {
|
|
|
|
SWITCH: {
|
|
if ($arg =~ /-b/) {$gNBytesPerOutfile = shift(@ARGV), last SWITCH;}
|
|
if ($arg =~ /-mn/) {$gTableFile = shift(@ARGV);
|
|
$gUseUnicode = 1;
|
|
last SWITCH;}
|
|
if ($arg =~ /-m/) {$gTableFile = shift(@ARGV); last SWITCH;}
|
|
if ($arg =~ /-ob/) {$gOutFileBase = shift(@ARGV), last SWITCH;}
|
|
if ($arg =~ /-sn/) {$gStartNodeOut = shift(@ARGV), last SWITCH;}
|
|
if ($arg =~ /-if/) {$gInFileName = shift(@ARGV), last SWITCH;}
|
|
if ($arg =~ /-r/) {$gKillIfMissing = 0; last SWITCH;}
|
|
if ($arg =~ /-k/) {$gKillIfMissing = 1; last SWITCH;}
|
|
if ($arg =~ /-term/) {$gTermChar = chr(shift(@ARGV)); last SWITCH;}
|
|
if ($arg =~ /-dump/) {$gDumpText = 1; last SWITCH;}
|
|
if ($arg =~ /-nosort/) {$gNeedsSort = 0; last SWITCH;}
|
|
if ($arg =~ /-wc/) {$gCountFile = shift(@ARGV); last SWITCH;}
|
|
if ($arg =~ /-ns/) {$gBytesPerNodeFile = shift(@ARGV); last SWITCH;}
|
|
if ($arg =~ /-force4/) {$gForceFour = 1; last SWITCH;}
|
|
# accept -fsize for compatibility with c++ version (but drop it)
|
|
if ($arg =~ /-fsize/) {shift(@ARGV); last SWITCH;}
|
|
if ($arg =~ /-debug/) {$debug = 1; last SWITCH;}
|
|
die "unexpected arg $arg\n";
|
|
}
|
|
}
|
|
|
|
|
|
print STDERR "gNBytesPerOutfile=$gNBytesPerOutfile\n" if $debug;
|
|
print STDERR "gTableFile=$gTableFile\n" if $debug;
|
|
print STDERR "gOutFileBase=$gOutFileBase\n" if $debug;
|
|
print STDERR "gStartNodeOut=$gStartNodeOut\n" if $debug;
|
|
printf STDERR "gTermChar=%s(%d)\n", $gTermChar, ord($gTermChar) if $debug;
|
|
|
|
return $gTableFile;
|
|
|
|
} # parseARGV
|