pgbackrest/build/lib/pgBackRestBuild/CodeGen/Switch.pm

####################################################################################################################################
# Generate C Switch Functions
####################################################################################################################################
package pgBackRestBuild::CodeGen::Switch;

use strict;
use warnings FATAL => qw(all);
use Carp qw(confess);
use English '-no_match_vars';

use Exporter qw(import);
    our @EXPORT = qw();
use Storable qw(dclone);

use pgBackRest::Common::Log;
use pgBackRest::Common::String;

use pgBackRestBuild::CodeGen::Common;

####################################################################################################################################
# Cost constants used by optimizer
####################################################################################################################################
# Cost for setting up a new switch statement
use constant COST_SWITCH                                            => 5;
# Cost for each case
use constant COST_SWITCH_CASE                                       => 1;
# Cost for a clause (which might be shared with multipe cases)
use constant COST_SWITCH_CLAUSE                                     => 2;

####################################################################################################################################
# cgenSwitchBuild - build switch statements to perform lookups
####################################################################################################################################
sub cgenSwitchBuild
{
    my $strName = shift;
    my $strType = shift;
    my $ryMatrix = dclone(shift);
    my $rstryParam = dclone(shift);
    my $rhLabelMap = shift;
    my $rhValueLabelMap = shift;

    # Build a hash with positions for the data in parameter order
    my $rhParamOrder = {};

    for (my $iIndex = 0; $iIndex < @{$rstryParam}; $iIndex++)
    {
        $rhParamOrder->{$rstryParam->[$iIndex]} = $iIndex;
    }

    # Try each permutation of param order to find the most efficient switch statement
    my $iBestCost;
    my $strBestSwitch;

    foreach my $rstryParamPermute (cgenPermute($rstryParam))
    {
        # Build a hash with positions for the data in permutation order
        my $rhPermuteOrder = {};

        for (my $iIndex = 0; $iIndex < @{$rstryParamPermute}; $iIndex++)
        {
            $rhPermuteOrder->{$rstryParamPermute->[$iIndex]} = $iIndex;
        }

        # Arrange data in permutation order so later functions don't have to remap for every operation
        my @yMatrixPermute;

        foreach my $rxyEntry (@{$ryMatrix})
        {
            my @xyEntryPermute;

            for (my $iSwapIdx = 0; $iSwapIdx < @{$rstryParam}; $iSwapIdx++)
            {
                $xyEntryPermute[$rhPermuteOrder->{$rstryParam->[$iSwapIdx]}] =
                    $rxyEntry->[$rhParamOrder->{$rstryParam->[$iSwapIdx]}];
            }

            # Convert the value to a special string if it is null to ease later prcessing
            $xyEntryPermute[@{$rstryParam}] = defined($rxyEntry->[-1]) ? $rxyEntry->[-1] : CGEN_DATAVAL_NULL;

            push(@yMatrixPermute, \@xyEntryPermute);
        }

        # Build switch based on current param permutation
        my ($strSwitch, $iCost) = cgenSwitchBuildSub(
            $strType, \@yMatrixPermute, 0, $rstryParamPermute, $rhLabelMap, $rhValueLabelMap);

        # If the switch has a lower cost than the existing one then use it instead
        if (!defined($iBestCost) || $iCost < $iBestCost)
        {
            $iBestCost = $iCost;
            $strBestSwitch = $strSwitch;
        }
    }

    # Construct the function based on the best switch statement
    return
        cgenTypeName($strType) . "\n" .
        "${strName}(int " . join(', int ', @{$rstryParam}) . ")\n" .
        "{\n" .
        "${strBestSwitch}\n" .
        "}\n";
}

push @EXPORT, qw(cgenSwitchBuild);

####################################################################################################################################
# cgenSwitchBuildSub - build individual switch statements recursively
####################################################################################################################################
sub cgenSwitchBuildSub
{
    my $strType = shift;
    my $rstryMatrix = dclone(shift);
    my $iDepth = shift;
    my $rstryParam = dclone(shift);
    my $rhLabelMap = shift;
    my $rhValueLabelMap = shift;
    my $xMostCommonParentValue = shift;

    # How much to indent the code is based on the current depth
    my $strIndent = ('    ' x (($iDepth * 2) + 1));

    # Set initial cost for setting up the switch statement
    my $iCost = COST_SWITCH;

    # Get the param to be used for the switch statement
    my $strParam = shift(@{$rstryParam});

    # Determine the most common value
    my $iMostCommonTotal = 0;
    my $xMostCommonValue;
    my $rhMostCommon = {};

    foreach my $rxyEntry (@{$rstryMatrix})
    {
        my $xValue = $rxyEntry->[-1];

        $rhMostCommon->{$xValue} = (defined($rhMostCommon->{$xValue}) ? $rhMostCommon->{$xValue} : 0) + 1;

        if ($rhMostCommon->{$xValue} > $iMostCommonTotal)
        {
            $iMostCommonTotal = $rhMostCommon->{$xValue};
            $xMostCommonValue = $xValue;
        }
    }

    # Keep going until all keys are exhausted
    my $rhClauseHash;

    while (@{$rstryMatrix} > 0)
    {
        # Start processing the first key in the list
        my $strKeyTop = $rstryMatrix->[0][0];

        # A list of keys values to be passed to the next switch statement
        my @stryEntrySub;

        # Find all instances of the key and build a hash representing the distinct list of values
        my $rhKeyValue = {};
        my $iEntryIdx = 0;

        while ($iEntryIdx < @{$rstryMatrix})
        {
            # If this key matches the top key then process
            if ($rstryMatrix->[$iEntryIdx][0] eq $strKeyTop)
            {
                # Add value to unique list
                $rhKeyValue->{$rstryMatrix->[$iEntryIdx][-1]} = true;

                # Get the key/value entry, remove the top key, and store for the next switch statement
                my @stryEntry = @{$rstryMatrix->[$iEntryIdx]};
                shift(@stryEntry);
                push(@stryEntrySub, \@stryEntry);

                # Remove the key from the list
                splice(@{$rstryMatrix}, $iEntryIdx, 1);
            }
            # else move on to the next key
            else
            {
                $iEntryIdx++;
            }
        };

        # Only need a switch if there is more than one value or the one value is not the most common value
        if (keys(%{$rhKeyValue}) > 1 || $stryEntrySub[0][-1] ne $xMostCommonValue)
        {
            my $strClause = '';

            $iCost += COST_SWITCH_CASE;

            # Process next switch
            if (keys(%{$rhKeyValue}) > 1 && @{$stryEntrySub[0]} > 1)
            {
                my ($strClauseSub, $iCostSub) = cgenSwitchBuildSub(
                    $strType, \@stryEntrySub, $iDepth + 1, $rstryParam, $rhLabelMap, $rhValueLabelMap, $xMostCommonValue);

                $strClause .= $strClauseSub . "\n";
                $iCost += $iCostSub;
            }
            # Return the value
            else
            {
                my $strRetVal = $stryEntrySub[0][-1];

                $strClause .=
                    "${strIndent}        return " .
                    cgenTypeFormat(
                        $strType,
                        defined($rhValueLabelMap) && defined($rhValueLabelMap->{$strRetVal}) ?
                            $rhValueLabelMap->{$strRetVal} : $strRetVal) .
                    ";\n";
            }

            # Store the key and the clause in a hash to deduplicate
            push(@{$rhClauseHash->{$strClause}{key}}, int($strKeyTop));
        }
    }

    # Reorder clause based on an numerical/alpha representation of the case statements. This is done for primarily for readability
    # but may have some optimization benefits since integer keys are ordered numerically.
    my $rhClauseOrderedHash;

    foreach my $strClause (sort(keys(%{$rhClauseHash})))
    {
        my $strKey;

        foreach my $iKey (@{$rhClauseHash->{$strClause}{key}})
        {
            $strKey .= (defined($strKey) ? '' : ',') . sprintf('%07d', $iKey);
        }

        $rhClauseOrderedHash->{$strKey}{clause} = $strClause;
        $rhClauseOrderedHash->{$strKey}{key} = $rhClauseHash->{$strClause}{key};
    }

    # Build the switch statement
    my $bFirst = true;
    my $strFunction =
        "${strIndent}switch (${strParam})\n" .
        "${strIndent}{\n";

    # Retrieve each unique clause and create a case for each key assocated with it
    foreach my $strKey (sort(keys(%{$rhClauseOrderedHash})))
    {
        if (!$bFirst)
        {
            $strFunction .= "\n";
        }

        foreach my $strKey (@{$rhClauseOrderedHash->{$strKey}{key}})
        {
            $iCost += COST_SWITCH_CLAUSE;

            $strFunction .=
                "${strIndent}    case " .
                (defined($rhLabelMap->{$strParam}) ? $rhLabelMap->{$strParam}{int($strKey)} : int($strKey)) . ":\n";
        }

        $strFunction .= $rhClauseOrderedHash->{$strKey}{clause};
        $bFirst = false;
    }

    $strFunction .=
        "${strIndent}}\n\n";

    # If the most common value is the same as the parent then break instead of returning the same value.  Returning the same value
    # again might be slightly more efficient but the break makes it easier to debug where values are coming from.
    if (defined($xMostCommonParentValue) && $xMostCommonValue eq $xMostCommonParentValue)
    {
        $strFunction .=
            "${strIndent}break;";
    }
    # Else return the most common value
    else
    {
        $strFunction .=
            "${strIndent}return " .
                cgenTypeFormat(
                    $strType,
                    defined($rhValueLabelMap) && defined($rhValueLabelMap->{$xMostCommonValue}) ?
                        $rhValueLabelMap->{$xMostCommonValue} : $xMostCommonValue) .
                ";";
    }

    return $strFunction, $iCost;
}

1;