big_code_analysis_ast/getter/

perl.rs

//! `Getter` implementation for Perl.
#![allow(clippy::wildcard_imports, clippy::enum_glob_use)]

use super::*;
use crate::lang_helpers::perl::{
    perl_and_is_operator, perl_bareword_key_sign, perl_dash_signs_key, perl_file_test_is_dash_key,
    perl_is_dash_key_word, perl_key_is_signed, perl_not_is_key,
};

impl Getter for PerlCode {
    fn get_space_kind(node: &Node) -> SpaceKind {
        match node.kind_id().into() {
            Perl::FunctionDefinition
            | Perl::FunctionDefinitionWithoutSub
            | Perl::AnonymousFunction => SpaceKind::Function,
            Perl::SourceFile => SpaceKind::Unit,
            _ => SpaceKind::Unknown,
        }
    }

    fn get_op_type<'a>(node: &Node<'a>, ancestors: Ancestors<'a, '_>) -> TokenRole {
        use Perl as P;

        if let Some(role) = auto_quoted_key_role(node, ancestors) {
            return role;
        }
        match node.kind_id().into() {
            // Regex delimiter punctuation. The bare match form is the
            // only one of Perl's five regex literals that spells its
            // delimiters with an operator token kind: `bca dump` at the
            // pinned grammar shows `/abc/` emitting two `SLASH` under
            // `PatternMatcher`, while `m//`, `qr//`, `s///` and `tr///`
            // use the dedicated `StartDelimiter` / `SeparatorDelimiter`
            // / `EndDelimiter` kinds that no arm here classifies. So
            // `$s =~ /abc/` fabricated two division operators (#1312,
            // the Perl sibling of Elixir #1256). Suppress them exactly
            // when their parent is the literal — the compound-leaf
            // guard of grammar-dispatch §5 — which leaves the bare form
            // contributing what its three synonyms already contribute
            // (#1314 made that "one operand" rather than "nothing";
            // see the pattern-value arm below).
            P::SLASH
                if ancestors.parent_has_kind(node, P::PatternMatcher as u16) =>
            {
                TokenRole::Unknown
            }
            // The bare form's pattern text is one operand, billed on the
            // `PatternMatcher` wrapper, but the grammar spells four of its
            // characters as anonymous tokens under `regex_pattern_content`:
            // `[`, `]`, `\` and `#`. They are literal regex text, which
            // `m//` and `qr//` emit no node for, so `/[a]/` billed a `[]`
            // operator that `m/[a]/` does not (#1549). `#` is also in no
            // operator arm, because its only other position is a comment's
            // leading `#` under `comments`, and a comment is not code.
            // `$#a` and the `#` delimiters of `qw#…#` / `s#a#b#` are
            // distinct token kinds.
            _ if ancestors.parent_has_kind(node, P::RegexPatternContent as u16) => {
                TokenRole::Unknown
            }
            // Control-flow and declaration keywords. `Perl::Sub` is the
            // `sub` keyword (token id 16); `Perl::SUB` is the `__SUB__`
            // literal (token id 7) — that one is an operand, not an
            // operator. Same split for `Package` (keyword) vs `PACKAGE`
            // (`__PACKAGE__` literal).
            P::If | P::Unless | P::Else | P::Elsif | P::While | P::Until | P::For
            | P::Foreach | P::When | P::Continue | P::Next | P::Last | P::Redo | P::Goto
            | P::Return | P::Sub | P::Package | P::My | P::Our
            | P::Local | P::State | P::Use | P::No | P::Require | P::Bless | P::And | P::Or
            | P::Xor | P::Not | P::Eq | P::Ne | P::Lt | P::Gt | P::Le | P::Ge | P::Cmp
            // Punctuation acting as operators
            | P::SEMI | P::COMMA | P::COLON | P::COLONCOLON | P::LBRACE | P::LBRACK
            | P::LPAREN | P::DOT | P::DOTDOT | P::DOTDOTDOT | P::FatComma | P::DASHGT
            | P::QMARK | P::BSLASH | P::DOLLAR | P::DOLLARHASH | P::AT | P::PERCENT
            // Arithmetic / comparison / logical / bitwise / assignment operators
            | P::EQ | P::PLUS | P::DASH | P::STAR | P::SLASH | P::STARSTAR | P::BANG
            | P::TILDE | P::EQTILDE | P::BANGTILDE | P::EQEQ | P::BANGEQ | P::LT | P::GT
            | P::LTEQ | P::GTEQ | P::AMPAMP | P::PIPEPIPE | P::SLASHSLASH | P::PIPE
            | P::CARET | P::LTLT | P::GTGT | P::TILDETILDE | P::PLUSPLUS | P::DASHDASH
            | P::PLUSEQ | P::DASHEQ | P::STAREQ | P::SLASHEQ | P::PERCENTEQ | P::STARSTAREQ
            | P::AMPEQ | P::PIPEEQ | P::CARETEQ | P::LTLTEQ | P::GTGTEQ | P::AMPAMPEQ
            | P::PIPEPIPEEQ | P::SLASHSLASHEQ | P::DOTEQ | P::XEQ
            | P::LTEQGT | P::AMPDOTEQ | P::PIPEDOTEQ | P::CARETDOTEQ | P::Isa
            // Substitution and transliteration. These are *operations
            // applied to a target*, not pattern values, so they are
            // operators while the three pattern spellings below are
            // operands (#1314). `y///` is a synonym of `tr///` and
            // shares `TransliterationTrOrY`, so the two fold to one
            // entry, which is what synonyms should do.
            //
            // Their *literal* pattern and replacement text is
            // invisible either way: `bca dump` shows `s/a/b/` emitting
            // only the `s` keyword and its `start` / `separator` /
            // `end` delimiters, with no content node, so classifying
            // them as operators loses nothing that treating them as
            // values would have kept. An *interpolated* `s/$x/$y/` does
            // emit `Interpolation` children, and those count as
            // operands under either choice — so the reason for the
            // split is the semantic one above, not this. `get_operator_id_as_str` below renders them
            // `s///` and `tr///` rather than as raw kind names.
            | P::SubstitutionPatternS | P::TransliterationTrOrY
                => TokenRole::Operator,
            // `package_name`, `package_variable` and `typeglob` each
            // spell a whole name — `Data::Dumper`, `$Foo::count`,
            // `*STDOUT` — and are operands in their own right below, so
            // an operand-classified node they *contain* is already
            // billed by the wrapper. Before #1355 the wrapper and its
            // contents both counted: `use strict;` scored N2 2 for one
            // name, `require Data::Dumper;` n2 3 / N2 3 for one, and
            // `our $Foo::count = 3;` n2 5 / N2 6 for two — the
            // vocabulary even growing a bare `::` entry, because a
            // `package_variable` spells its separator as a second,
            // childless `package_name` beside the qualifier.
            //
            // Keyed on the parent alone rather than on a list of child
            // kinds, because the invariant is positional: a wrapper's
            // span contains its children's, so whatever sits directly
            // inside one is already paid for. node-types.json admits ten
            // (wrapper, child) pairings across eight operand kinds, all
            // of them reachable — `package_name` ⊃ `typeglob` is
            // `*Foo::glob`, `package_name` ⊃ `package_variable` the
            // `$Foo::Bar::baz` nesting — and enumerating them here would
            // be a coverage claim to re-derive on every grammar bump for
            // no gain, the trade grammar-dispatch §1 recommends taking.
            // `perl_name_wrappers_bill_the_name_once_1355` witnesses all
            // ten and fails on an eleventh. Naming the three wrappers as
            // *parents* also resolves arbitrary qualifier depth to the
            // outermost, the way PHP handles `$$$x` (#1259).
            //
            // It sits below the operator arm on purpose: the `::` token
            // inside a bareword `package_name` (`Data::Dumper`), and `*`
            // and the opening `{` inside a `typeglob`, are matched there
            // and keep their operator reading. A sigil-qualified name
            // has no such token — its separator is the childless
            // `package_name` above, which the guard drops with the rest
            // of the wrapper — so `$Foo::count` bills no `::` where
            // `Data::Dumper` bills one. That asymmetry is the grammar's:
            // `main` billed that node as a bogus `::` operand and never
            // as an operator, so n1/N1 are unchanged here. The typeglob
            // `*` stays an operator because this getter already bills
            // the `$` sigil on every scalar reference (`my $x` → n1
            // {my, $, =, ;}), so the typeglob sigil follows the sigil
            // convention rather than #1312's delimiter suppression; the
            // cost is that it shares `Perl::STAR` with multiplication,
            // so both fold into one n1 entry, and `*Foo` and `*{Foo}`
            // differ by one `{}` operator. (The closing `}` has never
            // been classified — `get_operator_id_as_str` folds the pair
            // to one `{}` glyph — so the guard changes nothing for it.)
            //
            // Guarded, not deleted, per grammar-dispatch §6: these
            // leaves are ordinary operands everywhere else (`my $x`,
            // `foo()`, the `bar` of `Foo::bar()`, which is a *sibling*
            // of the `package_name` rather than a child).
            //
            // Keeping the wrapper's whole span is the opposite call from
            // PHP's `qualified_name` (#1293) and Groovy's
            // `QualifiedName` (#1263 / #1352), which bill the leaves and
            // drop the wrapper. Three reasons it goes the other way in
            // Perl. `package_variable` and `typeglob` are sigil-bearing
            // *variable references*, the shape #1259 settled by keeping
            // the wrapper — the leaves-only reading detaches the sigil
            // from the variable and glues it to the qualifier, billing
            // `$Foo::Bar::baz` as `$Foo` + `Bar` + `baz`, three operands
            // for one variable. The three kinds nest into each other, so
            // they must be decided together; splitting `package_name`
            // off would need a grandparent-aware guard. And the
            // vocabulary-sharing argument of #1293 / #1352 — that
            // `java.util.List` and `List` name the same class — has no
            // Perl analogue, since a package is always spelled in full.
            //
            // `module_name` is not here, though #1355 expected it to
            // be: it is the quoted `use 'Foo.pm'` form, and it holds
            // nothing but its two quote tokens — not the `identifier`
            // the issue thought it shared. It stays an operand, pinned
            // by `perl_qualified_name_leaves_still_count_elsewhere_1355`.
            _ if matches!(
                ancestors.parent(node).map(|p| p.kind_id().into()),
                Some(P::PackageName | P::PackageVariable | P::Typeglob)
            ) =>
            {
                TokenRole::Unknown
            }
            // Operands: identifiers and literals. Non-interpolating
            // string literals (`'…'`, `q{…}`) are leaf operands; the
            // interpolating kinds (`"…"`, `qq{…}`, `` `…` ``, `qx{…}`)
            // are handled separately below so their inner
            // scalar/array/hash variables are not double-counted.
            //
            // `ListItem` is one element of a `qw(a b c)` list — a leaf
            // the grammar emits under `word_list_qw` and nowhere else,
            // so it cannot double-bill another construct. Until it was
            // listed the whole `qw()` was invisible to Halstead: neither
            // the elements nor the wrapper nor the `qw` keyword had an
            // arm, so `my @a = qw(a b c)` billed `@a` alone while its
            // synonym `("a", "b", "c")` billed four operands. The
            // wrapper is gated below, the Ruby `%w[]` shape of #1353.
            P::Identifier | P::ScalarVariable | P::ArrayVariable | P::HashVariable
            | P::PackageVariable | P::SpecialScalarVariable | P::PackageName | P::ModuleName
            | P::BarewordImport | P::Typeglob | P::FileHandle | P::ListItem
            | P::Integer | P::FloatingPoint | P::ScientificNotation | P::Hexadecimal | P::Octal
            | P::True | P::False | P::SpecialLiteral
            | P::StringSingleQuoted | P::StringQQuoted
            | P::FILE | P::LINE | P::SUB | P::PACKAGE
                => TokenRole::Operand,
            // Perl's interpolating string-like literals count as one
            // operand when inert. When they carry an `Interpolation`
            // child the inner scalar / array / hash variables are
            // already walked and classified as operands; counting the
            // wrapping literal too would double-count the inner
            // variables' contribution to `N2` (issue #199, same
            // pattern as #180 for Elixir/Bash, #183 for C#, #184 for
            // PHP, #191 for Kotlin). `HeredocBodyStatement` is the
            // visible body of `<<TAG ... TAG` heredocs (issue #287);
            // it is interpolation-capable, so it joins the same
            // dispatch — inert heredocs are one operand, interpolating
            // heredocs let the inner variables carry the count.
            // The pattern *values* — `/abc/`, `m/abc/`, `qr/abc/` —
            // join the same dispatch (#1314). `m/abc/` is exactly
            // `/abc/` and `qr/abc/` is the same pattern as a value, so
            // all three must score alike; that equality is what
            // `perl_every_pattern_value_spelling_scores_alike` protects
            // and why #1312 declined to promote the bare form on its
            // own. Promoting the three together closes the gap without
            // reintroducing the spelling sensitivity: each contributes
            // one operand, matching Ruby's `Regex` and Elixir's
            // `Sigil`. `s///` and `tr///` are *not* here — they are
            // operations applied to a target and sit in the operator
            // arm above.
            //
            // Sharing the string dispatch is not incidental, which is
            // why the arms are merged rather than duplicated: the bare
            // form keeps an interpolated variable inside an
            // unclassified `regex_pattern_content`, but `m/$x/` and
            // `qr/$x/` emit a real `Interpolation` whose
            // `scalar_variable` is already counted. A plain operand arm
            // would score `/$x/` at one operand and `m/$x/` at two —
            // the very divergence the equality above exists to prevent.
            //
            // `WordListQw` holds classified `ListItem` operands rather
            // than interpolation, so the same guard gives it "one
            // operand per element, or one for the empty `qw()`" — the
            // rule #1353 settled for Ruby's `%w[]`. One list serves
            // both groups because no string kind admits a `list_item`
            // and `word_list_qw` admits no `interpolation`.
            P::StringDoubleQuoted | P::StringQqQuoted | P::BacktickQuoted
            | P::CommandQxQuoted | P::HeredocBodyStatement
            | P::PatternMatcher | P::PatternMatcherM | P::RegexPatternQr | P::WordListQw => {
                Self::string_operand_type(node, &[P::Interpolation as u16, P::ListItem as u16])
            }
            _ => TokenRole::Unknown,
        }
    }

    /// Spells a `-bareword` key whole (#1545). A key that is exactly a
    /// file test (`(-x => 1)`) has swallowed the `=>` and the value into
    /// its node, so the key is the sign and the word after it; a
    /// `-and` / `-not` key gets back the sign its `-` token stopped
    /// billing, spelled the same however the two are spaced, since Perl
    /// keys `(- not => 1)` as `"-not"` too. The sign is read off the tree
    /// (`perl_key_is_signed`), not the byte before the key, which can
    /// equally be an infix `-` or the end of a comment.
    ///
    /// Any other `-bareword` key (`(-name => 1)`, `$h{-name}`) bills its
    /// word spelled from the sign (#1572). That is a source slice, so a
    /// sign spaced off its word (`(- name => 1)`, rare) keeps the space,
    /// and a comment between the two (`(- # c⏎ name => 1)`) is carried
    /// along in it: one operand, distinct from `name`, but not merged
    /// with `-name`, and listed by `bca ops` as written.
    fn get_operand_id<'a>(
        node: &Node<'a>,
        code: &'a [u8],
        ancestors: Ancestors<'a, '_>,
    ) -> &'a [u8] {
        let (start, end) = (node.start_byte(), node.end_byte());
        match node.kind_id().into() {
            Perl::FileHandleOperator => {
                let word = code[start + 1..end]
                    .iter()
                    .take_while(|byte| byte.is_ascii_alphanumeric() || **byte == b'_')
                    .count();
                &code[start..=start + word]
            }
            Perl::And if perl_key_is_signed(node, ancestors) => b"-and",
            Perl::Not if perl_key_is_signed(node, ancestors) => b"-not",
            Perl::Identifier => perl_bareword_key_sign(node, ancestors)
                .map_or(&code[start..end], |dash| &code[dash.start_byte()..end]),
            _ => &code[start..end],
        }
    }

    /// Folds paired delimiters to one glyph, and names the two
    /// pattern *operations* after their source spelling.
    ///
    /// Hand-written rather than `get_operator!(Perl)` because
    /// `SubstitutionPatternS` and `TransliterationTrOrY` are named
    /// nodes rather than punctuation tokens (#1314): the macro's
    /// fallback renders a kind's own name, so `bca ops` would list
    /// `substitution_pattern_s` and `transliteration_tr_or_y` among
    /// the operators, which reads as a bug rather than as `s///`.
    /// `tr///` covers `y///` too — one kind, one glyph, because they
    /// are synonyms. `=>` is the named `fat_comma` node for the same
    /// reason.
    #[inline]
    fn get_operator_id_as_str(id: u16) -> &'static str {
        let typ = id.into();
        match typ {
            Perl::LPAREN => "()",
            Perl::LBRACK => "[]",
            Perl::LBRACE => "{}",
            Perl::SubstitutionPatternS => "s///",
            Perl::TransliterationTrOrY => "tr///",
            Perl::FatComma => "=>",
            _ => typ.into(),
        }
    }
}

/// The role of a token tree-sitter-perl 1.1.2 misparses inside an
/// auto-quoted hash key, or `None` for any other token. Perl quotes a
/// bareword before `=>` and alone in a hash subscript, keywords and a
/// leading `-` included, and the grammar reads some of those keys as
/// operators. Every arm is an upstream workaround; drop each with its
/// issue once the pin carries the fix.
fn auto_quoted_key_role<'a>(node: &Node<'a>, ancestors: Ancestors<'a, '_>) -> Option<TokenRole> {
    use Perl as P;

    let role = match node.kind_id().into() {
        // FIXME(#1539 upstream): an auto-quoted `and` key (`$h{and}`,
        // `(and => 1)`) lexes as the operator keyword. It is a
        // string key, so it bills what `$h{or}` bills: the
        // `identifier` operand the grammar gives every other
        // bareword key.
        P::And
            if !ancestors
                .parent(node)
                .is_some_and(|parent| perl_and_is_operator(node, &parent)) =>
        {
            TokenRole::Operand
        }
        // FIXME(#1541 upstream): the same for an auto-quoted `not`
        // key (`$h{not}`, `(not => 1)`); see `perl_not_is_key`.
        P::Not
            if ancestors
                .parent(node)
                .is_some_and(|parent| perl_not_is_key(node, &parent)) =>
        {
            TokenRole::Operand
        }
        // FIXME(#1545 upstream): a `-bareword` key (`$h{-foo}`,
        // `(-text => 1)`) lexes as a file test on the rest of the
        // word. It is one string key, so the test node bills it as
        // one operand spelling the whole key, and the word inside
        // bills nothing. A `-and` / `-not` key splits instead into
        // a `-` and the keyword, which the arms above bill as the
        // key, and any other `-bareword` key (`(-name => 1)`) into a
        // `-` and a bareword call, whose `identifier` bills the key
        // (#1572, the local workaround for upstream #1571); in both
        // the `-` is part of the key and bills nothing. See
        // `perl_file_test_is_dash_key` and `perl_bareword_is_key`.
        P::FileHandleOperator if perl_file_test_is_dash_key(node, ancestors) => TokenRole::Operand,
        P::Identifier
            if ancestors
                .iter(node)
                .next()
                .is_some_and(|(word, above)| perl_is_dash_key_word(&word, above)) =>
        {
            TokenRole::Unknown
        }
        P::DASH if perl_dash_signs_key(node, ancestors) => TokenRole::Unknown,
        _ => return None,
    };
    Some(role)
}