Created
November 29, 2011 10:44
-
-
Save jnthn/1404379 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
my class LSM { | |
has Cool $!source is readonly; | |
has @!substitutions; | |
has Int $!index = 0; | |
has Int $!next_match; | |
has $!next_substitution; | |
has $!substitution_length; | |
has Str $.unsubstituted_text; | |
has Str $.substituted_text; | |
submethod BUILD(:$!source) { } | |
method add_substitution($key, $value) { | |
push @!substitutions, $key => $value; | |
} | |
submethod compare_substitution($substitution, Int $pos, Int $length) { | |
if $!next_match > $pos | |
|| $!next_match == $pos && $!substitution_length < $length { | |
$!next_match = $pos; | |
$!substitution_length = $length; | |
$!next_substitution = $substitution; | |
} | |
} | |
multi submethod triage_substitution($_ where { .key ~~ Regex }) { | |
my $key = .key; | |
return unless $!source.substr($!index) ~~ $key; | |
self.compare_substitution($_, $!index + $/.from, $/.to - $/.from); | |
} | |
multi submethod triage_substitution($_ where { .key ~~ Cool }) { | |
return unless defined index($!source, .key, $!index); | |
self.compare_substitution($_, | |
index($!source, .key, $!index), | |
.key.chars); | |
} | |
multi submethod triage_substitution($_) { | |
die "Don't know how to handle a {.WHAT.gist} as a substitution key"; | |
} | |
multi submethod increment_index(Regex $s) { | |
$!source.substr($!index) ~~ $s; | |
$!index = $!next_match + $/.chars; | |
} | |
multi submethod increment_index(Cool $s) { | |
$!index = $!next_match + $s.chars; | |
} | |
method next_substitution() { | |
$!next_match = $!source.chars; | |
for @!substitutions { | |
self.triage_substitution($_); | |
} | |
$!unsubstituted_text | |
= $!source.substr($!index, $!next_match - $!index); | |
if defined $!next_substitution { | |
my $result = $!next_substitution.value; | |
$!substituted_text | |
= $result ~~ Callable ?? $result() !! $result; | |
self.increment_index($!next_substitution.key); | |
} | |
return $!next_match < $!source.chars; | |
} | |
} | |
sub trans($self, *@changes) { | |
my sub expand($s) { | |
return $s.list if $s ~~ Iterable|Positional; | |
gather for $s.comb(/ (\w) '..' (\w) | . /, :match) { | |
if .[0] { | |
take $_ for ~.[0] .. ~.[1]; | |
} else { | |
take ~$_; | |
} | |
} | |
} | |
my $lsm = LSM.new(:source($self)); | |
for (@changes) -> $p { | |
die "$p.perl() is not a Pair" unless $p ~~ Pair; | |
if $p.key ~~ Regex { | |
$lsm.add_substitution($p.key, $p.value); | |
} | |
elsif $p.value ~~ Callable { | |
my @from = expand $p.key; | |
for @from -> $f { | |
$lsm.add_substitution($f, $p.value); | |
} | |
} | |
else { | |
my @from = expand $p.key; | |
my @to = expand $p.value; | |
for @from Z (@to ?? @to xx ceiling(@from / @to) !! '' xx @from) -> $f, $t { | |
$lsm.add_substitution($f, $t); | |
} | |
} | |
} | |
my $r = ""; | |
while $lsm.next_substitution { | |
$r ~= $lsm.unsubstituted_text ~ $lsm.substituted_text; | |
} | |
$r ~= $lsm.unsubstituted_text; | |
return $r; | |
} | |
say trans("abc", "b" => "d"); | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment