You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2009/09/09 07:14:19 UTC
svn commit: r812773 - in /lucene/lucy/trunk/boilerplater/lib/Boilerplater:
Class.pm Dumpable.pm Method.pm
Author: marvin
Date: Wed Sep 9 05:14:18 2009
New Revision: 812773
URL: http://svn.apache.org/viewvc?rev=812773&view=rev
Log:
Commit LUCY-30, adding autogeneration of Dump() and Load() methods to
"dumpable" classes in Boilerplater.
Added:
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Dumpable.pm (with props)
Modified:
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Class.pm
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Method.pm
Modified: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Class.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Class.pm?rev=812773&r1=812772&r2=812773&view=diff
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Class.pm (original)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Class.pm Wed Sep 9 05:14:18 2009
@@ -11,6 +11,7 @@
verify_args
a_isa_b
);
+use Boilerplater::Dumpable;
use File::Spec::Functions qw( catfile );
use Scalar::Util qw( reftype );
@@ -31,6 +32,8 @@
exposure => 'parcel',
);
+my $dumpable = Boilerplater::Dumpable->new;
+
our %registry;
# Testing only.
@@ -118,7 +121,7 @@
unless reftype( $self->{attributes} ) eq 'HASH';
# Store in registry.
- my $key = $self->get_prefix . $self->{struct_sym};
+ my $key = $self->full_struct_sym;
my $existing = $registry{$key};
if ($existing) {
confess( "New class $self->{class_name} conflicts with previously "
@@ -166,6 +169,9 @@
sub vtable_var { uc( shift->{struct_sym} ) }
sub vtable_type { shift->vtable_var . '_VT' }
+sub full_struct_sym { $_[0]->get_prefix . $_[0]->{struct_sym} }
+sub full_vtable_var { $_[0]->get_PREFIX . $_[0]->vtable_var }
+
sub append_autocode { $_[0]->{autocode} .= $_[1] }
sub functions { @{ shift->{functions} } }
@@ -225,6 +231,12 @@
$self->{meth_by_name}{ $method->micro_sym } = $method;
}
+# Create dumpable functions unless hand coded versions were supplied.
+sub _create_dumpables {
+ my $self = shift;
+ $dumpable->add_dumpables($self) if $self->has_attribute('dumpable');
+}
+
sub grow_tree {
my $self = shift;
confess("Can't call grow_tree more than once") if $self->{tree_grown};
@@ -259,6 +271,7 @@
# passed down but before methods are passed down.
sub _generate_automethods {
my $self = shift;
+ $self->_create_dumpables;
for my $child ( @{ $self->{children} } ) {
$child->_generate_automethods;
}
@@ -520,6 +533,14 @@
struct, and it's not possible to initialize a static struct with a flexible
array at the end under C89.
+=head2 full_vtable_var
+
+Fully qualified vtable variable name, including the parcel prefix.
+
+=head2 full_struct_sym
+
+Fully qualified struct symbol, including the parcel prefix.
+
=head1 COPYRIGHT AND LICENSE
/**
Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Dumpable.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Dumpable.pm?rev=812773&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Dumpable.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Dumpable.pm Wed Sep 9 05:14:18 2009
@@ -0,0 +1,290 @@
+use strict;
+use warnings;
+
+package Boilerplater::Dumpable;
+use Carp;
+use Boilerplater::Class;
+use Boilerplater::Type;
+use Boilerplater::Method;
+use Boilerplater::Variable;
+
+sub new {
+ my $either = shift;
+ return bless {}, ref($either) || $either;
+}
+
+sub add_dumpables {
+ my ( $self, $class ) = @_;
+ confess( $class->get_class_name . " isn't dumpable" )
+ unless $class->has_attribute('dumpable');
+
+ # Inherit Dump/Load from parent if no novel member vars.
+ my $parent = $class->get_parent;
+ if ( $parent and $parent->has_attribute('dumpable') ) {
+ return unless scalar $class->novel_member_vars;
+ }
+
+ if ( !$class->novel_method('Dump') ) {
+ $self->_add_dump_method($class);
+ }
+ if ( !$class->novel_method('Load') ) {
+ $self->_add_load_method($class);
+ }
+}
+
+# Create a Boilerplater::Method object for either Dump() or Load().
+sub _make_method_obj {
+ my ( $self, $class, $dump_or_load ) = @_;
+ my $return_type = Boilerplater::Type::Object->new(
+ incremented => 1,
+ specifier => 'Obj',
+ indirection => 1,
+ parcel => $class->get_parcel,
+ );
+ my $self_type = Boilerplater::Type::Object->new(
+ specifier => $class->get_struct_sym,
+ indirection => 1,
+ parcel => $class->get_parcel,
+ );
+ my $self_var = Boilerplater::Variable->new(
+ type => $self_type,
+ parcel => $class->get_parcel,
+ micro_sym => 'self',
+ );
+
+ my $param_list;
+ if ( $dump_or_load eq 'Dump' ) {
+ $param_list
+ = Boilerplater::ParamList->new( variables => [$self_var], );
+ }
+ else {
+ my $dump_type = Boilerplater::Type::Object->new(
+ specifier => 'Obj',
+ indirection => 1,
+ parcel => $class->get_parcel,
+ );
+ my $dump_var = Boilerplater::Variable->new(
+ type => $dump_type,
+ parcel => $class->get_parcel,
+ micro_sym => 'dump',
+ );
+ $param_list = Boilerplater::ParamList->new(
+ variables => [ $self_var, $dump_var ], );
+ }
+
+ return Boilerplater::Method->new(
+ parcel => $class->get_parcel,
+ return_type => $return_type,
+ class_name => $class->get_class_name,
+ class_cnick => $class->get_cnick,
+ param_list => $param_list,
+ macro_sym => $dump_or_load,
+ exposure => 'public',
+ );
+}
+
+sub _add_dump_method {
+ my ( $self, $class ) = @_;
+ my $method = $self->_make_method_obj( $class, 'Dump' );
+ $class->add_method($method);
+ my $full_func_sym = $method->full_func_sym;
+ my $full_struct = $class->full_struct_sym;
+ my $autocode;
+ my @members;
+ my $parent = $class->get_parent;
+
+ if ( $parent and $parent->has_attribute('dumpable') ) {
+ my $super_dump = 'lucy_' . $parent->get_cnick . '_dump';
+ my $super_type = $parent->full_struct_sym;
+ $autocode = <<END_STUFF;
+lucy_Obj*
+$full_func_sym($full_struct *self)
+{
+ lucy_Hash *dump = (lucy_Hash*)$super_dump(($super_type*)self);
+END_STUFF
+ @members = $class->novel_member_vars;
+ }
+ else {
+ $autocode = <<END_STUFF;
+lucy_Obj*
+$full_func_sym($full_struct *self)
+{
+ lucy_Hash *dump = lucy_Hash_new(0);
+ Lucy_Hash_Store_Str(dump, "_class", 6,
+ (lucy_Obj*)Lucy_CB_Clone(Lucy_Obj_Get_Class_Name(self)));
+END_STUFF
+ @members = $class->member_vars;
+ shift @members; # skip self->vtable
+ shift @members; # skip refcount self->ref
+ }
+
+ for my $member_var (@members) {
+ $autocode .= $self->_process_dump_member( $class, $member_var );
+ }
+ $autocode .= " return (lucy_Obj*)dump;\n}\n\n";
+ $class->append_autocode($autocode);
+}
+
+sub _process_dump_member {
+ my ( $self, $class, $member ) = @_;
+ my $type = $member->get_type;
+ my $name = $member->micro_sym;
+ my $len = length($name);
+ if ( $type->is_integer ) {
+ return qq| Lucy_Hash_Store_Str(dump, "$name", $len, |
+ . qq|(lucy_Obj*)lucy_CB_newf("%i64", (chy_i64_t)self->$name));\n|;
+ }
+ elsif ( $type->is_floating ) {
+ return qq| Lucy_Hash_Store_Str(dump, "$name", $len, |
+ . qq|(lucy_Obj*)lucy_CB_newf("%f64", (double)self->$name));\n|;
+ }
+ elsif ( $type->is_object ) {
+ return <<END_STUFF;
+ if (self->$name) {
+ Lucy_Hash_Store_Str(dump, "$name", $len, Lucy_Obj_Dump(self->$name));
+ }
+END_STUFF
+ }
+ else {
+ confess( "Don't know how to dump a " . $type->get_specifier );
+ }
+}
+
+sub _add_load_method {
+ my ( $self, $class ) = @_;
+ my $method = $self->_make_method_obj( $class, 'Load' );
+ $class->add_method($method);
+ my $full_func_sym = $method->full_func_sym;
+ my $full_struct = $class->full_struct_sym;
+ my $autocode;
+ my @members;
+ my $parent = $class->get_parent;
+
+ if ( $parent and $parent->has_attribute('dumpable') ) {
+ my $super_load = 'lucy_' . $parent->get_cnick . '_load';
+ my $super_type = $parent->full_struct_sym;
+ $autocode = <<END_STUFF;
+lucy_Obj*
+$full_func_sym($full_struct *self, lucy_Obj *dump)
+{
+ lucy_Hash *source = (lucy_Hash*)LUCY_ASSERT_IS_A(dump, LUCY_HASH);
+ $full_struct *loaded
+ = ($full_struct*)$super_load(($super_type*)self, dump);
+ CHY_UNUSED_VAR(self);
+END_STUFF
+ @members = $class->novel_member_vars;
+ }
+ else {
+ $autocode = <<END_STUFF;
+lucy_Obj*
+$full_func_sym($full_struct *self, lucy_Obj *dump)
+{
+ lucy_Hash *source = (lucy_Hash*)LUCY_ASSERT_IS_A(dump, LUCY_HASH);
+ lucy_CharBuf *class_name = (lucy_CharBuf*)LUCY_ASSERT_IS_A(
+ Lucy_Hash_Fetch_Str(source, "_class", 6), LUCY_CHARBUF);
+ lucy_VTable *vtable = lucy_VTable_singleton(class_name, NULL);
+ $full_struct *loaded = ($full_struct*)Lucy_VTable_Make_Obj(vtable);
+ CHY_UNUSED_VAR(self);
+END_STUFF
+ @members = $class->member_vars;
+ shift @members; # skip self->vtable
+ shift @members; # skip refcount self->ref
+ }
+
+ for my $member_var (@members) {
+ $autocode .= $self->_process_load_member( $class, $member_var );
+ }
+ $autocode .= " return (lucy_Obj*)loaded;\n}\n\n";
+ $class->append_autocode($autocode);
+}
+
+sub _process_load_member {
+ my ( $self, $class, $member ) = @_;
+ my $type = $member->get_type;
+ my $type_str = $type->to_c;
+ my $name = $member->micro_sym;
+ my $len = length($name);
+ my $struct_sym = $type->get_specifier;
+ my $vtable_var = uc($struct_sym);
+ my $extraction
+ = $type->is_integer ? qq|($type_str)Lucy_Obj_To_I64(var)|
+ : $type->is_floating ? qq|($type_str)Lucy_Obj_To_F64(var)|
+ : $type->is_object
+ ? qq|($struct_sym*)LUCY_ASSERT_IS_A(Lucy_Obj_Load(var, var), $vtable_var)|
+ : confess( "Don't know how to load " . $type->get_specifier );
+ return <<END_STUFF;
+ {
+ lucy_Obj *var = Lucy_Hash_Fetch_Str(source, "$name", $len);
+ if (var) { loaded->$name = $extraction; }
+ }
+END_STUFF
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Dumpable - Auto-generate code for "dumpable" classes.
+
+=head1 SYNOPSIS
+
+ my $dumpable = Boilerplater::Dumpable->new;
+ for my $class ( grep { $_->has_attribute('dumpable') } @classes ) {
+ $dumpable->add_dumpables($class);
+ }
+
+=head1 DESCRIPTION
+
+If a class declares that it has the attribute "dumpable", but does not declare
+either Dump or Load(), Boilerplater::Dumpable will attempt to auto-generate
+those methods if methods inherited from the parent class do not suffice.
+
+ class Foo::Bar extends Foo : dumpable {
+ Thing *thing;
+
+ public inert incremented Bar*
+ new();
+
+ void
+ Destroy(Bar *self);
+ }
+
+=head1 METHODS
+
+=head2 new
+
+ my $dumpable = Boilerplater::Dumpable->new;
+
+Constructor. Takes no arguments.
+
+=head2 add_dumpables
+
+ $dumpable->add_dumpables($dumpable_class);
+
+Analyze a class with the attribute "dumpable" and add Dump() or Load() methods
+as necessary.
+
+=head1 COPYRIGHT AND LICENSE
+
+ /**
+ * Copyright 2009 The Apache Software Foundation
+ *
+ * Licensed 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.
+ */
+
+=cut
+
Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Dumpable.pm
------------------------------------------------------------------------------
svn:eol-style = native
Modified: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Method.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Method.pm?rev=812773&r1=812772&r2=812773&view=diff
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Method.pm (original)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Method.pm Wed Sep 9 05:14:18 2009
@@ -51,10 +51,10 @@
my $args = $self->get_param_list->get_variables;
confess "Not enough args" unless @$args;
my $specifier = $args->[0]->get_type->get_specifier;
- my ($struct_name) = $self->{class_name} =~ /(\w+)$/;
+ my ($struct_sym) = $self->{class_name} =~ /(\w+)$/;
confess
"First arg type doesn't match class: $self->{class_name} $specifier"
- unless $specifier eq $self->get_prefix . $struct_name;
+ unless $specifier eq $self->get_prefix . $struct_sym;
# Cache typedef.
$self->{short_typedef}
@@ -329,4 +329,3 @@
*/
=cut
-