From: Steve Hancock Date: Thu, 21 Apr 2022 19:39:25 +0000 (-0700) Subject: some minor optimizations X-Git-Tag: 20220613~52 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e75aac65ad3b920357c305eee08a474cd8bd3fec;p=perltidy.git some minor optimizations --- diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index b069f395..9ebdda8b 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -2502,14 +2502,24 @@ sub initialize_whitespace_hashes { } ## end initialize_whitespace_hashes -# The following hash is used to skip over needless if tests. -# Be sure to update it when adding new checks in its block. my %is_special_ws_type; +my %is_wCUG; +my %is_wi; BEGIN { + + # The following hash is used to skip over needless if tests. + # Be sure to update it when adding new checks in its block. my @q = qw(k w i C m - Q); push @q, '#'; @is_special_ws_type{@q} = (1) x scalar(@q); + + # These hashes replace slower regex tests + @q = qw( w C U G ); + @is_wCUG{@q} = (1) x scalar(@q); + + @q = qw( w i ); + @is_wi{@q} = (1) x scalar(@q); } use constant DEBUG_WHITE => 0; @@ -2563,8 +2573,6 @@ sub set_whitespace_flags { $rtokh->[_TYPE_SEQUENCE_] = ''; $rtokh->[_LINE_INDEX_] = 0; - my ($ws); - # This is some logic moved to a sub to avoid deep nesting of if stmts my $ws_in_container = sub { @@ -2655,7 +2663,7 @@ sub set_whitespace_flags { my ( $ws_1, $ws_2, $ws_3, $ws_4 ); # main loop over all tokens to define the whitespace flags - for ( my $j = 0 ; $j <= $jmax ; $j++ ) { + foreach my $j ( 0 .. $jmax ) { if ( $rLL->[$j]->[_TYPE_] eq 'b' ) { $rwhitespace_flags->[$j] = WS_OPTIONAL; @@ -2672,7 +2680,7 @@ sub set_whitespace_flags { $token = $rtokh->[_TOKEN_]; $type = $rtokh->[_TYPE_]; - $ws = undef; + my $ws; #--------------------------------------------------------------- # Whitespace Rules Section 1: @@ -2756,11 +2764,93 @@ sub set_whitespace_flags { #--------------------------------------------------------------- # Whitespace Rules Section 2: + # Special checks for certain types ... + #--------------------------------------------------------------- + # The hash '%is_special_ws_type' significantly speeds up this routine, + # but be sure to update it if a new check is added. + # Currently has types: qw(k w i C m - Q #) + if ( $is_special_ws_type{$type} ) { + if ( $type eq 'i' ) { + + # never a space before -> + if ( substr( $token, 0, 2 ) eq '->' ) { + $ws = WS_NO; + } + } + + elsif ( $type eq 'k' ) { + + # Keywords 'for', 'foreach' are special cases for -kpit since + # the opening paren does not always immediately follow the + # keyword. So we have to search forward for the paren in this + # case. I have limited the search to 10 tokens ahead, just in + # case somebody has a big file and no opening paren. This + # should be enough for all normal code. Added the level check + # to fix b1236. + if ( $is_for_foreach{$token} + && %keyword_paren_inner_tightness + && defined( $keyword_paren_inner_tightness{$token} ) + && $j < $jmax ) + { + my $level = $rLL->[$j]->[_LEVEL_]; + my $jp = $j; + for ( my $inc = 1 ; $inc < 10 ; $inc++ ) { + $jp++; + last if ( $jp > $jmax ); + last if ( $rLL->[$jp]->[_LEVEL_] != $level ); # b1236 + next unless ( $rLL->[$jp]->[_TOKEN_] eq '(' ); + my $seqno_p = $rLL->[$jp]->[_TYPE_SEQUENCE_]; + $set_container_ws_by_keyword->( $token, $seqno_p ); + last; + } + } + } + + # retain any space between '-' and bare word + elsif ( $type eq 'w' || $type eq 'C' ) { + $ws = WS_OPTIONAL if $last_type eq '-'; + + # never a space before -> + if ( substr( $token, 0, 2 ) eq '->' ) { + $ws = WS_NO; + } + } + + # retain any space between '-' and bare word; for example + # avoid space between 'USER' and '-' here: <> + # $myhash{USER-NAME}='steve'; + elsif ( $type eq 'm' || $type eq '-' ) { + $ws = WS_OPTIONAL if ( $last_type eq 'w' ); + } + + # always space before side comment + elsif ( $type eq '#' ) { $ws = WS_YES if $j > 0 } + + # space_backslash_quote; RT #123774 <> + # allow a space between a backslash and single or double quote + # to avoid fooling html formatters + elsif ( $last_type eq '\\' && $type eq 'Q' && $token =~ /^[\"\']/ ) + { + if ($rOpts_space_backslash_quote) { + if ( $rOpts_space_backslash_quote == 1 ) { + $ws = WS_OPTIONAL; + } + elsif ( $rOpts_space_backslash_quote == 2 ) { $ws = WS_YES } + else { } # shouldnt happen + } + else { + $ws = WS_NO; + } + } + } ## end elsif ( $is_special_ws_type{$type} ... + + #--------------------------------------------------------------- + # Whitespace Rules Section 3: # Handle space on inside of closing brace pairs. #--------------------------------------------------------------- # /[\}\)\]R]/ - if ( $is_closing_type{$type} ) { + elsif ( $is_closing_type{$type} ) { my $seqno = $rtokh->[_TYPE_SEQUENCE_]; if ( $j == $j_tight_closing_paren ) { @@ -2794,10 +2884,8 @@ sub set_whitespace_flags { } ## end setting space flag inside closing tokens #--------------------------------------------------------------- - # Whitespace Rules Section 3: - # Handle some special cases. + # Whitespace Rules Section 4: #--------------------------------------------------------------- - # /^[L\{\(\[]$/ elsif ( $is_opening_type{$type} ) { @@ -2847,9 +2935,11 @@ sub set_whitespace_flags { # repeated parens, like () () (), as in case c017, but I # decided that would not be a good idea. elsif ( - $last_type =~ /^[wCUG]$/ + ##$last_type =~ /^[wCUG]$/ + $is_wCUG{$last_type} || ( - $last_type =~ /^[wi]$/ + ##$last_type =~ /^[wi]$/ + $is_wi{$last_type} && ( $last_token =~ /^([\&]|->)/ @@ -2912,85 +3002,6 @@ sub set_whitespace_flags { } } ## end if ( $is_opening_type{$type} ) { - # Special checks for certain other types ... - # the hash '%is_special_ws_type' significantly speeds up this routine, - # but be sure to update it if a new check is added. - # Currently has types: qw(k w i C m - Q #) - elsif ( $is_special_ws_type{$type} ) { - if ( $type eq 'i' ) { - - # never a space before -> - if ( substr( $token, 0, 2 ) eq '->' ) { - $ws = WS_NO; - } - } - - elsif ( $type eq 'k' ) { - - # Keywords 'for', 'foreach' are special cases for -kpit since - # the opening paren does not always immediately follow the - # keyword. So we have to search forward for the paren in this - # case. I have limited the search to 10 tokens ahead, just in - # case somebody has a big file and no opening paren. This - # should be enough for all normal code. Added the level check - # to fix b1236. - if ( $is_for_foreach{$token} - && %keyword_paren_inner_tightness - && defined( $keyword_paren_inner_tightness{$token} ) - && $j < $jmax ) - { - my $level = $rLL->[$j]->[_LEVEL_]; - my $jp = $j; - for ( my $inc = 1 ; $inc < 10 ; $inc++ ) { - $jp++; - last if ( $jp > $jmax ); - last if ( $rLL->[$jp]->[_LEVEL_] != $level ); # b1236 - next unless ( $rLL->[$jp]->[_TOKEN_] eq '(' ); - my $seqno_p = $rLL->[$jp]->[_TYPE_SEQUENCE_]; - $set_container_ws_by_keyword->( $token, $seqno_p ); - last; - } - } - } - - # retain any space between '-' and bare word - elsif ( $type eq 'w' || $type eq 'C' ) { - $ws = WS_OPTIONAL if $last_type eq '-'; - - # never a space before -> - if ( substr( $token, 0, 2 ) eq '->' ) { - $ws = WS_NO; - } - } - - # retain any space between '-' and bare word; for example - # avoid space between 'USER' and '-' here: <> - # $myhash{USER-NAME}='steve'; - elsif ( $type eq 'm' || $type eq '-' ) { - $ws = WS_OPTIONAL if ( $last_type eq 'w' ); - } - - # always space before side comment - elsif ( $type eq '#' ) { $ws = WS_YES if $j > 0 } - - # space_backslash_quote; RT #123774 <> - # allow a space between a backslash and single or double quote - # to avoid fooling html formatters - elsif ( $last_type eq '\\' && $type eq 'Q' && $token =~ /^[\"\']/ ) - { - if ($rOpts_space_backslash_quote) { - if ( $rOpts_space_backslash_quote == 1 ) { - $ws = WS_OPTIONAL; - } - elsif ( $rOpts_space_backslash_quote == 2 ) { $ws = WS_YES } - else { } # shouldnt happen - } - else { - $ws = WS_NO; - } - } - } ## end elsif ( $is_special_ws_type{$type} ... - # always preserver whatever space was used after a possible # filehandle (except _) or here doc operator if ( @@ -6740,7 +6751,7 @@ sub respace_tokens { # Loop to copy all tokens on this line, with any changes #------------------------------------------------------- my $type_sequence; - for ( my $KK = $Kfirst ; $KK <= $Klast ; $KK++ ) { + foreach my $KK ( $Kfirst .. $Klast ) { $Ktoken_vars = $KK; $rtoken_vars = $rLL->[$KK]; my $token = $rtoken_vars->[_TOKEN_]; @@ -7067,7 +7078,7 @@ EOM # Walk backwards through the tokens, making forward links to sequence items. if ( @{$rLL_new} ) { my $KNEXT; - for ( my $KK = @{$rLL_new} - 1 ; $KK >= 0 ; $KK-- ) { + foreach my $KK ( reverse( 0 .. @{$rLL_new} - 1 ) ) { $rLL_new->[$KK]->[_KNEXT_SEQ_ITEM_] = $KNEXT; if ( $rLL_new->[$KK]->[_TYPE_SEQUENCE_] ) { $KNEXT = $KK } } @@ -14484,7 +14495,7 @@ EOM @unmatched_opening_indexes_in_this_batch = (); - for ( my $i = 0 ; $i <= $max_index_to_go ; $i++ ) { + foreach my $i ( 0 .. $max_index_to_go ) { $iprev_to_go[$i] = $ilast_nonblank; $inext_to_go[$i] = $i + 1; diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 200dc0d6..a0f54cf8 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -2787,7 +2787,7 @@ EOM ##################################################### # Loop over lines to remove unwanted alignment tokens ##################################################### - for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) { + foreach my $jj ( $jbeg .. $jend ) { my $line = $rnew_lines->[$jj]; my $rtokens = $line->get_rtokens(); my $rhash = $rline_hashes->[$jj]; @@ -2801,7 +2801,7 @@ EOM $saw_large_group ||= $nlines > 2 && $imax > 1; # Loop over all alignment tokens - for ( my $i = 0 ; $i <= $imax ; $i++ ) { + foreach my $i ( 0 .. $imax ) { my $tok = $rtokens->[$i]; next if ( $tok eq '#' ); # shouldn't happen my ( $iii, $il, $ir, $raw_tok, $lev, $tag, $tok_count ) = @@ -3056,7 +3056,7 @@ sub delete_null_alignments { $j_match_end = $jj; # Keep track of any padding that would be needed for each token - for ( my $i = 0 ; $i <= $imax ; $i++ ) { + foreach my $i ( 0 .. $imax ) { next if ( $rneed_pad->[$i] ); my $length = $rfield_lengths->[$i]; my $length_match = $rfield_lengths_match->[$i];