Re^3: Compact data classes

[BrowserUk]

Because it allows me to 'hardcode' the numbers in the substrs.

If you uncomment the print before the eval, you'll see something like:

package Test;
use constant { F1_N => 0, F2_N => 15, F3_N => 30, F4_N => 45, F5_N => 
+60, F6_N => 75, F7_N => 90, F8_N => 105, F9_N => 120, F10_N => 135, }
+;
use constant { F1_L => 15, F2_L => 15, F3_L => 15, F4_L => 15, F5_L =>
+ 15, F6_L => 15, F7_L => 15, F8_L => 15, F9_L => 15, F10_L => 15, };

sub new {
    my $class = shift;
    my $self = shift // '';
    return bless \$self, $class
}
# line 1 "sub_F4"
sub Test::F4 :lvalue {
    my $self = shift;
    substr( $$self, F4_N(), F4_L() );
}

F4_N() and F4_L() are constant subs which get optimised away during compilation, leaving hardcoded numbers which are faster than variables.

The memory saving comes from packing the fields into single strings; the performance comes from asking the sub to do as little as possible.

That said, by explaining that, I've spotted another couple of optimisations; and a potential bug. I'll get back to you with a revised version 2 days from now.

(A good reason for not uploading to cpan straight away :)

[creeble]

Okay, I totally understand that now; I had un-commented the print and not remembered that the 'use constant' actually does get optimised away at compile time. Very cool.

FWIW, I don't need the lvalue-ness of the accessors, setting them with param(value) makes me totally happy, especially if it saves anything. I'm embarrassed to say I've never seen the ":lvalue" attribute in use, which is rather nifty.

This is so promising. I really appreciate your expertise on this; I've tried various solutions like roboticus proposed, but performance has been unusable.

[BrowserUk]

Try this. It fixes a potential bug and adds the ability to get greater compression for numeric fields. It needs more testing, diagnostics and documentation, but suck it and see if it satisfies.

#! perl -slw
package Class::Struct::Compact2;
use strict;
use warnings;
my $TEMPL_RE = qr[(?:[AaZ]\d*|[cCsSiIlLqQjJfFd][><]?)];

our @export = qw[ new ];

sub new {
    my( $class, $newClassName, $templ ) = ( shift, shift, shift );
    $templ =~ m[^(?:\s*$TEMPL_RE)+\s*$] or die "Invalid template";
    my @templs = split ' ', $templ;
    my @names = @_;
    die 'The number of templates and names does not match.' unless @te
+mpls == @names;
    my( $n, @sizes, @offsets ) = 0;
    $sizes[ @sizes ] = $_, $offsets[ @offsets ] = $n, $n += $_ for map
+ length( pack $_, 0 ), @templs;

    my $package = <<EON;
# line 1 \"sub_New\"
package $newClassName;

sub new {
    my \$class = shift;
    my \$self;
    if( \@_ == 1 ) {
       \$self = shift() // '';
    }
    elsif( \@_ == @{[ scalar @templs ]} ) {
        \$self = pack '$templ', \@_;
    }
    return bless \\\$self, \$class
}
EON

    for my $field ( 0 .. $#names ) {
        $package .= <<EOA;
# line 1 \"sub_$names[ $field ]\"
sub ${newClassName}::${names[ $field ]} {
    my( \$self, \$newVal ) = \@_;
    substr( \$\$self, $offsets[ $field ], $sizes[ $field ] ) = pack '$
+templs[ $field ]', \$newVal
        if defined \$newVal;
    return unpack '$templs[ $field ]', substr( \$\$self, $offsets[ $fi
+eld ], $sizes[ $field ] );
}

EOA
    }
#    print $package;
    eval $package;
    return;
}

return 1 if caller;
package main;
use Time::HiRes qw[ time ];
use Devel::Size qw[ total_size ];
use Data::Dump qw[ pp ];

my @chars = ( 'a'..'z' );
sub dummy {
     my $n = shift;
     join '', @chars[ map int( rand @chars ), 1 .. $n ];
}

my @fieldNames = ( qw[
    SPString BString NPString SChar UChar SShort UShort
    SInt UInt ANInt UNInt SLong ULong
    SQuad UQuad SPFloat DPFloat NDouble
] );

our $N //= 15_000;
our $FIELD //= 'BString';
our $SHOW  //= 0;
our $CHECK //= 0;


Class::Struct::Compact2->new(
    'Test',
    'A15 a15 Z15 c C s S i I l L j J q Q f F d',
    @fieldNames
);
printf "Class constructed: check mem: "; $CHECK and <>;

my @db;
push @db, Test->new(
    map( dummy( 15 ), 1 .. 3 ),
    map( int( rand 2**$_ ), (7)x2, (15)x2, (31)x6, (63)x2 ),
    rand() * 1e38, rand() * 1e308, rand() * 1e308
) for 1 .. $N;

printf "Instances created: check mem: "; $CHECK and <>;

@db = sort{
    $a->$FIELD cmp $b->$FIELD
} @db;
$SHOW and pp \@db;

printf "Instances sorted:  check mem: "; $CHECK and <>;
print "total size: ", total_size \@db;
print "object size:", total_size \$db[0];

my $start = time;
for my $o ( 0, $#db ) {
    my @rec = map $db[ $o ]->$_, @fieldNames;
    print "@rec";
}
printf "Took %15.12f s\n", time() - $start;


__END__