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-03-16

KMRCLを眺める DEF-PREFIXED-NUMBER-STRING (116)

| 13:52 | KMRCLを眺める DEF-PREFIXED-NUMBER-STRING (116) - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める DEF-PREFIXED-NUMBER-STRING (116) - わだばLisperになる

今回はKMRCLのstrings.lispから、DEF-PREFIXED-NUMBER-STRINGです。

動作は、マクロを書くマクロ

(KL::def-prefixed-number-string prefixed-fixnum-string fixnum)

とすると、

(DEFUN PREFIXED-FIXNUM-STRING (NUM PCHAR LEN)
  "Outputs a string of LEN digit with an optional initial character PCHAR.
Leading zeros are present. LEN must be a fixnum."
  (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
           (FIXNUM LEN)
           (FIXNUM NUM))
  (WHEN PCHAR (INCF LEN))
  (DO* ((ZERO-CODE (CHAR-CODE #\0))
        (RESULT (MAKE-STRING LEN :INITIAL-ELEMENT #\0))
        (MINUS? (MINUSP NUM))
        (VAL (IF MINUS?
                        (- NUM)
                        NUM)
                    (NTH-VALUE 0 (FLOOR VAL 10)))
        (POS (1- LEN) (1- POS))
        (MOD (MOD VAL 10) (MOD VAL 10)))
       ((OR (ZEROP VAL) (MINUSP POS))
        (WHEN PCHAR (SETF (SCHAR RESULT 0) PCHAR))
        (WHEN MINUS?
          (SETF (SCHAR RESULT
                       (IF PCHAR
                           1
                           0))
                  #\-))
        RESULT)
    (DECLARE (FIXNUM VAL)
             (FIXNUM MOD ZERO-CODE POS)
             (BOOLEAN MINUS?)
             (SIMPLE-STRING RESULT))
    (SETF (SCHAR RESULT POS)
            (CODE-CHAR (THE FIXNUM (+ ZERO-CODE MOD))))))

のようなマクロに展開され、結果として、

(KL::PREFIXED-FIXNUM-STRING 1 #\G 6)
⇒ "G000001"

(KL::PREFIXED-FIXNUM-STRING -1 #\G 6)
⇒"G-00001"

のようなものが定義できるようになります。

定義は、

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defmacro def-prefixed-number-string (fn-name type &optional doc)
    `(defun ,fn-name (num pchar len)
       ,@(when (stringp doc) (list doc))
       (declare (optimize (speed 3) (safety 0) (space 0))
                (fixnum len)
                (,type num))
       (when pchar
         (incf len))
       (do* ((zero-code (char-code #\0))
             (result (make-string len :initial-element #\0))
             (minus? (minusp num))
             (val (if minus? (- num) num)
                  (nth-value 0 (floor val 10)))
             (pos (1- len) (1- pos))
             (mod (mod val 10) (mod val 10)))
            ((or (zerop val) (minusp pos))
             (when pchar
               (setf (schar result 0) pchar))
             (when minus? (setf (schar result (if pchar 1 0)) #\-))
             result)
         (declare (,type val)
                  (fixnum mod zero-code pos)
                  (boolean minus?)
                  (simple-string result))
         (setf (schar result pos) (code-char (the fixnum (+ zero-code mod))))))))

となっています。同じファイル内でこのマクロを利用した定義が続くので、eval-when (:compile-toplevel :load-toplevel :execute)が付いています。