Gauche:半角カナ->全角カナ

Gauche:半角カナ->全角カナ

半角カナから全角カナへの変換

全角から半角への変換とはちょっと違って自明ではない。 濁点や半濁点が不正な位置に存在する可能性があるからだ。 ここでは一案として不正な位置にあるものは濁点や半濁点は無かったものとしてスキップしている。

(use srfi-1)
(use gauche.collection)

(define (make-table src . dst)
  (let1 dst (get-optional dst (make-list (string-length src) #t))
    (let ((pairs (map cons src dst))
          (tbl (make-hash-table)))
      (for-each (lambda (kv)
                  (hash-table-put! tbl (car kv) (cdr kv)))
                pairs)
      tbl)))

(define (gen-kana-trans . options)
  (let-keywords* options ((loseless-voices :voiced #t)
                          (loseless-semivoices :semivoiced #t))
    (let* ((normal (make-table
                    "アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォャュョッー、。「」・"
                    "アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォャュョッー、。「」・"))
           (voiced (make-table
                    "ウカキクケコサシスセソタチツテトハヒフヘホ"
                    "ヴガギグゲゴザジズゼゾダヂヅデドバビブベボ"))
           (semivoiced (make-table
                        "ハヒフヘホ"
                        "パピプペポ"))
           (voiced-loseless? (if (string? loseless-voices) #f #t))
           (semivoiced-loseless? (if (string? loseless-semivoices) #f #t))
           (vs (if voiced-loseless?
                   (make-hash-table)
                   (make-table loseless-voices)))
           (svs (if semivoiced-loseless?
                    (make-hash-table)
                    (make-table loseless-semivoices))))
      (lambda (orig-string)
        (let lp ((rev-str (reverse (string->list orig-string)))
                 (result '()))
          (if (null? rev-str)
              (list->string result)
              (let ((c (car rev-str))
                    (rest (cdr rev-str)))
                (cond ((eq? c #?゙) (cond ((null? rest) (if voiced-loseless?
                                                           (lp rest (cons #?゛ result))
                                                           (lp rest result)))
                                         ((hash-table-get voiced (car rest) #f) => (lambda (v) (lp (cdr rest) (cons v result))))
                                         ((hash-table-get vs (car rest) voiced-loseless?) (lp rest (cons #?゛ result)))
                                         (else (lp rest result))))
                      ((eq? c #?゚) (cond ((null? rest) (if semivoiced-loseless?
                                                           (lp rest (cons #?゜ result))
                                                           (lp rest result)))
                                         ((hash-table-get semivoiced (car rest) #f) => (lambda (v) (lp (cdr rest) (cons v result))))
                                         ((hash-table-get svs (car rest) semivoiced-loseless?) (lp rest (cons #?゜ result)))
                                         (else (lp rest result))))
                      ((hash-table-get normal c #f) => (lambda (v) (lp rest (cons v result))))
                      (else (lp rest (cons c result)))))))))))

(define kana-trans:half->full (gen-kana-trans))
More ...