#! perl
# Copyright (C) 2001-2007, The Perl Foundation.
# $Id: gen_class.pl 21451 2007-09-21 09:33:44Z paultcochrane $

=head1 NAME

tools/dev/gen_class.pl - Create a template PMC file

=head1 SYNOPSIS

    % perl tools/dev/gen_class.pl Foo > src/pmc/Foo.pmc

=head1 DESCRIPTION

Use this script to generate a template PMC file with stubs for all the
methods you need to fill in. See F<docs/vtables.pod> for more
information on adding a new PMC to Parrot.

To see what a minimal PMC looks like, create a PMC template and compile
it to C.

    % perl tools/dev/gen_class.pl Foo > src/pmc/foo.pmc
    % perl tools/build/pmc2c.pl -c src/pmc/foo.pmc

=head1 SEE ALSO

F<tools/build/pmc2c.pl>, F<docs/vtables.pod>.

=cut

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../../lib";
use Parrot::Vtable;

my $vtbl = parse_vtable("$FindBin::Bin/../../vtable.tbl");

my $classname = shift
    or die "No classname given!\n";

## emit file header
print <<"EOF";
/* ${classname}.pmc
 *  Copyright (C) 2007, The Perl Foundation.
 *  SVN Info
 *     \$Id\$
 *  Overview:
 *     These are the vtable functions for the $classname base class
 *  Data Structure and Algorithms:
 *  History:
 *  Notes:
 *     Please remove unneeded entries.
 *  References:
 */

#include "parrot/parrot.h"

pmclass $classname {

EOF

## emit method bodies
for (@$vtbl) {
    my ( $retval, $methname, $args ) = @$_;
    if ( $methname eq 'type' || $methname eq 'name' || $methname =~ /prop/ ) {

        # default.pmc handles these
        next;
    }

    print "    $retval $methname ($args) {\n";

    if ( $retval ne 'void' ) {
        print $retval eq 'PMC*'
            ? "        return PMCNULL;\n"
            : "        return ($retval)0;\n";
    }
    print "    }\n\n";
}

## emit file footer
print "}\n";

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:


syntax highlighted by Code2HTML, v. 0.9.1