egison-3.3.16: lib/string/japanese.egi
(define $katakana?
(match-lambda char
{[,'ア' #t] [,'イ' #t] [,'ウ' #t] [,'エ' #t] [,'オ' #t]
[,'カ' #t] [,'キ' #t] [,'ク' #t] [,'ケ' #t] [,'コ' #t]
[,'サ' #t] [,'シ' #t] [,'ス' #t] [,'セ' #t] [,'ソ' #t]
[,'タ' #t] [,'チ' #t] [,'ツ' #t] [,'テ' #t] [,'ト' #t]
[,'ナ' #t] [,'ニ' #t] [,'ヌ' #t] [,'ネ' #t] [,'ノ' #t]
[,'ハ' #t] [,'ヒ' #t] [,'フ' #t] [,'ヘ' #t] [,'ホ' #t]
[,'マ' #t] [,'ミ' #t] [,'ム' #t] [,'メ' #t] [,'モ' #t]
[,'ヤ' #t] [,'ユ' #t] [,'ヨ' #t]
[,'ラ' #t] [,'リ' #t] [,'ル' #t] [,'レ' #t] [,'ロ' #t]
[,'ワ' #t] [,'ヲ' #t] [,'ン' #t]
[,'ガ' #t] [,'ギ' #t] [,'グ' #t] [,'ゲ' #t] [,'ゴ' #t]
[,'ザ' #t] [,'ジ' #t] [,'ズ' #t] [,'ゼ' #t] [,'ゾ' #t]
[,'ダ' #t] [,'ヂ' #t] [,'ヅ' #t] [,'デ' #t] [,'ド' #t]
[,'バ' #t] [,'ビ' #t] [,'ブ' #t] [,'ベ' #t] [,'ボ' #t]
[,'パ' #t] [,'ピ' #t] [,'プ' #t] [,'ペ' #t] [,'ポ' #t]
[,'ヴ' #t] [,'ヰ' #t] [,'ヱ' #t]
[,'ァ' #t] [,'ィ' #t] [,'ゥ' #t] [,'ェ' #t] [,'ォ' #t]
[,'ヵ' #t] [,'ヶ' #t]
[,'ャ' #t] [,'ュ' #t] [,'ョ' #t]
[,'ッ' #t] [,'ー' #t] [,'ヮ' #t]
[_ #f]}))
(define $katakanas?
(lambda [$s]
(all katakana? (unpack s))))
(define $katakana-to-yomi
(lambda [$s]
(match s string
{[<cons ,'ッ' $rs>
(katakana-to-yomi rs)]
[<cons ,'ー' $rs>
(katakana-to-yomi rs)]
[<cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c) <cons ,'ー' $rs>>
{(match c char {[,'ァ' "A"] [,'ィ' "I"] [,'ゥ' "U"] [,'ェ' "E"] [,'ォ' "O"]}) @(katakana-to-yomi rs)}]
[<cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c) $rs>
{(match c char {[,'ァ' "A"] [,'ィ' "I"] [,'ゥ' "U"] [,'ェ' "E"] [,'ォ' "O"]}) @(katakana-to-yomi rs)}]
[<cons (& (| ,'ャ' ,'ュ' ,'ョ') $c) <cons ,'ー' $rs>>
{@(match c char {[,'ャ' {"Y" "A"}] [,'ュ' {"Y" "U"}] [,'ョ' {"Y" "O"}]}) @(katakana-to-yomi rs)}]
[<cons (& (| ,'ャ' ,'ュ' ,'ョ') $c) $rs>
{@(match c char {[,'ャ' {"Y" "A"}] [,'ュ' {"Y" "U"}] [,'ョ' {"Y" "O"}]}) @(katakana-to-yomi rs)}]
[<cons $c1 <cons (& (| ,'ャ' ,'ュ' ,'ョ') $c2) <cons ,'ー' $rs>>>
(append (katakana-to-yomi-y-1 {c1 c2}) (katakana-to-yomi rs))]
[<cons $c1 <cons (& (| ,'ャ' ,'ュ' ,'ョ') $c2) $rs>>
(append (katakana-to-yomi-y-1 {c1 c2}) (katakana-to-yomi rs))]
[<cons $c1 <cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c2) <cons ,'ー' $rs>>>
(append (katakana-to-yomi-x-1 {c1 c2}) (katakana-to-yomi rs))]
[<cons $c1 <cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c2) $rs>>
(append (katakana-to-yomi-x-1 {c1 c2}) (katakana-to-yomi rs))]
[<cons $c <cons ,'ー' $rs>>
(append (katakana-to-yomi-1 {c}) (katakana-to-yomi rs))]
[<cons $c $rs>
(append (katakana-to-yomi-1 {c}) (katakana-to-yomi rs))]
[<nil> {}]
})))
(define $katakana-to-yomi-y-1
(lambda [$cs]
(match cs (list char)
{[,{'キ' 'ャ'} {"KY" "A"}] [,{'キ' 'ュ'} {"KY" "U"}] [,{'キ' 'ョ'} {"KY" "O"}]
[,{'ギ' 'ャ'} {"GY" "A"}] [,{'ギ' 'ュ'} {"GY" "U"}] [,{'ギ' 'ョ'} {"GY" "O"}]
[,{'シ' 'ャ'} {"SH" "A"}] [,{'シ' 'ュ'} {"SH" "U"}] [,{'シ' 'ョ'} {"SH" "O"}]
[,{'ジ' 'ャ'} {"J" "A"}] [,{'ジ' 'ュ'} {"J" "U"}] [,{'ジ' 'ョ'} {"J" "O"}]
[,{'チ' 'ャ'} {"CH" "A"}] [,{'チ' 'ュ'} {"CH" "U"}] [,{'チ' 'ョ'} {"CH" "O"}]
[,{'ヂ' 'ャ'} {"J" "A"}] [,{'ヂ' 'ュ'} {"J" "U"}] [,{'ヂ' 'ョ'} {"J" "O"}]
[,{'ニ' 'ャ'} {"NY" "A"}] [,{'ニ' 'ュ'} {"N" "U"}] [,{'ニ' 'ョ'} {"N" "O"}]
[,{'ヒ' 'ャ'} {"HY" "A"}] [,{'ヒ' 'ュ'} {"HY" "U"}] [,{'ヒ' 'ョ'} {"HY" "O"}]
[,{'ビ' 'ャ'} {"BY" "A"}] [,{'ビ' 'ュ'} {"BY" "U"}] [,{'ビ' 'ョ'} {"BY" "O"}]
[,{'ピ' 'ャ'} {"PY" "A"}] [,{'ピ' 'ュ'} {"PY" "U"}] [,{'ピ' 'ョ'} {"PY" "O"}]
[,{'ミ' 'ャ'} {"MY" "A"}] [,{'ミ' 'ュ'} {"MY" "U"}] [,{'ミ' 'ョ'} {"MY" "O"}]
[,{'リ' 'ャ'} {"RY" "A"}] [,{'リ' 'ュ'} {"RY" "U"}] [,{'リ' 'ョ'} {"RY" "O"}]
[,{'フ' 'ュ'} {"FY" "U"}] [,{'テ' 'ュ'} {"CH" "U"}] [,{'デ' 'ュ'} {"DY" "U"}]
[<cons $c1 <cons $c2 <nil>>> {@(katakana-to-yomi-1 {c1})
@(match c2 char {[,'ャ' {"Y" "A"}] [,'ュ' {"Y" "A"}] [,'ョ' {"Y" "A"}]})}]
})))
(define $katakana-to-yomi-x-1
(lambda [$cs]
(match cs (list char)
{[,{'ウ' 'ィ'} {"W" "I"}] [,{'ウ' 'ェ'} {"W" "E"}] [,{'ウ' 'ォ'} {"W" "O"}]
[,{'キ' 'ィ'} {"K" "I"}]
[,{'ク' 'ァ'} {"K" "A"}] [,{'ク' 'ィ'} {"K" "I"}] [,{'ク' 'ェ'} {"K" "E"}] [,{'ク' 'ォ'} {"K" "O"}]
[,{'シ' 'ィ'} {"S" "I"}] [,{'シ' 'ェ'} {"SH" "E"}]
[,{'ジ' 'ェ'} {"J" "E"}]
[,{'ツ' 'ァ'} {"TS" "A"}] [,{'ツ' 'ィ'} {"TS" "I"}] [,{'ツ' 'ゥ'} {"TS" "U"}] [,{'ツ' 'ェ'} {"TS" "E"}] [,{'ツ' 'ォ'} {"TS" "O"}]
[,{'チ' 'ェ'} {"CH" "E"}]
[,{'フ' 'ァ'} {"F" "A"}] [,{'フ' 'ィ'} {"F" "I"}] [,{'フ' 'ェ'} {"F" "E"}] [,{'フ' 'ォ'} {"F" "O"}]
[,{'ヴ' 'ァ'} {"V" "A"}] [,{'ヴ' 'ィ'} {"V" "I"}] [,{'ヴ' 'ェ'} {"V" "E"}] [,{'ヴ' 'ォ'} {"V" "O"}]
[,{'シ' 'ィ'} {"S" "I"}] [,{'ス' 'ィ'} {"S" "I"}] [,{'ズ' 'ィ'} {"Z" "I"}]
[,{'テ' 'ィ'} {"T" "I"}] [,{'デ' 'ィ'} {"D" "I"}]
[,{'ト' 'ゥ'} {"T" "U"}] [,{'ヅ' 'ゥ'} {"D" "U"}] [,{'ド' 'ゥ'} {"D" "U"}]
[<cons $c1 <cons $c2 <nil>>> {@(katakana-to-yomi-1 {c1})
(match c2 char {[,'ァ' "A"] [,'ィ' "I"] [,'ゥ' "U"] [,'ェ' "E"] [,'ォ' "O"]})
}]
})))
(define $katakana-to-yomi-1
(lambda [$cs]
(match cs (list char)
{[,{'ア'} {"A"}] [,{'イ'} {"I"}] [,{'ウ'} {"U"}] [,{'エ'} {"E"}] [,{'オ'} {"O"}]
[,{'カ'} {"K" "A"}] [,{'キ'} {"K" "I"}] [,{'ク'} {"K" "U"}] [,{'ケ'} {"K" "E"}] [,{'コ'} {"K" "O"}]
[,{'サ'} {"S" "A"}] [,{'シ'} {"SH" "I"}] [,{'ス'} {"S" "U"}] [,{'セ'} {"S" "E"}] [,{'ソ'} {"S" "O"}]
[,{'タ'} {"T" "A"}] [,{'チ'} {"CH" "I"}] [,{'ツ'} {"TS" "U"}] [,{'テ'} {"T" "E"}] [,{'ト'} {"T" "O"}]
[,{'ナ'} {"N" "A"}] [,{'ニ'} {"N" "I"}] [,{'ヌ'} {"N" "U"}] [,{'ネ'} {"N" "E"}] [,{'ノ'} {"N" "O"}]
[,{'ハ'} {"H" "A"}] [,{'ヒ'} {"H" "I"}] [,{'フ'} {"F" "U"}] [,{'ヘ'} {"H" "E"}] [,{'ホ'} {"H" "O"}]
[,{'マ'} {"M" "A"}] [,{'ミ'} {"M" "I"}] [,{'ム'} {"M" "U"}] [,{'メ'} {"M" "E"}] [,{'モ'} {"M" "O"}]
[,{'ヤ'} {"Y" "A"}] [,{'ユ'} {"Y" "U"}] [,{'ヨ'} {"Y" "O"}]
[,{'ラ'} {"R" "A"}] [,{'リ'} {"R" "I"}] [,{'ル'} {"R" "U"}] [,{'レ'} {"R" "E"}] [,{'ロ'} {"R" "O"}]
[,{'ワ'} {"W" "A"}] [,{'ヲ'} {"O"}] [,{'ン'} {"N"}]
[,{'ガ'} {"G" "A"}] [,{'ギ'} {"G" "I"}] [,{'グ'} {"G" "U"}] [,{'ゲ'} {"G" "E"}] [,{'ゴ'} {"G" "O"}]
[,{'ザ'} {"Z" "A"}] [,{'ジ'} {"J" "I"}] [,{'ズ'} {"Z" "U"}] [,{'ゼ'} {"Z" "E"}] [,{'ゾ'} {"Z" "O"}]
[,{'ダ'} {"D" "A"}] [,{'ヂ'} {"D" "I"}] [,{'ヅ'} {"D" "U"}] [,{'デ'} {"D" "E"}] [,{'ド'} {"D" "O"}]
[,{'バ'} {"B" "A"}] [,{'ビ'} {"B" "I"}] [,{'ブ'} {"B" "U"}] [,{'ベ'} {"B" "E"}] [,{'ボ'} {"B" "O"}]
[,{'パ'} {"P" "A"}] [,{'ピ'} {"P" "I"}] [,{'プ'} {"P" "U"}] [,{'ペ'} {"P" "E"}] [,{'ポ'} {"P" "O"}]
[,{'ヴ'} {"V" "U"}] [,{'ヰ'} {"I"}] [,{'ヱ'} {"E"}] [,{'ヮ'} {"W" "A"}]
[,{'ヵ'} {"K" "A"}] [,{'ヶ'} {"K" "E"}]
})))