Changeset 131 for lang/scheme

Timestamp:

04/15/09 09:41:07 (15 years ago)

Author:

naoya_t

Message:

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

Location:

lang/scheme/gauche/bindings/mecab/trunk

Files:

• ChangeLog (modified) (2 diffs)
• DIST (added)
• Makefile.in (modified) (2 diffs)
• VERSION (deleted)
• configure (deleted)
• mecab-lib.scm (modified) (18 diffs)
• test-dep-1.scm (added)
• test-dep-ipadic.scm (added)
• test-naoyat.scm (deleted)
• test.scm (modified) (1 diff)

lang/scheme/gauche/bindings/mecab/trunk/ChangeLog

@@ -1 +Â @@
-2009-03-23  naoya_t  <naoya.t@aqua.plala.or.jp>
+2009-03-25  Naoya Tozuka  <naoya_t@users.sourceforge.jp>
 
-        * Merged naoya_t's MeCab binding.  Supports almost all of MeCab APIs and Tagger class.
+        * Merged naoya_t's mecab-gauche-0.98pre1 (http://blog.livedoor.jp/naoya_t/archives/51131440.html)
+        * Supports:
+                * Tagger class
+                * Accessors for mecab_node_t structure members
+                * All MeCab APIs, except those which overwrite their argument:
+                    mecab-sparse-tostr3, mecab-nbest-sparse-tostr3, mecab-nbest-next-tostr2
+        * (mecab params ...) makes a new instance with parameter(s).  The format is inspired by leque's (make-mecab :rcfile "mymecabrc") style.
+        * Separates dictionary-dependent tests from test.scm.
 
 2009-03-01  Shiro Kawai  <shiro@acm.org>
@@ -10 +17 @@
 
 
-

lang/scheme/gauche/bindings/mecab/trunk/Makefile.in

@@ -1 +1 @@
 #
-# $Id: Makefile.in,v 1.3 2009/03/02 03:52:45 shirok Exp $
+# $Id: Makefile.in,v 1.4 2009/03/25 06:22:38 naoya_t Exp $
 #
 
@@ -55 +55 @@
         $(GOSH) -I. -I$(srcdir) $(srcdir)/test.scm > test.log
 
+# dictionary-dependent tests (optional)
+check-dep : all
+        @rm -f test-dep-1.log test-dep-ipadic.log
+        $(GOSH) -I. -I$(srcdir) $(srcdir)/test-dep-1.scm > test-dep-1.log
+        $(GOSH) -I. -I$(srcdir) $(srcdir)/test-dep-ipadic.scm > test-dep-ipadic.log
+
 install : all
         $(INSTALL) -m 444 -T $(GAUCHE_PKGINCDIR) $(HEADERS)

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

@@ -31 +31 @@
 ;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ;;;
-;;;  $Id: mecab-lib.scm,v 1.1 2009/03/02 03:52:45 shirok Exp $
+;;;  $Id: mecab-lib.scm,v 1.3 2009/03/25 09:42:14 naoya_t Exp $
 ;;;
 
 (define-module text.mecab
   (use srfi-1)
+  (use srfi-13)
   (use gauche.charconv)
   (export <mecab> <mecab-node> <mecab-dictionary-info>
@@ -41 +42 @@
           mecab-do mecab-new mecab-new2
           mecab-version mecab-strerror mecab-destroy mecab-destroyed?
+          mecab mecab-options
 
           mecab-tagger ; message passing
@@ -79 +81 @@
 ;; This should be configurable, since mecab can be compiled to use utf-8.
 (define-constant MECAB_ENCODING 'euc-jp)
-;(define-constant MECAB_ENCODING 'utf-8)
-
+
+;; We need cv-send and cv-recv if MeCab is configured with --enable-utf8-only option.
+;(define (cv-send str)
+;  (ces-convert str (gauche-character-encoding) MECAB_ENCODING))
+;(define (cv-recv str)
+;  (and str (ces-convert str MECAB_ENCODING)))
 (define (cv-send str) str)
-;  (ces-convert str (gauche-character-encoding) MECAB_ENCODING))
-
 (define (cv-recv str) str)
-;  (and str (ces-convert str MECAB_ENCODING)))
 
 (define (mecab-do args)
@@ -95 +98 @@
   (unless (every string? args)
     (error "mecab-new: list of strings required, but got:" args))
-  (%mecab-new (map cv-send args)))
+  (%mecab-new (map cv-send args) (mecab-parse-options args)))
 
 (define (mecab-new2 str)
-  (%mecab-new2 (cv-send str)))
+  (%mecab-new2 (cv-send str) (mecab-parse-options str)))
 
 (define (mecab-strerror m)
-  (cv-recv (if m (%mecab-strerror m)
-               (%mecab-strerror-with-null))))
-
-(define (mecab-get-partial m)
-  (%mecab-get-partial m))
-
-(define (mecab-set-partial m partial)
-  (%mecab-set-partial m partial))
-
-(define (mecab-get-theta m)
-  (%mecab-get-theta m))
-
-(define (mecab-set-theta m theta)
-  (%mecab-set-theta m theta))
-
-(define (mecab-get-lattice-level m)
-  (%mecab-get-lattice-level m))
-
-(define (mecab-set-lattice-level m llevel)
-  (%mecab-set-lattice-level m llevel))
-
-(define (mecab-get-all-morphs m)
-  (%mecab-get-all-morphs m))
-
-(define (mecab-set-all-morphs m morphs)
- (%mecab-set-all-morphs m morphs))
+; (cv-recv (%mecab-strerror m))) ;; m can be #f
+  (cv-recv (if m (%mecab-strerror m) (%mecab-strerror-with-null))))
 
 (define (mecab-sparse-tostr m str)
@@ -155 +134 @@
   (cv-recv (%mecab-nbest-next-tostr m)))
 
-(define (mecab-nbest-next-tonode m)
-  (%mecab-nbest-next-tonode m))
-
 (define (mecab-format-node m node)
-  (%mecab-format-node m node))
-
-(define (mecab-dictionary-info m)
-  (%mecab-dictionary-info m))
+  (cv-recv (%mecab-format-node m node)))
 
 (define (mecab-dict-index args)
@@ -189 +162 @@
   (%mecab-test-gen (map cv-send args)))
 
-;;
+;; mecab_node_t
 (define (mecab-node-surface n)
   (cv-recv (%mecab-node-surface n)))
@@ -200 +173 @@
               (%mecab-node-stat n)))
 
+;; mecab_dictionary_info_t
 (define (mecab-dictionary-info-type dinfo)
   (vector-ref #(mecab-sys-dic mecab-usr-dic mecab-unk-dic)
               (%mecab-dictionary-info-type dinfo)))
 
+;;
 (inline-stub
  "#include <mecab.h>"
@@ -211 +186 @@
    SCM_HEADER;
    mecab_t *m; /* NULL if closed */
+   ScmObj   options;
  } ScmMeCab;
 
  typedef struct ScmMeCabNodeRec {
    SCM_HEADER;
-   mecab_node_t *node;
+   const mecab_node_t *node;
  } ScmMeCabNode;
 
  typedef struct ScmMeCabDictionaryInfoRec {
    SCM_HEADER;
-   mecab_dictionary_info_t *dic_info;
+   const mecab_dictionary_info_t *dic_info;
  } ScmMeCabDictionaryInfo;"
 
@@ -240 +216 @@
      (mecab-destroy (-> m m))
      (set! (-> m m) NULL)))
-
+ 
  (define-cfn mecab-finalize (obj data::void*) ::void :static
    (mecab-cleanup (SCM_MECAB obj)))
 
- (define-cfn make-mecab (m::mecab_t*) :static
+ (define-cfn make-mecab (m::mecab_t* options::ScmObj) :static
    (when (== m NULL) (mecab-strerror NULL))
    (let* ([obj::ScmMeCab* (SCM_NEW ScmMeCab)])
      (SCM_SET_CLASS obj (& Scm_MeCabClass))
      (set! (-> obj m) m)
+     (set! (-> obj options) options)
      (Scm_RegisterFinalizer (SCM_OBJ obj) mecab-finalize NULL)
      (return (SCM_OBJ obj))))
 
- (define-cfn make-mecab-node (n::mecab_node_t*) :static
-;   (when (== node NULL) (mecab-strerror NULL))
+ (define-cfn make-mecab-node (n::"const mecab_node_t*") :static
+   ;; returns #f when n==NULL ... for convenience of mecab_nbest_next_*
    (if (== n NULL) (return SCM_FALSE)
        (let* ([obj::ScmMeCabNode* (SCM_NEW ScmMeCabNode)])
@@ -260 +237 @@
          (return (SCM_OBJ obj)))))
 
- (define-cfn make-mecab-dictionary-info (dic_info::mecab_dictionary_info_t*) :static
-;   (when (== dic_info NULL) (mecab-strerror NULL))
+ (define-cfn make-mecab-dictionary-info (dic_info::"const mecab_dictionary_info_t*") :static
+   ;; returns #f when dic_info==NULL ... for convenience of mecab-dictionary-info-next
    (if (== dic_info NULL) (return SCM_FALSE)
        (let* ([obj::ScmMeCabDictionaryInfo* (SCM_NEW ScmMeCabDictionaryInfo)])
@@ -278 +255 @@
      (result (mecab-do argc argv))))
 
- (define-cproc %mecab-new (args::<list>)
+ (define-cproc %mecab-new (args::<list> options)
    (let* ([argc::int (Scm_Length args)]
           [argv::char** (Scm_ListToCStringArray args TRUE NULL)])
-     (result (make-mecab (mecab-new argc argv)))))
- 
- (define-cproc %mecab-new2 (arg::<string>)
-   (result (make-mecab (mecab-new2 (Scm_GetString arg)))))
+     (result (make-mecab (mecab-new argc argv) options))))
+
+ (define-cproc %mecab-new2 (arg::<string> options)
+   (result (make-mecab (mecab-new2 (Scm_GetString arg)) options)))
 
  (define-cproc mecab-version () ::<const-cstring> mecab-version)
@@ -294 +271 @@
    (result (== (-> m m) NULL)))
 
+ (define-cproc mecab-options (m::<mecab>)
+   (result (-> m options)))
+
  (define-cproc %mecab-strerror (m::<mecab>) ::<const-cstring>
    (result (mecab-strerror (-> m m))))
+
  (define-cproc %mecab-strerror-with-null () ::<const-cstring>
    (result (mecab-strerror NULL)))
+
+ (define-cproc mecab-get-partial (m::<mecab>) ::<int>
+   (result (mecab-get-partial (-> m m))))
+
+ (define-cproc mecab-set-partial (m::<mecab> partial::<int>) ::<void>
+   (mecab-set-partial (-> m m) partial))
+
+ (define-cproc mecab-get-theta (m::<mecab>) ::<float>
+   (result (mecab-get-theta (-> m m))))
+
+ (define-cproc mecab-set-theta (m::<mecab> theta::<float>) ::<void>
+   (mecab-set-theta (-> m m) theta))
+
+ (define-cproc mecab-get-lattice-level (m::<mecab>) ::<int>
+   (result (mecab-get-lattice-level (-> m m))))
+
+ (define-cproc mecab-set-lattice-level (m::<mecab> level::<int>) ::<void>
+   (mecab-set-lattice-level (-> m m) level))
+
+ (define-cproc mecab-get-all-morphs (m::<mecab>) ::<int>
+   (result (mecab-get-all-morphs (-> m m))))
+
+ (define-cproc mecab-set-all-morphs (m::<mecab> all_morphs::<int>) ::<void>
+   (mecab-set-all-morphs (-> m m) all_morphs))
 
  (define-cproc %mecab-sparse-tostr (m::<mecab> str::<const-cstring>)
@@ -315 +320 @@
    (result (mecab-nbest-sparse-tostr2 (-> m m) n str len)))
 
- (define-cproc %mecab-nbest-init (m::<mecab> str::<const-cstring>)
-   ::<int>
+ (define-cproc %mecab-nbest-init (m::<mecab> str::<const-cstring>) ::<int>
    (result (mecab-nbest-init (-> m m) str)))
 
- (define-cproc %mecab-nbest-init2 (m::<mecab> str::<const-cstring> len::<uint>)
-   ::<int>
+ (define-cproc %mecab-nbest-init2 (m::<mecab> str::<const-cstring> len::<uint>) ::<int>
    (result (mecab-nbest-init2 (-> m m) str len)))
 
- (define-cproc %mecab-nbest-next-tostr (m::<mecab>)
+ (define-cproc %mecab-nbest-next-tostr (m::<mecab>) ;; returns null at the end
 ;   (result (mecab-nbest-next-tostr (-> m m))))
 " const char *s = mecab_nbest_next_tostr(m->m);
   return s ? SCM_MAKE_STR_COPYING(s) : SCM_FALSE;")
 
- (define-cproc %mecab-nbest-next-tonode (m::<mecab>)
+ (define-cproc mecab-nbest-next-tonode (m::<mecab>) ;; returns null at the end
    (result (make-mecab-node (mecab-nbest-next-tonode (-> m m)))))
-;" mecab_node_t *node = mecab_nbest_next_tonode(m->m);
-;  return node ? make_mecab_node(node) : SCM_FALSE;")
 
  (define-cproc %mecab-sparse-tonode (m::<mecab> str::<const-cstring>)
@@ -339 +340 @@
    (result (make-mecab-node (mecab-sparse-tonode2 (-> m m) str siz))))
 
- (define-cproc %mecab-dictionary-info (m::<mecab>)
+ (define-cproc mecab-dictionary-info (m::<mecab>)
    (result (make-mecab-dictionary-info (mecab-dictionary-info (-> m m)))))
 
- (define-cproc %mecab-get-partial (m::<mecab>)
-   ::<int>
-   (result (mecab-get-partial (-> m m))))
-
- (define-cproc %mecab-set-partial (m::<mecab> partial::<int>)
-   ::<void>
-   (mecab-set-partial (-> m m) partial))
-
- (define-cproc %mecab-get-theta (m::<mecab>)
-   ::<float>
-   (result (mecab-get-theta (-> m m))))
-
- (define-cproc %mecab-set-theta (m::<mecab> theta::<float>)
-   ::<void>
-   (mecab-set-theta (-> m m) theta))
-
- (define-cproc %mecab-get-lattice-level (m::<mecab>)
-   ::<int>
-   (result (mecab-get-lattice-level (-> m m))))
-
- (define-cproc %mecab-set-lattice-level (m::<mecab> level::<int>)
-   ::<void>
-   (mecab-set-lattice-level (-> m m) level))
- 
- (define-cproc %mecab-get-all-morphs (m::<mecab>)
-   ::<int>
-   (result (mecab-get-all-morphs (-> m m))))
-
- (define-cproc %mecab-set-all-morphs (m::<mecab> all_morphs::<int>)
-   ::<void>
-   (mecab-set-all-morphs (-> m m) all_morphs))
-
- (define-cproc %mecab-format-node (m::<mecab> n::<mecab-node>)
-   ::<const-cstring>?
+ (define-cproc %mecab-format-node (m::<mecab> n::<mecab-node>) ::<const-cstring>?
    (result (mecab-format-node (-> m m) (-> n node))))
 
@@ -407 +375 @@
 ;;
  (define-cproc mecab-node-prev (n::<mecab-node>)
-"  const mecab_node_t *prev_node = n->node->prev;
-  return prev_node ? make_mecab_node(prev_node) : SCM_FALSE;")
+   (result (make-mecab-node (-> (-> n node) prev))))
 
  (define-cproc mecab-node-next (n::<mecab-node>)
-"  const mecab_node_t *next_node = n->node->next;
-  return next_node ? make_mecab_node(next_node) : SCM_FALSE;")
+   (result (make-mecab-node (-> (-> n node) next))))
 
  (define-cproc mecab-node-enext (n::<mecab-node>)
-"  const mecab_node_t *enext_node = n->node->enext;
-  return enext_node ? make_mecab_node(enext_node) : SCM_FALSE;")
+   (result (make-mecab-node (-> (-> n node) enext))))
 
  (define-cproc mecab-node-bnext (n::<mecab-node>)
-"  const mecab_node_t *bnext_node = n->node->bnext;
-  return bnext_node ? make_mecab_node(bnext_node) : SCM_FALSE;")
-
-;; NULL terminate�������ޤ���������Ƽ��Ф��ˤ�;; strncpy(buf, node->feature, node->length) �Ȥ������������
+   (result (make-mecab-node (-> (-> n node) bnext))))
+
  (define-cproc %mecab-node-surface (n::<mecab-node>)
-  "  char buf[n->node->length + 1];
-     memcpy(buf, n->node->surface, n->node->length);
-     buf[n->node->length] = 0;
-     return SCM_MAKE_STR_COPYING(buf);");
-
- (define-cproc %mecab-node-feature (n::<mecab-node>) ::<const-cstring>
-   (result (-> (-> n node) feature)))
-
- (define-cproc mecab-node-length (n::<mecab-node>) ::<uint>
-   (result (-> (-> n node) length)))
-
- (define-cproc mecab-node-rlength (n::<mecab-node>) ::<uint>
-   (result (-> (-> n node) rlength)))
-
- (define-cproc mecab-node-id (n::<mecab-node>) ::<uint>
-   (result (-> (-> n node) id)))
-
- (define-cproc mecab-node-rc-attr (n::<mecab-node>) ::<uint>
-   (result (-> (-> n node) rcAttr)))
-
- (define-cproc mecab-node-lc-attr (n::<mecab-node>) ::<uint>
-   (result (-> (-> n node) lcAttr)))
-
- (define-cproc mecab-node-posid (n::<mecab-node>) ::<uint>
-   (result (-> (-> n node) posid)))
-
- (define-cproc mecab-node-char-type (n::<mecab-node>) ::<uint>
-   (result (-> (-> n node) char-type)))
-
- (define-cproc %mecab-node-stat (n::<mecab-node>) ::<int>
-   (result (-> (-> n node) stat)))
-
- (define-cproc mecab-node-best? (n::<mecab-node>) ::<boolean>
-   (result (-> (-> n node) isbest)))
-
- (define-cproc mecab-node-alpha (n::<mecab-node>) ::<float>
-   (result (-> (-> n node) alpha)))
-
- (define-cproc mecab-node-beta (n::<mecab-node>) ::<float>
-   (result (-> (-> n node) beta)))
-
- (define-cproc mecab-node-prob (n::<mecab-node>) ::<float>
-   (result (-> (-> n node) prob)))
-
- (define-cproc mecab-node-wcost (n::<mecab-node>) ::<int>
-   (result (-> (-> n node) wcost)))
-
- (define-cproc mecab-node-cost (n::<mecab-node>) ::<int>
-   (result (-> (-> n node) cost)))
+   (result (Scm-MakeString (-> (-> n node) surface)
+                           (-> (-> n node) length) ;; size
+                           -1 ;; Gauche will count the 'length' of this substring
+                           SCM-STRING-COPYING)))
+
+ (define-cproc %mecab-node-feature (n::<mecab-node>)
+   ::<const-cstring> (result (-> (-> n node) feature)))
+
+ (define-cproc mecab-node-length (n::<mecab-node>)
+   ::<uint> (result (-> (-> n node) length)))
+
+ (define-cproc mecab-node-rlength (n::<mecab-node>)
+   ::<uint> (result (-> (-> n node) rlength)))
+
+ (define-cproc mecab-node-id (n::<mecab-node>)
+   ::<uint> (result (-> (-> n node) id)))
+
+ (define-cproc mecab-node-rc-attr (n::<mecab-node>)
+   ::<uint> (result (-> (-> n node) rcAttr)))
+
+ (define-cproc mecab-node-lc-attr (n::<mecab-node>)
+   ::<uint> (result (-> (-> n node) lcAttr)))
+
+ (define-cproc mecab-node-posid (n::<mecab-node>)
+   ::<uint> (result (-> (-> n node) posid)))
+
+ (define-cproc mecab-node-char-type (n::<mecab-node>)
+   ::<uint> (result (-> (-> n node) char-type)))
+
+ (define-cproc %mecab-node-stat (n::<mecab-node>)
+   ::<int> (result (-> (-> n node) stat)))
+
+ (define-cproc mecab-node-best? (n::<mecab-node>)
+   ::<boolean> (result (-> (-> n node) isbest)))
+
+ (define-cproc mecab-node-alpha (n::<mecab-node>)
+   ::<float> (result (-> (-> n node) alpha)))
+
+ (define-cproc mecab-node-beta (n::<mecab-node>)
+   ::<float> (result (-> (-> n node) beta)))
+
+ (define-cproc mecab-node-prob (n::<mecab-node>)
+   ::<float> (result (-> (-> n node) prob)))
+
+ (define-cproc mecab-node-wcost (n::<mecab-node>)
+   ::<int> (result (-> (-> n node) wcost)))
+
+ (define-cproc mecab-node-cost (n::<mecab-node>)
+   ::<int> (result (-> (-> n node) cost)))
 
 ;;
 ;; mecab_dictionary_info_t
 ;;
-;;   #define MECAB_USR_DIC   1
-;;   #define MECAB_SYS_DIC   0
-;;   #define MECAB_UNK_DIC   2
-;;
  (define-cproc mecab-dictionary-info-filename (dinfo::<mecab-dictionary-info>)
-   ::<const-cstring>
-   (result (-> (-> dinfo dic_info) filename)))
+   ::<const-cstring> (result (-> (-> dinfo dic_info) filename)))
 
  (define-cproc mecab-dictionary-info-charset (dinfo::<mecab-dictionary-info>)
-   ::<const-cstring>
-   (result (-> (-> dinfo dic_info) charset)))
+   ::<const-cstring> (result (-> (-> dinfo dic_info) charset)))
 
  (define-cproc mecab-dictionary-info-size (dinfo::<mecab-dictionary-info>)
@@ -514 +471 @@
 
 (define-method write-object ((m <mecab>) out)
-  (format out "#<mecab>")); (mecab-version)))
+  (format out "#<mecab ~s>" (mecab-options m)))
 (define-method write-object ((m <mecab-node>) out)
   (format out "#<mecab-node>"))
@@ -520 +477 @@
   (format out "#<mecab-dictionary-info>"))
 
-(define-reader-ctor '<mecab> mecab-new2)
-
-(define (mecab-tagger paramstr)
-  (let1 mecabobj (mecab-new2 paramstr)
+(define *mecab-options+*
+  '((r rcfile FILE)
+    (d dicdir DIR)
+    (u userdic FILE)
+    (l lattice-level INT)
+    (D dictionary-info)
+    (a all-morphs)
+    (O output-format-type TYPE)
+    (p partial)
+    (F node-format STR)
+    (U unk-format STR)
+    (B bos-format STR)
+    (E eos-format STR)
+    (x unk-feature STR)
+    (b input-buffer-size INT)
+    (P dump-config)
+    (M open-mutable-dictionary)
+    (C allocate-sentence)
+    (N nbest INT)
+    (t theta FLOAT)
+    (c cost-factor INT)
+    (o output FILE)
+    (v version)
+    (h help)))
+
+(define *mecab-options* (map cdr *mecab-options+*))
+
+(define (cast argtype obj)
+  (case argtype
+    [(STR DIR FILE) (x->string obj)]
+    [(INT FLOAT) obj]
+    [(TYPE) (string->symbol (x->string obj))]
+    [else obj]))
+
+(define (requires-arg? option)
+  (let1 opt (assoc option *mecab-options*)
+    (if opt (= 2 (length opt)) #f)))
+
+(define (argtype option)
+  (cadr (or (assoc option *mecab-options*) (list #f #f))))
+
+(define (long-option-name short-option-name)
+  (cadr (or (assoc short-option-name *mecab-options+*) (list #f #f))))
+
+(define (keyword-length keyword)
+  (string-length (keyword->string keyword)))
+
+(define (keyword->symbol keyword)
+  (string->symbol (keyword->string keyword)))
+
+(define (mecab-parse-options args)
+  ;; eg. ("-Ochasen" :l 1 "--theta" "0.75")
+  ;;     => (:output-format-type "chasen" :lattice-level 1 :theta "0.75")
+  (let1 args* (append-map
+               (lambda (arg)
+                 (cond [(string? arg)
+                        (if (string=? "" arg) '()
+                            (append-map
+                             (lambda (str)
+                               (let1 len (string-length str)
+                                 (if (<= 2 len)
+                                     (if (eq? #\- (string-ref str 0))
+                                         ;; --option, -X[arg]
+                                         (if (eq? #\- (string-ref str 1))
+                                             ;; --option
+                                             (list (string->symbol (substring str 2 len)))
+                                             ;; -X[arg]
+                                             (let1 option (long-option-name (string->symbol (substring str 1 2)))
+                                               (if (= len 2)
+                                                   ;; -X
+                                                   (list option)
+                                                   ;; -Xarg
+                                                   (list option (cast (argtype option) (substring str 2 len))))))
+                                         (list str))
+                                     (list str))))
+                             (string-split arg #[ =])))]
+                       [(keyword? arg)
+                        (if (= 1 (keyword-length arg))
+                            (list (long-option-name (keyword->symbol arg)))
+                            (list (keyword->symbol arg)))]
+                       [else
+                        (list arg)]))
+               (if (list? args) args (list args)))
+    ;; eg. (:output-format-type "chasen" :lattice-level 1 :theta "0.75")
+    ;;     => ((output-format-type chasen) (lattice-level 1) (theta 0.75))
+    (let loop ((rest args*) (options '()))
+      (if (null? rest)
+          (reverse! options)
+          (let1 option (car rest)
+            (if (symbol? option)
+                (if (requires-arg? option)
+                    (loop (cddr rest) (cons (list option (cast (argtype option) (cadr rest))) options))
+                    (loop (cdr rest) (cons (list option (if #f #f)) options)))
+                (loop (cdr rest) options)))))))
+
+(define (mecab . args) ;; inspired by leque's make-mecab
+  (let* ([options (mecab-parse-options args)]
+         [options-str (append-map (lambda (option+arg)
+                                    (let* ([option (car option+arg)]
+                                           [option-str (format "--~a" option)])
+                                      (if (requires-arg? option)
+                                          (list option-str (x->string (cadr option+arg)))
+                                          (list option-str) )))
+                                  options)])
+    (%mecab-new options-str options)))
+
+(define-reader-ctor 'mecab mecab)
+
+;; Tagger
+(define (mecab-tagger . args)
+  (let1 m (apply mecab args)
     (define (parse-to-string str . args)
       (let-optionals* args ((len #f))
         (if len
-            (mecab-sparse-tostr2 mecabobj str len)
-            (mecab-sparse-tostr mecabobj str) )))
-    
-    (define (parse-to-node str)
-      (mecab-sparse-tonode mecabobj str))
-
-    ;; ���ε�ǽ������� ��ư�����ץ����Ȥ���-l 1 ��ꤹ�����������
-    (define (parse-nbest n str)
-      (mecab-nbest-sparse-tostr mecabobj n str))
-
-    (define (parse-nbest-init str)
-      (mecab-nbest-init mecabobj str))
-
-    (define (next)
-      (mecab-nbest-next-tostr mecabobj))
-
-    (define (next-node)
-      (mecab-nbest-next-tonode mecabobj))
-
-    (define (format-node node)
-      (mecab-format-node mecabobj node))
+            (mecab-sparse-tostr2 m str len)
+            (mecab-sparse-tostr m str) )))
+
+    (define (parse-to-node str) (mecab-sparse-tonode m str))
+
+    ;; requires "-l 1" in option
+    (define (parse-nbest n str) (mecab-nbest-sparse-tostr m n str))
+
+    (define (parse-nbest-init str) (mecab-nbest-init m str))
+
+    (define (next) (mecab-nbest-next-tostr m))
+
+    (define (next-node) (mecab-nbest-next-tonode m))
+
+    (define (format-node node) (mecab-format-node m node))
+
+    (define (destroy) (mecab-destroy m))
 
     (lambda (m)
@@ -558 +618 @@
         [(next-node) next-node]
         [(format-node) format-node]
+        [(destroy) destroy]
         ))))
 
-;;; class
-(define-class <mecab-tagger> () (mecab #f))
+(define-class <mecab-tagger> () (m #f))
+
 (define (mecab-make-tagger paramstr)
-  (make <mecab-tagger> :mecab (mecab-new2 paramstr)))
-(define (tagger-mecab tagger) (slot-ref tagger 'mecab))
+  (make <mecab-tagger> :mecab (mecab paramstr)))
+
+(define (tagger-mecab tagger) (slot-ref tagger 'm))
+
 (define-method parse ((tagger <mecab-tagger>) (str <string>))
   (mecab-sparse-tostr (tagger-mecab tagger) str))
+
 (define-method parse ((tagger <mecab-tagger>) (str <string>) (len <integer>))
   (mecab-sparse-tostr2 (tagger-mecab tagger) str len))
+
 (define-method parse-to-string ((tagger <mecab-tagger>) (str <string>))
   (mecab-sparse-tostr (tagger-mecab tagger) str))
+
 (define-method parse-to-string ((tagger <mecab-tagger>) (str <string>) (len <integer>))
   (mecab-sparse-tostr (tagger-mecab tagger) str len))
+
 (define-method parse-to-node ((tagger <mecab-tagger>) (str <string>))
   (mecab-sparse-tonode (tagger-mecab tagger) str))
+
 (define-method parse-to-node ((tagger <mecab-tagger>) (str <string>) (len <integer>))
   (mecab-sparse-tonode2 (tagger-mecab tagger) str len))
+
 (define-method parse-nbest ((tagger <mecab-tagger>) (n <integer>) (str <string>))
   (mecab-nbest-sparse-tostr (tagger-mecab tagger) str))
+
 (define-method parse-nbest ((tagger <mecab-tagger>) (n <integer>) (str <string>) (len <integer>))
   (mecab-nbest-sparse-tostr (tagger-mecab tagger) str len))
+
 (define-method parse-nbest-init ((tagger <mecab-tagger>) (str <string>))
   (mecab-nbest-init (tagger-mecab tagger) str))
+
 (define-method parse-nbest-init ((tagger <mecab-tagger>) (str <string>) (len <integer>))
   (mecab-nbest-init (tagger-mecab tagger) str len))
+
 (define-method next ((tagger <mecab-tagger>))
   (mecab-nbest-next-tostr (tagger-mecab tagger)))
+
 (define-method next-node ((tagger <mecab-tagger>))
   (mecab-nbest-next-tonode (tagger-mecab tagger)))
+
 (define-method format-node ((tagger <mecab-tagger>) (node <mecab-node>))
   (mecab-format-node (tagger-mecab tagger) node))

lang/scheme/gauche/bindings/mecab/trunk/test.scm

@@ -1 +1 @@
 ;; -*- coding:euc-jp -*-
 ;;
-;; test for mecab module
+;; dictionary-independent tests for mecab module
 ;;
 
 (use gauche.test)
 
-(test-start "mecab")
+(test-start "mecab: dictionary-independent tests")
 (use text.mecab)
 (test-module 'text.mecab)
 
-(define m (mecab-new2 ""))
-(test* "mecab-new2" #t (is-a? m <mecab>))
-(test* "mecab-destroy" #f (mecab-destroyed? m))
-(mecab-destroy m)
-(test* "mecab-destroy" #t (mecab-destroyed? m))
+;;
+;; write-object / ctor
+;;
+(define-macro (displayed-string obj)
+  `(with-output-to-string (lambda () (display ,obj))))
 
-(test* "mecab-sparse-tostr" #f
-       (mecab-sparse-tostr m "�Ϻ�ϼ�Ϻ���������Ҥ�Ϥ�����"))
-(test* "mecab-strerror" #t (string? (mecab-strerror m)))
+(test-section "write-object (display)")
+(let1 m (mecab-new '())
+  (test* "(mecab-new '())" "#<mecab ()>" (displayed-string m))
+  (mecab-destroy m))
+(let1 m (mecab-new '("-O" "chasen"))
+  (test* "(mecab-new '(\"-O\" \"chasen\"))" "#<mecab ((output-format-type chasen))>" (displayed-string m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "")
+  (test* "(mecab-new2 \"\")" "#<mecab ()>" (displayed-string m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "-Ochasen")
+  (test* "(mecab-new2 \"-Ochasen\")" "#<mecab ((output-format-type chasen))>" (displayed-string m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "-O chasen")
+  (test* "(mecab-new2 \"-O chasen\")" "#<mecab ((output-format-type chasen))>" (displayed-string m))
+  (mecab-destroy m))
 
-(define m (mecab-new2 ""))
-(test* "mecab-sparse-tostr"
-       "�Ϻ      ̾����,*,*,�Ϻ,ï¿½ï¿½ï¿½í¤¦,*\n\
-        �������*,*,����*\n\
-        ��Ϻ     ̾����,*,*,��Ϻ,ï¿½ï¿½ï¿½í¤¦,*\n\
-        ��      ���ʽ�*,*,��,��,*\n\
-        ��ư��,�Ҳ�ư�쥿���������Ʒ����ä��ɽɽ��:��
-        �������������,���ư�����������\n\
-        �       ̾���̾��,*,�,�ۤ���:�� �ɽɽ��:�\n\
-        ����ʽ�*,*,��,*\n\
-        �ֻ�̾����,*,*,�ֻ��Ϥʤ�,*\n\
-        �����ʽ�*,*,����*\n\
-        �����   ư��,�Ҳ�ư�쥵���������,�錄����,�°ư����ʴ���ɽɽ��:���\n\
-        ��      ����,*,*,��,��,*\n\
-        EOS\n"
-       (mecab-sparse-tostr m "�Ϻ�ϼ�Ϻ���������Ҥ�Ϥ�����"))
-                            
-(mecab-destroy m)
+(test-section "reader-ctor")
+(let1 m #,(mecab "") ;; with reader-ctor
+  (test* "#,(mecab \"\") : mecab?" #t (mecab? m))
+  (test* "#,(mecab \"\") : options" '() (mecab-options m))
+  (mecab-destroy m))
+(let1 m #,(mecab "-Ochasen") ;; with reader-ctor
+  (test* "#,(mecab \"-Ochasen\") : mecab?" #t (mecab? m))
+  (test* "#,(mecab \"-Ochasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m #,(mecab :O chasen :l 1) ;; with reader-ctor
+  (test* "#,(mecab :O chasen :l 1) : mecab?" #t (mecab? m))
+  (test* "#,(mecab :O chasen :l 1) : mecab-options" '((output-format-type chasen) (lattice-level 1)) (mecab-options m))
+  (mecab-destroy m))
+
+;;
+;; mecab?, mecab-node?, mecab-dictionary-info?
+;;
+(let* ([m (mecab-new2 "")]
+       [node (mecab-sparse-tonode m "")]
+       [dinfo (mecab-dictionary-info m)])
+  (test-section "mecab?, mecab-node?, mecab-dictionary-info?")
+
+  (test* "is-a? m <mecab>" #t (is-a? m <mecab>))
+  (test* "is-a? node <mecab>" #t (is-a? node <mecab-node>))
+  (test* "is-a? dinfo <mecab>" #t (is-a? dinfo <mecab-dictionary-info>))
+
+  (test* "mecab? m" #t (mecab? m))
+  (test* "mecab? node" #f (mecab? node))
+  (test* "mecab? dinfo" #f (mecab? dinfo))
+
+  (test* "mecab-node? m" #f (mecab-node? m))
+  (test* "mecab-node? node" #t (mecab-node? node))
+  (test* "mecab-node? dinfo" #f (mecab-node? dinfo))
+
+  (test* "mecab-dictionary-info? m" #f (mecab-dictionary-info? m))
+  (test* "mecab-dictionary-info? node" #f (mecab-dictionary-info? node))
+  (test* "mecab-dictionary-info? dinfo" #t (mecab-dictionary-info? dinfo))
+
+  (mecab-destroy m))
+
+;; mecab, mecab-options
+(test-section "mecab-options")
+(let1 m (mecab-new '())
+  (test* "(mecab-new '())" '() (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab-new '("-O" "chasen"))
+  (test* "(mecab-new '(\"-O\" \"chasen\"))" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "")
+  (test* "(mecab-new2 \"\"" '() (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "-Ochasen")
+  (test* "mecab?" #t (mecab? m))
+  (test* "(mecab-new2 \"-Ochasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "-O chasen")
+  (test* "mecab?" #t (mecab? m))
+  (test* "(mecab-new2 \"-O chasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "--output-format-type chasen")
+  (test* "mecab?" #t (mecab? m))
+  (test* "(mecab-new2 \"--output-format-type chasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab-new2 "--output-format-type=chasen")
+  (test* "mecab?" #t (mecab? m))
+  (test* "(mecab-new2 \"--output-format-type=chasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab "")
+  (test* "(mecab \"\") : mecab?" #t (mecab? m))
+  (test* "(mecab \"\") : options" '() (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab "-Ochasen")
+  (test* "(mecab \"-Ochasen\") : mecab?" #t (mecab? m))
+  (test* "(mecab \"-Ochasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab "-O chasen")
+  (test* "(mecab \"-O chasen\") : mecab?" #t (mecab? m))
+  (test* "(mecab \"-O chasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab "-O" "chasen")
+  (test* "(mecab \"-O\" \"chasen\") : mecab?" #t (mecab? m))
+  (test* "(mecab \"-O\" \"chasen\") : options" '((output-format-type chasen)) (mecab-options m))
+  (mecab-destroy m))
+(let1 m (mecab :O 'chasen :l 1)
+  (test* "(mecab :O chasen :l 1) : mecab?" #t (mecab? m))
+  (test* "(mecab :O chasen :l 1) : mecab-options" '((output-format-type chasen) (lattice-level 1)) (mecab-options m))
+  (mecab-destroy m))
+
+;;
+;; APIs
+;;
+(test-section "mecab-new")
+(let1 m (mecab-new '())
+  (test* "is-a? <mecab>" #t (is-a? m <mecab>))
+  (test* "mecab?" #t (mecab? m))
+
+  (test-section "mecab-destroy")
+  (test* "not destroyed yet" #f (mecab-destroyed? m))
+  (mecab-destroy m)
+  (test* "destroyed" #t (mecab-destroyed? m))
+  )
+
+(test-section "mecab-new2")
+(let1 m (mecab-new2 "")
+  (test* "is-a? <mecab>" #t (is-a? m <mecab>))
+  (test* "mecab?" #t (mecab? m))
+  (test* "options" '() (mecab-options m))
+  (mecab-destroy m))
+
+(test-section "mecab-version")
+(test* "mecab-version" 1
+       (rxmatch-num-matches
+        (#/^[0-9]+\.[0-9]+[.0-9A-Za-z]*$/ (mecab-version))))
+
+(test-section "mecab-strerror")
+(mecab-new2 "")
+(test* "at mecab-new2 (ok)" "" (mecab-strerror #f))
+
+(mecab-new2 "-d //") ;; => "tagger.cpp(149) [load_dictionary_resource(param)] param.cpp(71) [ifs] no such file or directory:  //dicrc"
+(test* "at mecab-new (err)" #f (string=? "" (mecab-strerror #f)))
+(test* "no such file or directory" #f (not (#/no such file or directory/ (mecab-strerror #f))))
+
+(let1 m (mecab-new2 "")
+  (mecab-sparse-tostr m "��Ĥ���")
+  (test* "noerr" "" (mecab-strerror m))
+  (mecab-destroy m))
+
+(let1 m (mecab-new2 "")
+  (test-section "mecab-get-partial / mecab-set-partial")
+  (test* "default partial mode [0|1]" #t
+         (and (memq (mecab-get-partial m) '(0 1)) #t))
+  (mecab-set-partial m 1)
+  (test* "set to 1" 1 (mecab-get-partial m))
+  (mecab-set-partial m 0)
+  (test* "set to 0" 0 (mecab-get-partial m))
+
+  (test-section "mecab-get-theta / mecab-set-theta")
+  (let1 theta (mecab-get-theta m)
+    (test* "default partial mode [0..1]" #t (and (number? theta) (<= 0.0 theta 1.0))))
+  (mecab-set-theta m 1.0)
+  (test* "set to 1.0" 1.0 (mecab-get-theta m))
+  (mecab-set-theta m 0.5)
+  (test* "set to 0.5" 0.5 (mecab-get-theta m))
+
+  (test-section "mecab-get-lattice-level / mecab-set-lattice-level")
+  (test* "default lattice-level [0|1|2]" #t
+         (and (memq (mecab-get-lattice-level m) '(0 1 2)) #t))
+  (mecab-set-lattice-level m 1)
+  (test* "set to 1" 1 (mecab-get-lattice-level m))
+  (mecab-set-lattice-level m 2)
+  (test* "set to 2" 2 (mecab-get-lattice-level m))
+  (mecab-set-lattice-level m 0)
+  (test* "set to 0" 0 (mecab-get-lattice-level m))
+
+  (test-section "mecab-get-all-morphs / mecab-set-all-morphs")
+  (test* "default all-morphs [0|1]" #t
+         (and (memq (mecab-get-all-morphs m) '(0 1)) #t))
+  (mecab-set-all-morphs m 1)
+  (test* "set to 1" 1 (mecab-get-all-morphs m))
+  (mecab-set-all-morphs m 0)
+  (test* "set to 0" 0 (mecab-get-all-morphs m))
+  )
 
 (test-end)