Fix obsolete comment regarding FSM truncation.

[PostgreSQL.git] / src / interfaces / ecpg / preproc / parse.pl

#!/usr/bin/perl
# $PostgreSQL$
# parser generater for ecpg
# call with backend parser as stdin
#
# Copyright (c) 2007-2008, PostgreSQL Global Development Group
#
# Written by Mike Aubury <mike.aubury@aubit.com>
#            Michael Meskes <meskes@postgresql.org>
#
# Placed under the same license as PostgreSQL.
#

if (@ARGV) {
        $path = $ARGV[0];
        shift @ARGV;
}

if ($path eq '') { $path = "."; }

$[ = 1;                 # set array base to 1
$, = ' ';               # set output field separator
$\ = "\n";              # set output record separator

$copymode = 'off';
$brace_indent = 0;
$yaccmode = 0;
$header_included = 0;
$feature_not_supported = 0;
$tokenmode = 0;

# some token have to be replaced by other symbols
# either in the rule
$replace_token{'BCONST'} = 'ecpg_bconst';
$replace_token{'FCONST'} = 'ecpg_fconst';
$replace_token{'Sconst'} = 'ecpg_sconst';
$replace_token{'IDENT'} = 'ecpg_ident';
$replace_token{'PARAM'} = 'ecpg_param';
# or in the block
$replace_string{'WITH_TIME'} = 'with time';
$replace_string{'NULLS_FIRST'} = 'nulls first';
$replace_string{'NULLS_LAST'} = 'nulls last';
$replace_string{'TYPECAST'} = '::';

# specific replace_types for specific non-terminals - never include the ':'
# ECPG-only replace_types are defined in ecpg-replace_types
$replace_types{'PrepareStmt'} = '<prep>';
$replace_types{'opt_array_bounds'} = '<index>';
# "ignore" means: do not create type and rules for this non-term-id
$replace_types{'stmtblock'} = 'ignore';
$replace_types{'stmtmulti'} = 'ignore';
$replace_types{'CreateAsStmt'} = 'ignore';
$replace_types{'DeallocateStmt'} = 'ignore';
$replace_types{'RuleStmt'} = 'ignore';
$replace_types{'ColLabel'} = 'ignore';
$replace_types{'unreserved_keyword'} = 'ignore';
$replace_types{'Sconst'} = 'ignore';

# some production rules have to be ignored or replaced
$replace_line{'fetch_direction'} = 'ignore';
$replace_line{"opt_array_boundsopt_array_bounds'['Iconst']'"} = 'ignore';
$replace_line{'col_name_keywordCHAR_P'} = 'ignore';
$replace_line{'col_name_keywordINT_P'} = 'ignore';
$replace_line{'col_name_keywordVALUES'} = 'ignore';
$replace_line{'reserved_keywordTO'} = 'ignore';
$replace_line{'reserved_keywordUNION'} = 'ignore';
$replace_line{'VariableShowStmtSHOWvar_name'} = 'SHOW var_name ecpg_into';
$replace_line{'VariableShowStmtSHOWTIMEZONE'} = 'SHOW TIME ZONE ecpg_into';
$replace_line{'VariableShowStmtSHOWTRANSACTIONISOLATIONLEVEL'} = 'SHOW TRANSACTION ISOLATION LEVEL ecpg_into';
$replace_line{'VariableShowStmtSHOWSESSIONAUTHORIZATION'} = 'SHOW SESSION AUTHORIZATION ecpg_into';
$replace_line{'ExecuteStmtEXECUTEnameexecute_param_clause'} = 'EXECUTE prepared_name execute_param_clause execute_rest';
$replace_line{'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause'} = 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause';
$replace_line{'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt'} = 'PREPARE prepared_name prep_type_clause AS PreparableStmt';
$replace_line{'var_nameColId'} = 'ECPGColId';

line: while (<>) {
    chomp;      # strip record separator
    @Fld = split(' ', $_, -1);

    # Dump the action for a rule - 
    # mode indicates if we are processing the 'stmt:' rule (mode==0 means normal,  mode==1 means stmt:)
    # flds are the fields to use. These may start with a '$' - in which case they are the result of a previous non-terminal
    #                             if they dont start with a '$' then they are token name
    #
    # len is the number of fields in flds...
    # leadin is the padding to apply at the beginning (just use for formatting)

    if (/ERRCODE_FEATURE_NOT_SUPPORTED/) {
        $feature_not_supported = 1;
        next line;
    }

    if (/^%%/) {
        $tokenmode = 2;
        $copymode = 'on';
        $yaccmode++;
        $infield = 0;
        $fieldcount = 0;
    }

    $S = $_;
    $prec = 0;
    # Make sure any braces are split
    $s = '{', $S =~ s/$s/ { /g;
    $s = '}', $S =~ s/$s/ } /g;
    # Any comments are split
    $s = '[/][*]', $S =~ s#$s# /* #g;
    $s = '[*][/]', $S =~ s#$s# */ #g;

    # Now split the line into individual fields
    $n = (@arr = split(' ', $S));

    if ($arr[1] eq '%token' && $tokenmode == 0) {
        $tokenmode = 1;
        &include_stuff('tokens', 'ecpg.tokens', '', 1, 0);
        $type = 1;
    }
    elsif ($arr[1] eq '%type' && $header_included == 0) {
        &include_stuff('header', 'ecpg.header', '', 1, 0);
        &include_stuff('ecpgtype', 'ecpg.type', '', 1, 0);
        $header_included = 1;
    }

    if ($tokenmode == 1) {
        $str = '';
        for ($a = 1; $a <= $n; $a++) {
            if ($arr[$a] eq '/*') {
                $comment++;
                next;
            }
            if ($arr[$a] eq '*/') {
                $comment--;
                next;
            }
            if ($comment) {
                next;
            }
            if (substr($arr[$a], 1, 1) eq '<') {
                next;
                # its a type
            }
            $tokens{$arr[$a]} = 1;

            $str = $str . ' ' . $arr[$a];
            if ($arr[$a] eq 'IDENT' && $arr[$a - 1] eq '%nonassoc') {
            # add two more tokens to the list
                $str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT";
            }
        }
        &add_to_buffer('orig_tokens', $str);
        next line;
    }

    # Dont worry about anything if we're not in the right section of gram.y
    if ($yaccmode != 1) {
        next line;
    }

    # Go through each field in turn
    for ($fieldIndexer = 1; $fieldIndexer <= $n; $fieldIndexer++) {
        if ($arr[$fieldIndexer] eq '*/' && $comment) {
            $comment = 0;
            next;
        }
        elsif ($comment) {
            next;
        }
        elsif ($arr[$fieldIndexer] eq '/*') {
            # start of a multiline comment
            $comment = 1;
            next;
        }
        elsif ($arr[$fieldIndexer] eq '//') {
            next line;
        }
        elsif ($arr[$fieldIndexer] eq '}') {
            $brace_indent--;
            next;
        }
        elsif ($arr[$fieldIndexer] eq '{') {
            $brace_indent++;
            next;
        }

        if ($brace_indent > 0) {
            next;
        }
        if ($arr[$fieldIndexer] eq ';') {
            if ($copymode eq 'on') {
                if ($infield && $includetype eq '') {
                    &dump_line($stmt_mode, $fields, $field_count);
                }
                &add_to_buffer('rules', ";\n\n");
            }
            else {
                $copymode = 'on';
            }
            $field_count = 0;
            $infield = 0;
            $line = '';
            $includetype = '';
            next;
        }

        if ($arr[$fieldIndexer] eq '|') {
            if ($copymode eq 'on') {
                if ($infield && $includetype eq '') {
                    $infield = $infield + &dump_line($stmt_mode, $fields, $field_count);
                }
                if ($infield > 1) {
                    $line = '| ';
                }
            }
            $field_count = 0;
            $includetype = '';
            next;
        }

        if ($replace_token{$arr[$fieldIndexer]}) {
            $arr[$fieldIndexer] = $replace_token{$arr[$fieldIndexer]};
        }
        
        # Are we looking at a declaration of a non-terminal ? 
        if (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:') || $arr[$fieldIndexer + 1] eq ':') {
            $non_term_id = $arr[$fieldIndexer];
            $s = ':', $non_term_id =~ s/$s//g;

            if ($replace_types{$non_term_id} eq '') {
                $replace_types{$non_term_id} = '<str>';
            }
            if ($replace_types{$non_term_id} eq 'ignore') {
                $copymode = ';';
                $line = '';
                next line;
            }
            else {
                $copymode = 'on';
            }
            $line = $line . ' ' . $arr[$fieldIndexer];
            # Do we have the : attached already ? 
            # If yes, we'll have already printed the ':'
            if (!($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')) {
                # Consume the ':' which is next...
                $line = $line . ':';
                $fieldIndexer++;
            }

            # Special mode? 
            if ($non_term_id eq 'stmt') {
                $stmt_mode = 1;
            }
            else {
                $stmt_mode = 0;
            }
            $tstr = '%type ' . $replace_types{$non_term_id} . ' ' .  $non_term_id;
            &add_to_buffer('types', $tstr);

            if ($copymode eq 'on') {
                &add_to_buffer('rules', $line);
            }
            $line = '';
            $field_count = 0;
            $infield = 1;
            next;
        }
        elsif ($copymode eq 'on') {
            $line = $line . ' ' . $arr[$fieldIndexer];
        }
        if ($arr[$fieldIndexer] eq '%prec') {
            $prec = 1;
            next;
        }

        if ($copymode eq 'on' && !$prec && !$comment && $arr[$fieldIndexer] ne '/*EMPTY*/' && length($arr[$fieldIndexer]) && $infield) {
            $nfield = $field_count + 1;
            if ($arr[$fieldIndexer] ne 'Op' && ($tokens{$arr[$fieldIndexer]} > 0 || $arr[$fieldIndexer] =~ "'.+'") || $stmt_mode == 1) {
                if ($replace_string{$arr[$fieldIndexer]}) {
                    $S = $replace_string{$arr[$fieldIndexer]};
                }
                else {
                    $S = $arr[$fieldIndexer];
                }
                $s = '_P', $S =~ s/$s//g;
                $s = "'", $S =~ s/$s//g;
                if ($stmt_mode == 1) {
                    $fields{$field_count++} = $S;
                }
                else {
                    $fields{$field_count++} = lc($S);
                }
            }
            else {
                $fields{$field_count++} = "\$" . $nfield;
            }
        }
    }
}

&dump('header');
&dump('tokens');
&dump('types');
&dump('ecpgtype');
&dump('orig_tokens');
print '%%';
print 'prog: statements;';
&dump('rules');
&include_stuff('trailer', 'ecpg.trailer', '', 1, 0);
&dump('trailer');

sub include_stuff {
    local($includestream, $includefilename, $includeblock, $copy, $field_count) = @_;
    $copied = 0;
    $inblock = 0;
    $filename = $path . "/" . $includefilename;
    while (($_ = &Getline2($filename),$getline_ok)) {
        if ($includeblock ne '' && $Fld[1] eq 'ECPG:' && $inblock == 0) {
            if ($Fld[2] eq $includeblock) {
                $copy = 1;
                $inblock = 1;
                $includetype = $Fld[3];
                if ($includetype eq 'rule') {
                    &dump_fields($stmt_mode, *fields, $field_count, ' { ');
                }
                elsif ($includetype eq 'addon') {
                    &add_to_buffer('rules', ' { ');
                }
            }
            else {
                $copy = 0;
            }
        }
        else {
            if ($copy == 1 && $Fld[1] ne 'ECPG:') {
                &add_to_buffer($includestream, $_);
                $copied = 1;
                $inblock = 0;
            }
        }
    }
    delete $opened{$filename} && close($filename);
    if ($includetype eq 'addon') {
        &dump_fields($stmt_mode, *fields, $field_count, '');
    }
    if ($copied == 1) {
        $field_count = 0;
        $line = '';
    }
    $copied;
}

sub add_to_buffer {
    local($buffer, $str) = @_;
    $buff{$buffer, $buffcnt{$buffer}++} = $str;
}

sub dump {
    local($buffer) = @_;
    print '/* ' . $buffer . ' */';
    for ($a = 0; $a < $buffcnt{$buffer}; $a++) {
        print $buff{$buffer, $a};
    }
}

sub dump_fields {
    local($mode, *flds, $len, $ln) = @_;
    if ($mode == 0) {
        #Normal 
        &add_to_buffer('rules', $ln);
        if ($feature_not_supported == 1) {
            # we found an unsupported feature, but we have to
            # filter out ExecuteStmt: CREATE OptTemp TABLE ...
            # because the warning there is only valid in some situations
            if ($flds{0} ne 'create' || $flds{2} ne 'table') {
                &add_to_buffer('rules', "mmerror(PARSE_ERROR, ET_WARNING, \"unsupported feature will be passed to backend\\n\");");
            }
            $feature_not_supported = 0;
        }

        if ($len == 0) {
            # We have no fields ? 
            &add_to_buffer('rules', " \$\$=EMPTY; }");
        }
        else {
            # Go through each field and try to 'aggregate' the tokens into a single 'make_str' where possible
            $cnt = 0;
            for ($z = 0; $z < $len; $z++) {
                if (substr($flds{$z}, 1, 1) eq "\$") {
                    $flds_new{$cnt++} = $flds{$z};
                    next;
                }

                $str = $flds{$z};

                while (1) {
                    if ($z >= $len - 1 || substr($flds{$z + 1}, 1, 1) eq "\$") {
                        # We're at the end...
                        $flds_new{$cnt++} = "make_str(\"" . $str . "\")";
                        last;
                    }
                    $z++;
                    $str = $str . ' ' . $flds{$z};
                }
            }

            # So - how many fields did we end up with ? 
            if ($cnt == 1) {
                # Straight assignement
                $str = " \$\$ = " . $flds_new{0} . ';';
                &add_to_buffer('rules', $str);
            }
            else {
                # Need to concatenate the results to form
                # our final string
                $str = " \$\$ = cat_str(" . $cnt;

                for ($z = 0; $z < $cnt; $z++) {
                    $str = $str . ',' . $flds_new{$z};
                }
                $str = $str . ');';
                &add_to_buffer('rules', $str);
            }
            if ($literal_mode == 0) {
                &add_to_buffer('rules', '}');
            }
        }
    }
    else {
        # we're in the stmt: rule
        if ($len) {
            # or just the statement ...
            &add_to_buffer('rules', " { output_statement(\$1, 0, ECPGst_normal); }");
        }
        else {
            &add_to_buffer('rules', " { \$\$ = NULL; }");
        }
    }
}

sub generate_block {
    local($line) = @_;
    $block = $non_term_id . $line;
    $s = ' ', $block =~ s/$s//g;
    $s = "\\|", $block =~ s/$s//g;
    return $block;
}

sub dump_line {
    local($stmt_mode, $fields, $field_count) = @_;
    $block = &generate_block($line);
    if ($replace_line{$block} eq 'ignore') {
        return 0;
    }
    elsif ($replace_line{$block}) {
        if (index($line, '|') != 0) {
            $line = '| ' . $replace_line{$block};
        }
        else {
            $line = $replace_line{$block};
        }
        $block = &generate_block($line);
    }
    &add_to_buffer('rules', $line);
    $i = &include_stuff('rules', 'ecpg.addons', $block, 0, $field_count);
    if ($i == 0) {
        &dump_fields($stmt_mode, *fields, $field_count, ' { ');
    }
    return 1;
}

sub Getline2 {
    &Pick('',@_);
    if ($getline_ok = (($_ = <$fh>) ne '')) {
        chomp;  # strip record separator
        @Fld = split(' ', $_, -1);
    }
    $_;
}

sub Pick {
    local($mode,$name,$pipe) = @_;
    $fh = $name;
    open($name,$mode.$name.$pipe) unless $opened{$name}++;
}