Using PadWalker in a overload sub turned out to be problematic. The sub that overloads tr's operands cannot access the content of $x in such situation:

{
    my $x = 'abc;
    my $s = 'edcba';
    eval '$s =~ tr/$x/123/';
}
{
   my $x = 'ABC';
}
[download]

peek_my(1)->{'$x'} then gives \undef. Though I could work around this, I abandoned this approach and came to something similar: A generator for a sub, that can be used like tr/$x/$y/$opt without eval'ing $x and $y.

After I put this together I realized that something similar already exists: Regexp::Tr. However, the tr-arguments are eval'ed there.

Here is demo with all parts in a single file:

#!/usr/bin/perl

use strict;
use warnings;

### Internal only
package String::Compile::Tr::Overload;

use overload;

sub _ovl_tr {
    our ($search, $replace);

    return $_[1] unless $_[2] eq 'tr';
    return "$search" if $_[1] eq ':search:';
    return "$replace" if $_[1] eq ':replace:';
    
    $_[1];
}

sub import {
    overload::constant q => \&_ovl_tr;
}

sub unimport {
    overload::remove_constant q => \&_ovl_tr;
}

### The module itself
package String::Compile::Tr;

*search = *String::Compile::Tr::Overload::search;
*replace = *String::Compile::Tr::Overload::replace;

BEGIN {
    String::Compile::Tr::Overload->import;
}

sub trgen {
    local our ($search, $replace);
    my $options;
    ($search, $replace, $options) = @_;
    $options = '' unless defined $options;
    my ($opt) = $options =~ /^([cdsr]*)$/;
    $opt = '' unless defined $opt;
    my $template = <<'EOS';
    sub {
        local *_ = \$_[0] if @_;
        tr/:search:/:replace:/%s;
    }
EOS
    my $code = sprintf $template, $opt;

    eval $code;
}

BEGIN {
    String::Compile::Tr::Overload->unimport;
}

### main
package main;

use feature 'say';

*trgen = *String::Compile::Tr::trgen;

my $x = 'abc';
my $y = '123';

# compile a sub
my $tr = trgen($x, $y);

my $str = 'fedcba';
# like $str =~ tr/abc/123/:
$tr->($str);
say $str;   # fed321

my @list = qw(axy bxy cxy);
# like tr/abc/123/
$tr->() for @list;
say "(@list)";   # (1xy 2xy 3xy);
[download]