ext_closure_gen.pl

#!/usr/bin/perl  -w

use strict;
use warnings;

#this perl script is used to generate ExtClosure

my $kPreMaxArgs = 10;
my $kMaxArgs = 10;

sub PrintHead()
{
    print "#ifndef _TRIDENT_EXT_CLOSURE_H_\n";
    print "#define _TRIDENT_EXT_CLOSURE_H_\n\n";

    print "/////////////////////////////////////////////////////\n";
    print "// DO NOT EDIT!!!\n";
    print "// this header file is auto generated by perl script\n";
    print "// edit the generator if necessary\n";
    print "/////////////////////////////////////////////////////\n\n";

    print "/////////////////////////////////////////////////////\n";
    print "// Support:\n";
    print "// 1, Support pre-bind and post-bind for general\n";
    print "//    function and class method, up to 10 arguments.\n";
    print "// 2, Support pass argument by reference, though bind\n";
    print "//    always by value.\n";
    print "// 3, When bind class method, support use\n";
    print "//    \"trident::shared_ptr\" as this pointer of class.\n";
    print "// 4, Support create temporary and permanent closure:\n";
    print "//    Temporary closure (self destoryed after call):\n";
    print "//        NewExtClosure();\n";
    print "//    Permanent closure (do not destoryed by self):\n";
    print "//        NewPermanentExtClosure();\n";
    print "/////////////////////////////////////////////////////\n\n";

    print "/////////////////////////////////////////////////////\n";
    print "// Usage:\n";
    print "// 1, General function:\n";
    print "//    \n";
    print "//    void f1(int pre_arg, double post_arg);\n";
    print "//    \n";
    print "//    ExtClosure<void(double)>* c1 = NewExtClosure(&f1, 1);\n";
    print "//    c1->Run(2.0);\n";
    print "//    \n";
    print "//    ExtClosure<void(double)>* c2 = NewPermanentExtClosure(&f1, 1);\n";
    print "//    c2->Run(2.0);\n";
    print "//    \n";
    print "// 2, Class method:\n";
    print "//    \n";
    print "//    class C1\n";
    print "//    {\n";
    print "//        public:\n";
    print "//            int m1(int pre_arg, double post_arg);\n";
    print "//    };\n";
    print "//    \n";
    print "//    C1 obj;\n";
    print "//    \n";
    print "//    ExtClosure<int(double)>* c3 = NewExtClosure(&obj, &C1::m1, 1);\n";
    print "//    c3->Run(2.0);\n";
    print "//    \n";
    print "//    ExtClosure<int(double)>* c4 = NewPermanentExtClosure(&obj, &C1::m1, 1);\n";
    print "//    c4->Run(2.0);\n";
    print "//    \n";
    print "//    class C2 : public trident::enable_shared_from_this<C2>\n";
    print "//    {\n";
    print "//        public:\n";
    print "//            int m1(int pre_arg, double post_arg);\n";
    print "//     \n";
    print "//            void m2()\n";
    print "//            {\n";
    print "//                ExtClosure<int(double)>* c7 = NewExtClosure(\n";
    print "//                                  shared_from_this(), &C2::m1, 1);\n";
    print "//                c7->Run(2.0);\n";
    print "//             \n";
    print "//                ExtClosure<int(double)>* c8 = NewPermanentExtClosure(\n";
    print "//                                  shared_from_this(), &C2::m1, 1);\n";
    print "//                c8->Run(2.0);\n";
    print "//            }\n";
    print "//    };\n";
    print "//    \n";
    print "/////////////////////////////////////////////////////\n\n";

    print "/////////////////////////////////////////////////////\n";
    print "//\n";
    print "// //////// ExtClosure without return type ////////\n";
    for (my $i = 0; $i <= $kMaxArgs; $i++)
    {
        print "// ExtClosure: x->Run(";
        for (my $j = 1; $j <= $i; ++$j)
        {
            print "arg$j";
            print ", " if ($j < $i);
        }

        print "), ExtClosure can pre-bind 0~${kPreMaxArgs} argument(s).\n";
    }
    print "//\n";
    print "// /////// ExtClosure with return type of R ///////\n";
    for (my $i = 0; $i <= $kMaxArgs; $i++)
    {
        print "// ExtClosure: R = x->Run(";
        for (my $j = 1; $j <= $i; ++$j)
        {
            print "arg$j";
            print ", " if ($j < $i);
        }
        print "), ExtClosure can pre-bind 0~${kPreMaxArgs} argument(s).\n";
    }
    print "//\n";
    print "/////////////////////////////////////////////////////\n\n";

    print "#include <trident/closure_helper.h>\n\n";

    print "namespace trident {\n";
    print "\n";
}

sub PrintEnd
{
    print "\n\n";
    print "} // namespace trident\n\n";

    print "#endif // _TRIDENT_EXT_CLOSURE_H_\n";
}

sub PrintExtClosureBase()
{
    print "
/// base class for all ExtClosures
class ExtClosureBase
{
public:
    virtual ~ExtClosureBase() {}
    virtual bool IsSelfDelete() const = 0;
};

";
}

sub PrintExtClosure()
{
    my $kTotalArgs = $kPreMaxArgs + $kMaxArgs;
    print "// primary template\n";
    print "template <typename Signature>";
    print "class ExtClosure : public ExtClosureBase\n";
    print "{\n";
    print "};\n";

    for (my $i = 0; $i < $kTotalArgs; $i++)
    {
        if ($i <= 1)
        {
            print "\n// specified for $i argument\n";
        }
        else
        {
            print "\n// specified for $i arguments\n";
        }

        print "template <\n    typename R";

        my ($j);
        for ($j = 1; $j <= $i; ++$j)
        {
            print ",\n    typename Arg$j";
        }

        print "\n>\n";
        print "class ExtClosure<R (";

        for ($j = 1; $j <= $i; ++$j)
        {
            print ", " if $j > 1;
            print "Arg$j";
        }

        print ")>\n    : public ExtClosureBase\n{\npublic:\n";
        print "    virtual R Run(";

        for ($j = 1; $j <= $i; ++$j)
        {
            print "Arg$j arg$j";

            if ($j != $i)
            {
                print ", ";
            }
        }

        print ") = 0;\n";
        print "};\n";
    }
}

sub PrintExtClosure_Arg_Bind($$$)
{
    my ($type, $num_pre_args, $num_args) = @_;
    my $k;

    # print template argument list
    print "template <\n    bool SelfDeleting,\n    typename R";
    print ",\n    typename ClassPointer, typename MethodClass" if ($type eq "Method");
    for ($k = 1; $k <= $num_pre_args; $k++)
    {
        print ",\n    typename PreArg$k";
    }
    for ($k = 1; $k <= $num_args; $k++)
    {
        print ",\n    typename Arg$k";
    }
    print "\n>\n";

    # print class definition
    my $ClassName = "${type}ExtClosure_Arg${num_args}_Bind${num_pre_args}";
    print "class ${ClassName} : public ExtClosure<R (";
    for ($k = 1; $k <= $num_args; $k++)
    {
        print ", " if $k > 1;
        print "Arg$k";
    }
    print ")> {\n";

    # print typedef
    print "    typedef R (";
    print "MethodClass::" if ($type eq "Method");
    print "*${type}Type)(";

    for ($k = 1; $k <= $num_pre_args; $k++)
    {
        print "PreArg$k";
        print ", " if ($k < $num_pre_args || $num_args > 0);
    }

    for ($k = 1; $k <= $num_args; $k++)
    {
        print "Arg$k";
        print ", " if ($k < $num_args);
    }

    print ");\n";

    print "public:\n";

    # print ctor
    print "    $ClassName(";

    if ($type eq "Method")
    {
        print "ClassPointer object, MethodType method";
    }
    elsif ($type eq "Function")
    {
        print "FunctionType function";
    }

    for ($k = 1; $k <= $num_pre_args; $k++)
    {
        print ", PreArg$k pa$k";
    }
    print "):\n        ";

    if ($type eq "Method")
    {
        print "m_object(object), m_method(method)";
    }
    elsif ($type eq "Function")
    {
        print "m_function(function)";
    }

    for ($k = 1; $k <= $num_pre_args; $k++)
    {
        print ", m_pa${k}(pa${k})";
    }
    print " {}\n";

    # print the `Run' function
    print "    virtual R Run(";
    for ($k = 1; $k <= $num_args; $k++)
    {
        print "Arg${k} arg${k}";
        print ", " if ($k < $num_args);
    }
    print ") {\n";
    print "        ConditionalAutoDeleter<SelfDeleting, ${ClassName}> self_deleter(this);\n";
    print "        return ";
    if ($type eq "Method")
    {
        print "(get_pointer(m_object)->*m_method)(";
    }
    elsif ($type eq "Function")
    {
        print "m_function(";
    }
    for ($k = 1; $k <= $num_pre_args; $k++)
    {
        print "m_pa$k";
        print ", " if $k != $num_pre_args || $num_args > 0;
    }
    for ($k = 1; $k <= $num_args; $k++)
    {
            print "arg$k";
            print ", " if $k != $num_args;
    }
    print ");\n";
    print "    }\n";

    # IsSelfDelete
    print "    virtual bool IsSelfDelete() const { return SelfDeleting; }\n";

    # member variables
    print "private:\n";
    if ($type eq "Method")
    {
            print "    ClassPointer m_object;\n    MethodType m_method;\n";
    }
    if ($type eq "Function")
    {
            print "    FunctionType m_function;\n";
    }
    for ($k = 1; $k <= $num_pre_args; $k++)
    {
            print "    typename ParamTraits<PreArg${k}>::StorageType m_pa${k};\n";
    }
    print "};\n\n";
}

sub PrintAllExtClosure_Arg_Binds($)
{
    my ($type) = @_;
    print "////////////////////////////////////////////////////\n";

    if ($type eq "Method")
    {
        print "//////////// class method closures /////////////////\n";
    }
    else
    {
        print "//////////// nomal function closures //////////////////\n";
    }
    print "////////////////////////////////////////////////////\n\n";

    for (my $num_args = 0; $num_args <= $kMaxArgs; ++$num_args)
    {
        for (my $num_pre_args = 0; $num_pre_args <= $kPreMaxArgs; $num_pre_args++)
        {
            PrintExtClosure_Arg_Bind($type, $num_pre_args, $num_args);
        }
    }
}

sub PrintNewExtClosure($$)
{
    my ($type, $self_deleting) = @_;
    print "////////////////////////////////////////////////////\n";
    print "//////// ExtClosure create helper functions /////////////\n";
    print "////////////////////////////////////////////////////\n";
    if ($type eq "Method")
    {
        print "//////////// for class method ////////////////////////\n\n";
    }
    else
    {
        print "//////////// for nomal function ////////////////////////\n\n";
    }

    # $resultType = $has_result ? "R" : "void";
    for (my $num_args = 0; $num_args <= $kMaxArgs; $num_args++)
    {
        for (my $num_pre_args = 0; $num_pre_args <= $kPreMaxArgs; $num_pre_args++)
        {
            my $k;
            print "template <typename R";
            print ", typename ClassPointer, typename MethodClass" if ($type eq "Method");
            for ($k = 1; $k <= $num_pre_args; $k++)
            {
                print ", typename PreArg$k";
            }
            for ($k = 1; $k <= $num_args; $k++)
            {
                print ", typename Arg$k";
            }
            print ">\n";
            print "ExtClosure<R (";
            for ($k = 1; $k <= $num_args; $k++)
            {
                print ", " if $k > 1;
                print "Arg$k";
            }
            print ")>* ";
            if ($self_deleting eq "false")
            {
                print "NewPermanentExtClosure(";
            }
            else
            {
                print "NewExtClosure(";
            }
            if ($type eq "Method")
            {
                print "ClassPointer object, R (MethodClass::*method)(";
            }
            else
            {
                print "R (*function)(";
            }
            for ($k = 1; $k <= $num_pre_args; $k++)
            {
                print "PreArg$k";
                print ", " if ($k < $num_pre_args || $num_args > 0);
            }
            for ($k = 1; $k <= $num_args; $k++)
            {
                print "Arg$k";
                print ", " if ($k < $num_args);
            }
            print ")";
            for ($k = 1; $k <= $num_pre_args; $k++)
            {
                print "\n        , typename ParamTraits<PreArg$k>::ForwardType pa$k";
            }
            print ") {\n";

            if ($type eq "Method")
            {
                print "    return new MethodExtClosure_Arg${num_args}_Bind${num_pre_args}<$self_deleting, R, ClassPointer, MethodClass";
            }
            else
            {
                print "    return new FunctionExtClosure_Arg${num_args}_Bind${num_pre_args}<$self_deleting, R";
            }
            for ($k = 1; $k <= $num_pre_args; $k++)
            {
                print ", PreArg$k";
            }
            for ($k = 1; $k <= $num_args; $k++)
            {
                print ", Arg$k";
            }
            print ">(";
            if ($type eq "Method")
            {
                print "object, method";
            }
            else
            {
                print "function";
            }
            for ($k = 1; $k <= $num_pre_args; $k++)
            {
                print ", pa$k";
            }
            print ");\n}\n\n";
        }
    }
}

# Start real work
PrintHead();
PrintExtClosureBase();
PrintExtClosure();
PrintAllExtClosure_Arg_Binds("Method");
PrintAllExtClosure_Arg_Binds("Function");
PrintNewExtClosure("Method", "true");
PrintNewExtClosure("Method", "false");
PrintNewExtClosure("Function", "true");
PrintNewExtClosure("Function", "false");
PrintEnd();