Show
Ignore:
Timestamp:
04/15/09 09:41:07 (16 years ago)
Author:
naoya_t
Message:

=> http://cvs.sourceforge.jp/view/gauche/Gauche-mecab/

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/scheme/gauche/bindings/mecab/trunk/mecab-lib.scm

    r117 r131  
    3131;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 
    3232;;; 
    33 ;;;  $Id: mecab-lib.scm,v 1.1 2009/03/02 03:52:45 shirok Exp $ 
     33;;;  $Id: mecab-lib.scm,v 1.3 2009/03/25 09:42:14 naoya_t Exp $ 
    3434;;; 
    3535 
    3636(define-module text.mecab 
    3737  (use srfi-1) 
     38  (use srfi-13) 
    3839  (use gauche.charconv) 
    3940  (export <mecab> <mecab-node> <mecab-dictionary-info> 
    … …  
    4142          mecab-do mecab-new mecab-new2 
    4243          mecab-version mecab-strerror mecab-destroy mecab-destroyed? 
     44          mecab mecab-options 
    4345 
    4446          mecab-tagger ; message passing 
    … …  
    7981;; This should be configurable, since mecab can be compiled to use utf-8. 
    8082(define-constant MECAB_ENCODING 'euc-jp) 
    81 ;(define-constant MECAB_ENCODING 'utf-8) 
    82  
     83 
     84;; We need cv-send and cv-recv if MeCab is configured with --enable-utf8-only option. 
     85;(define (cv-send str) 
     86;  (ces-convert str (gauche-character-encoding) MECAB_ENCODING)) 
     87;(define (cv-recv str) 
     88;  (and str (ces-convert str MECAB_ENCODING))) 
    8389(define (cv-send str) str) 
    84 ;  (ces-convert str (gauche-character-encoding) MECAB_ENCODING)) 
    85  
    8690(define (cv-recv str) str) 
    87 ;  (and str (ces-convert str MECAB_ENCODING))) 
    8891 
    8992(define (mecab-do args) 
    … …  
    9598  (unless (every string? args) 
    9699    (error "mecab-new: list of strings required, but got:" args)) 
    97   (%mecab-new (map cv-send args))) 
     100  (%mecab-new (map cv-send args) (mecab-parse-options args))) 
    98101 
    99102(define (mecab-new2 str) 
    100   (%mecab-new2 (cv-send str))) 
     103  (%mecab-new2 (cv-send str) (mecab-parse-options str))) 
    101104 
    102105(define (mecab-strerror m) 
    103   (cv-recv (if m (%mecab-strerror m) 
    104                (%mecab-strerror-with-null)))) 
    105  
    106 (define (mecab-get-partial m) 
    107   (%mecab-get-partial m)) 
    108  
    109 (define (mecab-set-partial m partial) 
    110   (%mecab-set-partial m partial)) 
    111  
    112 (define (mecab-get-theta m) 
    113   (%mecab-get-theta m)) 
    114  
    115 (define (mecab-set-theta m theta) 
    116   (%mecab-set-theta m theta)) 
    117  
    118 (define (mecab-get-lattice-level m) 
    119   (%mecab-get-lattice-level m)) 
    120  
    121 (define (mecab-set-lattice-level m llevel) 
    122   (%mecab-set-lattice-level m llevel)) 
    123  
    124 (define (mecab-get-all-morphs m) 
    125   (%mecab-get-all-morphs m)) 
    126  
    127 (define (mecab-set-all-morphs m morphs) 
    128  (%mecab-set-all-morphs m morphs)) 
     106; (cv-recv (%mecab-strerror m))) ;; m can be #f 
     107  (cv-recv (if m (%mecab-strerror m) (%mecab-strerror-with-null)))) 
    129108 
    130109(define (mecab-sparse-tostr m str) 
    … …  
    155134  (cv-recv (%mecab-nbest-next-tostr m))) 
    156135 
    157 (define (mecab-nbest-next-tonode m) 
    158   (%mecab-nbest-next-tonode m)) 
    159  
    160136(define (mecab-format-node m node) 
    161   (%mecab-format-node m node)) 
    162  
    163 (define (mecab-dictionary-info m) 
    164   (%mecab-dictionary-info m)) 
     137  (cv-recv (%mecab-format-node m node))) 
    165138 
    166139(define (mecab-dict-index args) 
    … …  
    189162  (%mecab-test-gen (map cv-send args))) 
    190163 
    191 ;; 
     164;; mecab_node_t 
    192165(define (mecab-node-surface n) 
    193166  (cv-recv (%mecab-node-surface n))) 
    … …  
    200173              (%mecab-node-stat n))) 
    201174 
     175;; mecab_dictionary_info_t 
    202176(define (mecab-dictionary-info-type dinfo) 
    203177  (vector-ref #(mecab-sys-dic mecab-usr-dic mecab-unk-dic) 
    204178              (%mecab-dictionary-info-type dinfo))) 
    205179 
     180;; 
    206181(inline-stub 
    207182 "#include <mecab.h>" 
    … …  
    211186   SCM_HEADER; 
    212187   mecab_t *m; /* NULL if closed */ 
     188   ScmObj   options; 
    213189 } ScmMeCab; 
    214190 
    215191 typedef struct ScmMeCabNodeRec { 
    216192   SCM_HEADER; 
    217    mecab_node_t *node; 
     193   const mecab_node_t *node; 
    218194 } ScmMeCabNode; 
    219195 
    220196 typedef struct ScmMeCabDictionaryInfoRec { 
    221197   SCM_HEADER; 
    222    mecab_dictionary_info_t *dic_info; 
     198   const mecab_dictionary_info_t *dic_info; 
    223199 } ScmMeCabDictionaryInfo;" 
    224200 
    … …  
    240216     (mecab-destroy (-> m m)) 
    241217     (set! (-> m m) NULL))) 
    242  
     218  
    243219 (define-cfn mecab-finalize (obj data::void*) ::void :static 
    244220   (mecab-cleanup (SCM_MECAB obj))) 
    245221 
    246  (define-cfn make-mecab (m::mecab_t*) :static 
     222 (define-cfn make-mecab (m::mecab_t* options::ScmObj) :static 
    247223   (when (== m NULL) (mecab-strerror NULL)) 
    248224   (let* ([obj::ScmMeCab* (SCM_NEW ScmMeCab)]) 
    249225     (SCM_SET_CLASS obj (& Scm_MeCabClass)) 
    250226     (set! (-> obj m) m) 
     227     (set! (-> obj options) options) 
    251228     (Scm_RegisterFinalizer (SCM_OBJ obj) mecab-finalize NULL) 
    252229     (return (SCM_OBJ obj)))) 
    253230 
    254  (define-cfn make-mecab-node (n::mecab_node_t*) :static 
    255 ;   (when (== node NULL) (mecab-strerror NULL)) 
     231 (define-cfn make-mecab-node (n::"const mecab_node_t*") :static 
     232   ;; returns #f when n==NULL ... for convenience of mecab_nbest_next_* 
    256233   (if (== n NULL) (return SCM_FALSE) 
    257234       (let* ([obj::ScmMeCabNode* (SCM_NEW ScmMeCabNode)]) 
    … …  
    260237         (return (SCM_OBJ obj))))) 
    261238 
    262  (define-cfn make-mecab-dictionary-info (dic_info::mecab_dictionary_info_t*) :static 
    263 ;   (when (== dic_info NULL) (mecab-strerror NULL)) 
     239 (define-cfn make-mecab-dictionary-info (dic_info::"const mecab_dictionary_info_t*") :static 
     240   ;; returns #f when dic_info==NULL ... for convenience of mecab-dictionary-info-next 
    264241   (if (== dic_info NULL) (return SCM_FALSE) 
    265242       (let* ([obj::ScmMeCabDictionaryInfo* (SCM_NEW ScmMeCabDictionaryInfo)]) 
    … …  
    278255     (result (mecab-do argc argv)))) 
    279256 
    280  (define-cproc %mecab-new (args::<list>) 
     257 (define-cproc %mecab-new (args::<list> options) 
    281258   (let* ([argc::int (Scm_Length args)] 
    282259          [argv::char** (Scm_ListToCStringArray args TRUE NULL)]) 
    283      (result (make-mecab (mecab-new argc argv))))) 
    284   
    285  (define-cproc %mecab-new2 (arg::<string>) 
    286    (result (make-mecab (mecab-new2 (Scm_GetString arg))))) 
     260     (result (make-mecab (mecab-new argc argv) options)))) 
     261 
     262 (define-cproc %mecab-new2 (arg::<string> options) 
     263   (result (make-mecab (mecab-new2 (Scm_GetString arg)) options))) 
    287264 
    288265 (define-cproc mecab-version () ::<const-cstring> mecab-version) 
    … …  
    294271   (result (== (-> m m) NULL))) 
    295272 
     273 (define-cproc mecab-options (m::<mecab>) 
     274   (result (-> m options))) 
     275 
    296276 (define-cproc %mecab-strerror (m::<mecab>) ::<const-cstring> 
    297277   (result (mecab-strerror (-> m m)))) 
     278 
    298279 (define-cproc %mecab-strerror-with-null () ::<const-cstring> 
    299280   (result (mecab-strerror NULL))) 
     281 
     282 (define-cproc mecab-get-partial (m::<mecab>) ::<int> 
     283   (result (mecab-get-partial (-> m m)))) 
     284 
     285 (define-cproc mecab-set-partial (m::<mecab> partial::<int>) ::<void> 
     286   (mecab-set-partial (-> m m) partial)) 
     287 
     288 (define-cproc mecab-get-theta (m::<mecab>) ::<float> 
     289   (result (mecab-get-theta (-> m m)))) 
     290 
     291 (define-cproc mecab-set-theta (m::<mecab> theta::<float>) ::<void> 
     292   (mecab-set-theta (-> m m) theta)) 
     293 
     294 (define-cproc mecab-get-lattice-level (m::<mecab>) ::<int> 
     295   (result (mecab-get-lattice-level (-> m m)))) 
     296 
     297 (define-cproc mecab-set-lattice-level (m::<mecab> level::<int>) ::<void> 
     298   (mecab-set-lattice-level (-> m m) level)) 
     299 
     300 (define-cproc mecab-get-all-morphs (m::<mecab>) ::<int> 
     301   (result (mecab-get-all-morphs (-> m m)))) 
     302 
     303 (define-cproc mecab-set-all-morphs (m::<mecab> all_morphs::<int>) ::<void> 
     304   (mecab-set-all-morphs (-> m m) all_morphs)) 
    300305 
    301306 (define-cproc %mecab-sparse-tostr (m::<mecab> str::<const-cstring>) 
    … …  
    315320   (result (mecab-nbest-sparse-tostr2 (-> m m) n str len))) 
    316321 
    317  (define-cproc %mecab-nbest-init (m::<mecab> str::<const-cstring>) 
    318    ::<int> 
     322 (define-cproc %mecab-nbest-init (m::<mecab> str::<const-cstring>) ::<int> 
    319323   (result (mecab-nbest-init (-> m m) str))) 
    320324 
    321  (define-cproc %mecab-nbest-init2 (m::<mecab> str::<const-cstring> len::<uint>) 
    322    ::<int> 
     325 (define-cproc %mecab-nbest-init2 (m::<mecab> str::<const-cstring> len::<uint>) ::<int> 
    323326   (result (mecab-nbest-init2 (-> m m) str len))) 
    324327 
    325  (define-cproc %mecab-nbest-next-tostr (m::<mecab>) 
     328 (define-cproc %mecab-nbest-next-tostr (m::<mecab>) ;; returns null at the end 
    326329;   (result (mecab-nbest-next-tostr (-> m m)))) 
    327330" const char *s = mecab_nbest_next_tostr(m->m); 
    328331  return s ? SCM_MAKE_STR_COPYING(s) : SCM_FALSE;") 
    329332 
    330  (define-cproc %mecab-nbest-next-tonode (m::<mecab>) 
     333 (define-cproc mecab-nbest-next-tonode (m::<mecab>) ;; returns null at the end 
    331334   (result (make-mecab-node (mecab-nbest-next-tonode (-> m m))))) 
    332 ;" mecab_node_t *node = mecab_nbest_next_tonode(m->m); 
    333 ;  return node ? make_mecab_node(node) : SCM_FALSE;") 
    334335 
    335336 (define-cproc %mecab-sparse-tonode (m::<mecab> str::<const-cstring>) 
    … …  
    339340   (result (make-mecab-node (mecab-sparse-tonode2 (-> m m) str siz)))) 
    340341 
    341  (define-cproc %mecab-dictionary-info (m::<mecab>) 
     342 (define-cproc mecab-dictionary-info (m::<mecab>) 
    342343   (result (make-mecab-dictionary-info (mecab-dictionary-info (-> m m))))) 
    343344 
    344  (define-cproc %mecab-get-partial (m::<mecab>) 
    345    ::<int> 
    346    (result (mecab-get-partial (-> m m)))) 
    347  
    348  (define-cproc %mecab-set-partial (m::<mecab> partial::<int>) 
    349    ::<void> 
    350    (mecab-set-partial (-> m m) partial)) 
    351  
    352  (define-cproc %mecab-get-theta (m::<mecab>) 
    353    ::<float> 
    354    (result (mecab-get-theta (-> m m)))) 
    355  
    356  (define-cproc %mecab-set-theta (m::<mecab> theta::<float>) 
    357    ::<void> 
    358    (mecab-set-theta (-> m m) theta)) 
    359  
    360  (define-cproc %mecab-get-lattice-level (m::<mecab>) 
    361    ::<int> 
    362    (result (mecab-get-lattice-level (-> m m)))) 
    363  
    364  (define-cproc %mecab-set-lattice-level (m::<mecab> level::<int>) 
    365    ::<void> 
    366    (mecab-set-lattice-level (-> m m) level)) 
    367   
    368  (define-cproc %mecab-get-all-morphs (m::<mecab>) 
    369    ::<int> 
    370    (result (mecab-get-all-morphs (-> m m)))) 
    371  
    372  (define-cproc %mecab-set-all-morphs (m::<mecab> all_morphs::<int>) 
    373    ::<void> 
    374    (mecab-set-all-morphs (-> m m) all_morphs)) 
    375  
    376  (define-cproc %mecab-format-node (m::<mecab> n::<mecab-node>) 
    377    ::<const-cstring>? 
     345 (define-cproc %mecab-format-node (m::<mecab> n::<mecab-node>) ::<const-cstring>? 
    378346   (result (mecab-format-node (-> m m) (-> n node)))) 
    379347 
    … …  
    407375;; 
    408376 (define-cproc mecab-node-prev (n::<mecab-node>) 
    409 "  const mecab_node_t *prev_node = n->node->prev; 
    410   return prev_node ? make_mecab_node(prev_node) : SCM_FALSE;") 
     377   (result (make-mecab-node (-> (-> n node) prev)))) 
    411378 
    412379 (define-cproc mecab-node-next (n::<mecab-node>) 
    413 "  const mecab_node_t *next_node = n->node->next; 
    414   return next_node ? make_mecab_node(next_node) : SCM_FALSE;") 
     380   (result (make-mecab-node (-> (-> n node) next)))) 
    415381 
    416382 (define-cproc mecab-node-enext (n::<mecab-node>) 
    417 "  const mecab_node_t *enext_node = n->node->enext; 
    418   return enext_node ? make_mecab_node(enext_node) : SCM_FALSE;") 
     383   (result (make-mecab-node (-> (-> n node) enext)))) 
    419384 
    420385 (define-cproc mecab-node-bnext (n::<mecab-node>) 
    421 "  const mecab_node_t *bnext_node = n->node->bnext; 
    422   return bnext_node ? make_mecab_node(bnext_node) : SCM_FALSE;") 
    423  
    424 ;; NULL terminate�������ޤ���������Ƽ��Ф��ˤ�;; strncpy(buf, node->feature, node->length) �Ȥ������������ 
     386   (result (make-mecab-node (-> (-> n node) bnext)))) 
     387 
    425388 (define-cproc %mecab-node-surface (n::<mecab-node>) 
    426   "  char buf[n->node->length + 1]; 
    427      memcpy(buf, n->node->surface, n->node->length); 
    428      buf[n->node->length] = 0; 
    429      return SCM_MAKE_STR_COPYING(buf);"); 
    430  
    431  (define-cproc %mecab-node-feature (n::<mecab-node>) ::<const-cstring> 
    432    (result (-> (-> n node) feature))) 
    433  
    434  (define-cproc mecab-node-length (n::<mecab-node>) ::<uint> 
    435    (result (-> (-> n node) length))) 
    436  
    437  (define-cproc mecab-node-rlength (n::<mecab-node>) ::<uint> 
    438    (result (-> (-> n node) rlength))) 
    439  
    440  (define-cproc mecab-node-id (n::<mecab-node>) ::<uint> 
    441    (result (-> (-> n node) id))) 
    442  
    443  (define-cproc mecab-node-rc-attr (n::<mecab-node>) ::<uint> 
    444    (result (-> (-> n node) rcAttr))) 
    445  
    446  (define-cproc mecab-node-lc-attr (n::<mecab-node>) ::<uint> 
    447    (result (-> (-> n node) lcAttr))) 
    448  
    449  (define-cproc mecab-node-posid (n::<mecab-node>) ::<uint> 
    450    (result (-> (-> n node) posid))) 
    451  
    452  (define-cproc mecab-node-char-type (n::<mecab-node>) ::<uint> 
    453    (result (-> (-> n node) char-type))) 
    454  
    455  (define-cproc %mecab-node-stat (n::<mecab-node>) ::<int> 
    456    (result (-> (-> n node) stat))) 
    457  
    458  (define-cproc mecab-node-best? (n::<mecab-node>) ::<boolean> 
    459    (result (-> (-> n node) isbest))) 
    460  
    461  (define-cproc mecab-node-alpha (n::<mecab-node>) ::<float> 
    462    (result (-> (-> n node) alpha))) 
    463  
    464  (define-cproc mecab-node-beta (n::<mecab-node>) ::<float> 
    465    (result (-> (-> n node) beta))) 
    466  
    467  (define-cproc mecab-node-prob (n::<mecab-node>) ::<float> 
    468    (result (-> (-> n node) prob))) 
    469  
    470  (define-cproc mecab-node-wcost (n::<mecab-node>) ::<int> 
    471    (result (-> (-> n node) wcost))) 
    472  
    473  (define-cproc mecab-node-cost (n::<mecab-node>) ::<int> 
    474    (result (-> (-> n node) cost))) 
     389   (result (Scm-MakeString (-> (-> n node) surface) 
     390                           (-> (-> n node) length) ;; size 
     391                           -1 ;; Gauche will count the 'length' of this substring 
     392                           SCM-STRING-COPYING))) 
     393 
     394 (define-cproc %mecab-node-feature (n::<mecab-node>) 
     395   ::<const-cstring> (result (-> (-> n node) feature))) 
     396 
     397 (define-cproc mecab-node-length (n::<mecab-node>) 
     398   ::<uint> (result (-> (-> n node) length))) 
     399 
     400 (define-cproc mecab-node-rlength (n::<mecab-node>) 
     401   ::<uint> (result (-> (-> n node) rlength))) 
     402 
     403 (define-cproc mecab-node-id (n::<mecab-node>) 
     404   ::<uint> (result (-> (-> n node) id))) 
     405 
     406 (define-cproc mecab-node-rc-attr (n::<mecab-node>) 
     407   ::<uint> (result (-> (-> n node) rcAttr))) 
     408 
     409 (define-cproc mecab-node-lc-attr (n::<mecab-node>) 
     410   ::<uint> (result (-> (-> n node) lcAttr))) 
     411 
     412 (define-cproc mecab-node-posid (n::<mecab-node>) 
     413   ::<uint> (result (-> (-> n node) posid))) 
     414 
     415 (define-cproc mecab-node-char-type (n::<mecab-node>) 
     416   ::<uint> (result (-> (-> n node) char-type))) 
     417 
     418 (define-cproc %mecab-node-stat (n::<mecab-node>) 
     419   ::<int> (result (-> (-> n node) stat))) 
     420 
     421 (define-cproc mecab-node-best? (n::<mecab-node>) 
     422   ::<boolean> (result (-> (-> n node) isbest))) 
     423 
     424 (define-cproc mecab-node-alpha (n::<mecab-node>) 
     425   ::<float> (result (-> (-> n node) alpha))) 
     426 
     427 (define-cproc mecab-node-beta (n::<mecab-node>) 
     428   ::<float> (result (-> (-> n node) beta))) 
     429 
     430 (define-cproc mecab-node-prob (n::<mecab-node>) 
     431   ::<float> (result (-> (-> n node) prob))) 
     432 
     433 (define-cproc mecab-node-wcost (n::<mecab-node>) 
     434   ::<int> (result (-> (-> n node) wcost))) 
     435 
     436 (define-cproc mecab-node-cost (n::<mecab-node>) 
     437   ::<int> (result (-> (-> n node) cost))) 
    475438 
    476439;; 
    477440;; mecab_dictionary_info_t 
    478441;; 
    479 ;;   #define MECAB_USR_DIC   1 
    480 ;;   #define MECAB_SYS_DIC   0 
    481 ;;   #define MECAB_UNK_DIC   2 
    482 ;; 
    483442 (define-cproc mecab-dictionary-info-filename (dinfo::<mecab-dictionary-info>) 
    484    ::<const-cstring> 
    485    (result (-> (-> dinfo dic_info) filename))) 
     443   ::<const-cstring> (result (-> (-> dinfo dic_info) filename))) 
    486444 
    487445 (define-cproc mecab-dictionary-info-charset (dinfo::<mecab-dictionary-info>) 
    488    ::<const-cstring> 
    489    (result (-> (-> dinfo dic_info) charset))) 
     446   ::<const-cstring> (result (-> (-> dinfo dic_info) charset))) 
    490447 
    491448 (define-cproc mecab-dictionary-info-size (dinfo::<mecab-dictionary-info>) 
    … …  
    514471 
    515472(define-method write-object ((m <mecab>) out) 
    516   (format out "#<mecab>")); (mecab-version))) 
     473  (format out "#<mecab ~s>" (mecab-options m))) 
    517474(define-method write-object ((m <mecab-node>) out) 
    518475  (format out "#<mecab-node>")) 
    … …  
    520477  (format out "#<mecab-dictionary-info>")) 
    521478 
    522 (define-reader-ctor '<mecab> mecab-new2) 
    523  
    524 (define (mecab-tagger paramstr) 
    525   (let1 mecabobj (mecab-new2 paramstr) 
     479(define *mecab-options+* 
     480  '((r rcfile FILE) 
     481    (d dicdir DIR) 
     482    (u userdic FILE) 
     483    (l lattice-level INT) 
     484    (D dictionary-info) 
     485    (a all-morphs) 
     486    (O output-format-type TYPE) 
     487    (p partial) 
     488    (F node-format STR) 
     489    (U unk-format STR) 
     490    (B bos-format STR) 
     491    (E eos-format STR) 
     492    (x unk-feature STR) 
     493    (b input-buffer-size INT) 
     494    (P dump-config) 
     495    (M open-mutable-dictionary) 
     496    (C allocate-sentence) 
     497    (N nbest INT) 
     498    (t theta FLOAT) 
     499    (c cost-factor INT) 
     500    (o output FILE) 
     501    (v version) 
     502    (h help))) 
     503 
     504(define *mecab-options* (map cdr *mecab-options+*)) 
     505 
     506(define (cast argtype obj) 
     507  (case argtype 
     508    [(STR DIR FILE) (x->string obj)] 
     509    [(INT FLOAT) obj] 
     510    [(TYPE) (string->symbol (x->string obj))] 
     511    [else obj])) 
     512 
     513(define (requires-arg? option) 
     514  (let1 opt (assoc option *mecab-options*) 
     515    (if opt (= 2 (length opt)) #f))) 
     516 
     517(define (argtype option) 
     518  (cadr (or (assoc option *mecab-options*) (list #f #f)))) 
     519 
     520(define (long-option-name short-option-name) 
     521  (cadr (or (assoc short-option-name *mecab-options+*) (list #f #f)))) 
     522 
     523(define (keyword-length keyword) 
     524  (string-length (keyword->string keyword))) 
     525 
     526(define (keyword->symbol keyword) 
     527  (string->symbol (keyword->string keyword))) 
     528 
     529(define (mecab-parse-options args) 
     530  ;; eg. ("-Ochasen" :l 1 "--theta" "0.75") 
     531  ;;     => (:output-format-type "chasen" :lattice-level 1 :theta "0.75") 
     532  (let1 args* (append-map 
     533               (lambda (arg) 
     534                 (cond [(string? arg) 
     535                        (if (string=? "" arg) '() 
     536                            (append-map 
     537                             (lambda (str) 
     538                               (let1 len (string-length str) 
     539                                 (if (<= 2 len) 
     540                                     (if (eq? #\- (string-ref str 0)) 
     541                                         ;; --option, -X[arg] 
     542                                         (if (eq? #\- (string-ref str 1)) 
     543                                             ;; --option 
     544                                             (list (string->symbol (substring str 2 len))) 
     545                                             ;; -X[arg] 
     546                                             (let1 option (long-option-name (string->symbol (substring str 1 2))) 
     547                                               (if (= len 2) 
     548                                                   ;; -X 
     549                                                   (list option) 
     550                                                   ;; -Xarg 
     551                                                   (list option (cast (argtype option) (substring str 2 len)))))) 
     552                                         (list str)) 
     553                                     (list str)))) 
     554                             (string-split arg #[ =])))] 
     555                       [(keyword? arg) 
     556                        (if (= 1 (keyword-length arg)) 
     557                            (list (long-option-name (keyword->symbol arg))) 
     558                            (list (keyword->symbol arg)))] 
     559                       [else 
     560                        (list arg)])) 
     561               (if (list? args) args (list args))) 
     562    ;; eg. (:output-format-type "chasen" :lattice-level 1 :theta "0.75") 
     563    ;;     => ((output-format-type chasen) (lattice-level 1) (theta 0.75)) 
     564    (let loop ((rest args*) (options '())) 
     565      (if (null? rest) 
     566          (reverse! options) 
     567          (let1 option (car rest) 
     568            (if (symbol? option) 
     569                (if (requires-arg? option) 
     570                    (loop (cddr rest) (cons (list option (cast (argtype option) (cadr rest))) options)) 
     571                    (loop (cdr rest) (cons (list option (if #f #f)) options))) 
     572                (loop (cdr rest) options))))))) 
     573 
     574(define (mecab . args) ;; inspired by leque's make-mecab 
     575  (let* ([options (mecab-parse-options args)] 
     576         [options-str (append-map (lambda (option+arg) 
     577                                    (let* ([option (car option+arg)] 
     578                                           [option-str (format "--~a" option)]) 
     579                                      (if (requires-arg? option) 
     580                                          (list option-str (x->string (cadr option+arg))) 
     581                                          (list option-str) ))) 
     582                                  options)]) 
     583    (%mecab-new options-str options))) 
     584 
     585(define-reader-ctor 'mecab mecab) 
     586 
     587;; Tagger 
     588(define (mecab-tagger . args) 
     589  (let1 m (apply mecab args) 
    526590    (define (parse-to-string str . args) 
    527591      (let-optionals* args ((len #f)) 
    528592        (if len 
    529             (mecab-sparse-tostr2 mecabobj str len) 
    530             (mecab-sparse-tostr mecabobj str) ))) 
    531      
    532     (define (parse-to-node str) 
    533       (mecab-sparse-tonode mecabobj str)) 
    534  
    535     ;; ���ε�ǽ������� ��ư�����ץ����Ȥ���-l 1 ��ꤹ����������� 
    536     (define (parse-nbest n str) 
    537       (mecab-nbest-sparse-tostr mecabobj n str)) 
    538  
    539     (define (parse-nbest-init str) 
    540       (mecab-nbest-init mecabobj str)) 
    541  
    542     (define (next) 
    543       (mecab-nbest-next-tostr mecabobj)) 
    544  
    545     (define (next-node) 
    546       (mecab-nbest-next-tonode mecabobj)) 
    547  
    548     (define (format-node node) 
    549       (mecab-format-node mecabobj node)) 
     593            (mecab-sparse-tostr2 m str len) 
     594            (mecab-sparse-tostr m str) ))) 
     595 
     596    (define (parse-to-node str) (mecab-sparse-tonode m str)) 
     597 
     598    ;; requires "-l 1" in option 
     599    (define (parse-nbest n str) (mecab-nbest-sparse-tostr m n str)) 
     600 
     601    (define (parse-nbest-init str) (mecab-nbest-init m str)) 
     602 
     603    (define (next) (mecab-nbest-next-tostr m)) 
     604 
     605    (define (next-node) (mecab-nbest-next-tonode m)) 
     606 
     607    (define (format-node node) (mecab-format-node m node)) 
     608 
     609    (define (destroy) (mecab-destroy m)) 
    550610 
    551611    (lambda (m) 
    … …  
    558618        [(next-node) next-node] 
    559619        [(format-node) format-node] 
     620        [(destroy) destroy] 
    560621        )))) 
    561622 
    562 ;;; class 
    563 (define-class <mecab-tagger> () (mecab #f)) 
     623(define-class <mecab-tagger> () (m #f)) 
     624 
    564625(define (mecab-make-tagger paramstr) 
    565   (make <mecab-tagger> :mecab (mecab-new2 paramstr))) 
    566 (define (tagger-mecab tagger) (slot-ref tagger 'mecab)) 
     626  (make <mecab-tagger> :mecab (mecab paramstr))) 
     627 
     628(define (tagger-mecab tagger) (slot-ref tagger 'm)) 
     629 
    567630(define-method parse ((tagger <mecab-tagger>) (str <string>)) 
    568631  (mecab-sparse-tostr (tagger-mecab tagger) str)) 
     632 
    569633(define-method parse ((tagger <mecab-tagger>) (str <string>) (len <integer>)) 
    570634  (mecab-sparse-tostr2 (tagger-mecab tagger) str len)) 
     635 
    571636(define-method parse-to-string ((tagger <mecab-tagger>) (str <string>)) 
    572637  (mecab-sparse-tostr (tagger-mecab tagger) str)) 
     638 
    573639(define-method parse-to-string ((tagger <mecab-tagger>) (str <string>) (len <integer>)) 
    574640  (mecab-sparse-tostr (tagger-mecab tagger) str len)) 
     641 
    575642(define-method parse-to-node ((tagger <mecab-tagger>) (str <string>)) 
    576643  (mecab-sparse-tonode (tagger-mecab tagger) str)) 
     644 
    577645(define-method parse-to-node ((tagger <mecab-tagger>) (str <string>) (len <integer>)) 
    578646  (mecab-sparse-tonode2 (tagger-mecab tagger) str len)) 
     647 
    579648(define-method parse-nbest ((tagger <mecab-tagger>) (n <integer>) (str <string>)) 
    580649  (mecab-nbest-sparse-tostr (tagger-mecab tagger) str)) 
     650 
    581651(define-method parse-nbest ((tagger <mecab-tagger>) (n <integer>) (str <string>) (len <integer>)) 
    582652  (mecab-nbest-sparse-tostr (tagger-mecab tagger) str len)) 
     653 
    583654(define-method parse-nbest-init ((tagger <mecab-tagger>) (str <string>)) 
    584655  (mecab-nbest-init (tagger-mecab tagger) str)) 
     656 
    585657(define-method parse-nbest-init ((tagger <mecab-tagger>) (str <string>) (len <integer>)) 
    586658  (mecab-nbest-init (tagger-mecab tagger) str len)) 
     659 
    587660(define-method next ((tagger <mecab-tagger>)) 
    588661  (mecab-nbest-next-tostr (tagger-mecab tagger))) 
     662 
    589663(define-method next-node ((tagger <mecab-tagger>)) 
    590664  (mecab-nbest-next-tonode (tagger-mecab tagger))) 
     665 
    591666(define-method format-node ((tagger <mecab-tagger>) (node <mecab-node>)) 
    592667  (mecab-format-node (tagger-mecab tagger) node))