jp.p6

my %kana_table = {
    'あ'=><あ　か　さ　た　な　は　ま　や　ら　わ　ん　が　ざ　だ　ば　ぱ>,
    'い'=>(|<い　き し ち に ひ み>,Nil,|<り ゐ>,Nil,|<ぎ じ ぢ び ぴ>),
    'う'=>(|<う　く　す　つ　ぬ　ふ　む　ゆ　る>,Nil,Nil,|<ぐ ず　づ　ぶ　ぷ>),
    'え'=>(|<え　け せ て ね へ め>,Nil,|<れ ゑ>,Nil,|<げ ぜ で べ ぺ>),
    'お'=>(|<お　こ　そ　と　の　ほ　も　よ　ろ　を>,Nil,|<ご ぞ　ど　ぼ　ぽ>)
};

my @godan = <う　つ　る　く　ぐ　ぶ　む　す>;

my @iru = %kana_table<い>.grep({defined $_});
my @eru = %kana_table<え>.grep({defined $_});

my regex ichidan { <?after @iru | @eru>'る'$ };

sub tail_tr(%table) {
    my @itms = %table.keys Z %table.values;
    return ({/ $^a $ / => $^b} for @itms);
}

sub conj_swap(Str $v1, Str $v2) {
    my @pairs = %kana_table{$v1} Z=> %kana_table{$v2};
    my %filt = @pairs.grep({defined $_.value and defined $_.key});
    return tail_tr(%filt);
}

sub verb_class(Str $λ) {
    given $λ {
	when &ichidan {return 2}
	when / 'する'$ / {return 3}
	when / 'くる'$ / {return 4}
	when / @godan $ / {return 1}
	default {return Nil}
    }
}

module Polite {
    my sub _base(Str $λ = CALLER::<$_>) {
	my $s;
	if (verb_class($λ) == 2) {
	    $s = S/ 'る' $ // given $λ;
	}
	else {
	    $s = $λ.trans(conj_swap('う','い'));
	}
	return $s ~ 'ま';
    }

    our &Present = { _base ~ 'す' };
    our &Past = { _base ~ 'した' };
    our &Negative = { _base ~ 'せん' };
    our &PastNegative = { _base ~ 'せんでした' };
    our &Volitional = { _base ~ 'しょう' };
    our &Conjunctive = { _base ~ 'して' };
    our &Conditional = { _base ~ 'すれば' };
    our &Imperative = { _base ~ 'せ' }; # Not generally used
}