Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-10-21

KMRCLを眺める(219) FIND-START-TAG

| 21:16 | KMRCLを眺める(219) FIND-START-TAG - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(219) FIND-START-TAG - わだばLisperになる

今回はKMRCLのxml-utils.lispから、FIND-START-TAGです。

動作は、

(kl::find-start-tag "foo" 3 "1234<foo bar=\"foo\">hello</foo>" 0 30)
;⇒ 19, ("bar=\"foo\"")

という感じですが、タグの中身の開始位置と存在すれば属性を抜き出すもののようです。

以前眺めたstrings.lispの流れからすると最適化された下請け関数と思われます。

実装は最適化のため若干読みにくくなっていますが、ループしながら目的のものを切り出してゆくという感じです

(defun find-start-tag (tag taglen xmlstr start end)
  "Searches for the start of a tag in an xmlstring. Returns STARTPOS ATTRIBUTE-LIST)"
  (declare (simple-string tag xmlstr)
           (fixnum taglen start end)
           (optimize (speed 3) (safety 0) (space 0)))
  (do* ((search-str (concatenate 'string "<" tag))
        (search-len (1+ taglen))
        (bracketpos (fast-string-search search-str xmlstr search-len start end)
                    (fast-string-search search-str xmlstr search-len start end)))
       ((null bracketpos) nil)
    (let* ((endtag (+ bracketpos 1 taglen))
           (char-after-tag (schar xmlstr endtag)))
      (when (or (char= #\> char-after-tag)
                (char= #\space char-after-tag))
        (if (char= #\> char-after-tag)
            (return-from find-start-tag (values (1+ endtag) nil))
            (let ((endbrack (position-char #\> xmlstr (1+ endtag) end)))
              (if endbrack
                  (return-from find-start-tag
                    (values (1+ endbrack)
                            (string-to-list-skip-delimiter
                             (subseq xmlstr endtag endbrack))))
                  (values nil nil)))))
      (setq start endtag))))

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20101021