#!/usr/bin/perl
# This little script generates various utilities and structures for proper
# and efficient method handler lookups.

use strict;
use warnings;

#the ordering here is important, and should be structured
#with the most common being first.. so in the average case only 1-3
#comparisons are ever needed

my @object_types = (
    ['string', '"' ],
    ['key', '#'],
    ['number', '=' ],
    ['object', '{'],
    ['list', '[' ],
    ['data', 'c' ],
    ['json', 'D' ],
    ['special', '^' ],
    ['boolean', '?' ],
    ['null', '~' ],
    #this is a pseudo-type, and is manually picked up
    ['any', '.'],
);


my @mode_types = (
    ['on', '>'],
    ['start', '+'],
    ['end', '-'],
);

print <<"EOC";

/**
 * This file was automatically generated by running the '$0'
 * script. Do not modify this file directly.
 *
 * There are various macros in this header and they can be
 * enabled within various sections of code by doing the following
 * 
 * #define PLTUBA_METGHV_STRUCT
 * #include "this_header_name"
 * #undef PLTUBA_METHGV_STRUCT
 *
 * which will paste the definition of the methgv struct
 */

/** Structure defining GVs for all our callback methods */
#ifdef PLTUBA_METHGV_STRUCT
struct {
EOC
foreach (@mode_types) {
    my $mode = $_->[0];
    foreach (@object_types) {
        my $oname = $_->[0];
        print <<"EOC";
    GV* $mode\_$oname;
EOC
    }
}

print <<'EOC';
} methgv;

#endif /* PLTUBA_METHGV_STRUCT */
EOC

print <<"EOC";

/** X-Macro for method names */
#ifdef PLTUBA_DEFINE_XMETHGV
#define PLTUBA_XMETHGV \\
EOC

foreach (@mode_types) {
    my $mode = $_->[0];
    foreach (@object_types) {
        my $obj = $_->[0];
        print <<"EOC";
X($mode, $obj) \\
EOC
    }
}

print <<"EOC";

#endif /* PLTUBA_DEFINE_XMETHGV */
EOC

print <<"EOC";

/**
 * This generates a large switch statement which will
 * return the proper method name and the pointer to the GV
 * slot in the methgv structure. The reason why the pointer
 * to the slot is returned (i.e. a GV** instead of a GV*) is
 * so that it may be set and populated via a call to gv_fetchmethod
 */
#ifdef PLTUBA_METH_GETMETH
switch(action) {
EOC

foreach (@mode_types) {
    my ($pl_mode,$c_mode) = @$_;
    print <<"EOC";
    
/* $pl_mode */
case '$c_mode': {
    switch(cbtype) {
EOC
    foreach (@object_types) {
        my ($pl_oname,$char) = @$_;
        my $methname = "$pl_mode\_$pl_oname";
        print <<"EOC";
    case '$char':
        /* $pl_oname */
        methname = "$methname";
        methgvp = &tuba->methgv.$methname;
        break;
EOC
    }
    print <<"EOC";
    default:
        break;
    }
    break;
    }
EOC
}

print <<"EOC";
default:
    methname = NULL;
    methgvp = NULL;
    break;
}

#endif /* PLTUBA_METH_GETMETH */
EOC