Gauche:ドキュメントがあるかどうか調べる

Gauche:マニュアルにアクセスとGauche:モジュールの列挙の成果をつかい、ドキュメントの有無をチェックする試みです。yamasushi(2013/04/23 22:06:11 UTC)

(use gauche.dictionary)
(use util.match)

(use textj.gauche-info)
(use gauche-modules)
(use gauche-exports)
(use gauche-classes)

; TODO autoloadのモジュールをはねる処理

(let [[mod-index-node (info-node-module-jp)]
      [var-index-node (info-node-variable-jp)]
      [fun-index-node (info-node-function-jp)]
      [cls-index-node (info-node-class-jp) ] ]
  ; モジュールのドキュメントをチェック
  ;
  (define (mod-checker str mod)
    (let1 modsym (module-name mod)
      (if-let1 v (dict-get mod-index-node (symbol->string modsym) #f)
        (format #t "OK[~a] ~a ----> ~a\n" str modsym v)
        (format #t "!![~a] undocumented : ~a\n" str modsym )
      ) ) )
  (define (obj-checker str mod sym obj)
    (let [[name   (symbol->string sym)]
          [modsym (module-name mod) ]]
      (unless (or
          (dict-get var-index-node name #f)
          (dict-get fun-index-node name #f)
          (dict-get cls-index-node name #f) )
          (format #t "!![~a][~a] undocumented : ~a [~a]\n" modsym str sym ($ class-name $ class-of obj) ) ) ) )
  (for-each
    (match-lambda [(mod sym obj)
      (mod-checker "predef" mod )
      (obj-checker "predef" mod sym obj) ])
    (predefined-objects-lseq) )
  (for-each
    (match-lambda [(mod sym obj)
      (mod-checker "lib" mod )
      (obj-checker "lib" mod sym obj) ])
    (library-objects-lseq) )
  (for-each
    (match-lambda [(mod sym obj)
      (mod-checker "lib @ predef" mod )
      (obj-checker "lib @ predef" mod sym obj) ])
    (default-library-objects-lseq) )
  ;
  ; クラスのドキュメントをチェック
  ; モジュール列挙の方法がgauche-modules-for-eachとは異なる
  (gauche-classes-for-each
    ( ^(mod sym cls)
      ;(print mod " " cls)
      (if-let1 cls-name (and (slot-exists? cls 'name) ($ symbol->string $ class-name cls) )
        (if-let1 mod-node (dict-get mod-index-node (symbol->string (module-name mod) ) #f)
          (begin
            (format #t "OK ~a ----> ~a\n" (module-name mod) mod-node)
            (if-let1 cls-node (dict-get cls-index-node cls-name #f)
              (begin
                ;#?=cls-node
                (format #t "OK ~a ----> ~a\n" cls-name cls-node))
              (rxmatch-case cls-name
                [#/<\S+-meta>/ (_)
                  (format #t "! metaクラス(~a) ~a に索引がない\n" (module-name mod) cls-name ) ]
                [#/<\S+-error>/ (_)
                  (format #t "! errorクラス(~a)  ~a に索引がない\n" (module-name mod) cls-name ) ]
                [else
                  (format #t "!! (~a) クラス ~a に索引がない\n" (module-name mod) cls-name ) ] ) ) )
          (format #t "!! undocumented : ~a\n" (module-name mod) ) )
        (format #t "?? ~aがnameスロットをもたない !!??\n" cls) ) ) ) )