lib/sekka/convert-jisyo.nnd in sekka-0.8.8 vs lib/sekka/convert-jisyo.nnd in sekka-0.9.0

@@ -36,10 +36,21 @@
 (use srfi-1)
 (use sekka.util)
 (use sekka.roman-lib)
 
 
+(define (expand-hiragana-phrase-entry key)
+  (let1 roman-list (gen-hiragana->roman-list key)
+    (if (< 1000 (length roman-list))
+        (begin
+          (STDERR.printf " Warning: ignored entry [%s] (hiragana phrase), because too many pattens.\n" key)
+          #f) ;; パターン数が爆発した単語は無視する
+        (map
+         (lambda (x)
+           (cons (+ "=" x) key))
+         roman-list))))
+
 (define (expand-okuri-nashi-entry key value)
   (let1 roman-list (gen-hiragana->roman-list key)
     (if (< 1000 (length roman-list))
         (begin
           (STDERR.printf " Warning: ignored entry [%s %s] , because too many pattens.\n" key value)
@@ -77,11 +88,11 @@
   (define total   0)
   (define current 0)
 
   (define (display-progress line)
     (set! current (+ current 1))
-    (when (= 0 (% current 10000))
+    (when (= 0 (% current 1000))
       (STDERR.printf "  %7d/%7d (%3.3f％)\n" current total (* (/ current (total.to_f)) 100.0))))
 
   (define (gen-sekka-entries line)
     (display-progress line)
 
@@ -92,10 +103,17 @@
         ;; コメント行
         #f)
        ((not fields)
         ;; フォーマットエラー
         #f)
+       ((rxmatch #/\;\;/ line)
+        ;; フォーマットエラー
+        #f)
+       ((and (is-hiragana (first fields))
+             (rxmatch #/^\/$/ (second fields)))
+        ;; 平仮名フレーズ
+        (expand-hiragana-phrase-entry (first fields)))
        ((or (is-hiragana (first fields))
             (rxmatch #/^([>#あ-んー]+)$/ (first fields)))
         ;; 送り仮名なしデータ
         (expand-okuri-nashi-entry (first fields) (second fields)))
        ((rxmatch #/^([>あ-んー]+)([a-z])$/ (first fields))
@@ -111,22 +129,27 @@
         ;; # が1文字でも含まれている
         #f)
        (else
         (list (cons (first fields) (second fields)))))))
 
-  (let* ((lines
+  (let* ([lines
           (map
            (lambda (line)
              (line.chomp))
-           (f.readlines.to_list)))
-         (_ (set! total (length lines)))
-         (entry-list
-          (filter
-           (lambda (x) x)
-           (map gen-sekka-entries lines))))
-    (map
-     (lambda (entry)
-       (sprintf "%s %s" (car entry) (cdr entry)))
-     (apply append! entry-list))))
+           (f.readlines))]
+         [_ (set! total (lines.size))]
+         [result '#()])
+    (for-each
+     (lambda (x)
+       (let1 entries (gen-sekka-entries x)
+         (when entries
+           (for-each
+            (lambda (entry)
+              (result.push (sprintf "%s %s" (car entry) (cdr entry))))
+            entries))))
+     lines)
+
+    (to-list result)))
+