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 |

2011-05-07

CLでSRFI-42

| 23:10 | CLでSRFI-42 - わだばLisperになる を含むブックマーク はてなブックマーク - CLでSRFI-42 - わだばLisperになる

必要だった、ということは全くなかったのですが、Scheme版LOOPマクロという評判のSRFI-42をCLに移植してみました。

SRFI-42は、define-syntaxで書かれていて、CLのDEFMACROとは違うのですが、Drai Sitaram氏のmacro by example(mbe)を使ってみたところ殆ど修正もなく移植完了。

  • mbe
  • mbe (ASDF化してgithubに置いてみたもの)

srfi-42だとこんな感じに書けます

(defun palindrome-p (list)
  (every?-ec (:parallel (:- nom list)
                        (:- rev (reverse list)))
             (equal nom rev)))

(palindrome-p '(1 2 3 2 1))
;=> T

(defun flatten (list)
  (append-ec (:- e list)
             (if (listp e)
                 (flatten e)
                 (list e))))

(flatten '(1 2 3 (4 5 (6 (7 (8 (9 (((10((((((()))))))))))))))))
;=> (1 2 3 4 5 6 7 8 9 10)

(defun taxi-number (n)
  (list-ec (:- a 1 n)
           (:- b (+ a 1) n)
           (:- c (+ a 1) b)
           (:- d (+ c 1) b)
           (if (= (+ (expt a 3) (expt b 3))
                  (+ (expt c 3) (expt d 3))))
           (list a b c d)))

(taxi-number 100)
;=> ((1 12 9 10) (2 16 9 15) (2 24 18 20) (2 34 15 33) (2 89 41 86) (3 36 27 30) (3 60 22 59) (4 32 18 30) (4 48 36 40) (4 68 30 66) (5 60 45 50) (5 76 48 69)
     (6 48 27 45) (6 72 54 60) (7 84 63 70) (8 53 29 50) (8 64 36 60) (8 96 72 80) (9 34 16 33) (9 58 22 57) (10 27 19 24) (10 80 45 75) (11 93 30 92)
     (12 40 31 33) (12 51 38 43) (12 96 54 90) (15 80 54 71) (17 39 26 36) (17 55 24 54) (17 76 38 73) (18 68 32 66) (20 54 38 48) (20 97 33 96) (23 94 63 84)
     (24 80 62 66) (24 98 63 89) (29 99 60 92) (30 67 51 58) (30 81 57 72) (34 78 52 72) (35 98 59 92) (42 69 56 61) (47 97 66 90) (50 96 59 93) (51 82 64 75))

オリジナルと違うところとしては、 (: i 10)のようなものはCLでは不可なので、 (:- i 10)のようにして回避しました。

また、えぐいところとしては、キーワードシンボルにマクロが定義されることになります;(:- i 10)もマクロだったり。

ちなみに実行は関数呼び出しの連発になるので通常のLOOPと比べると25倍位遅い(SBCL調べ)ようですが、この辺りを高速化するのも盆栽的に面白いかなと思っています。

また、繰り返しは再帰なのですが、末尾再帰を最適化しない処理系では厳しいかもしれません。(SBCLは最適化するので大丈夫なようですが。)

(どうでも良い)SBCLクイズ: 空ループの最適化

| 17:04 | (どうでも良い)SBCLクイズ: 空ループの最適化 - わだばLisperになる を含むブックマーク はてなブックマーク - (どうでも良い)SBCLクイズ: 空ループの最適化 - わだばLisperになる

(defun foo-slow ()
  (let* ((numbers (coerce (- 0 1) 'number)))
    (declare (type number numbers))
    (tagbody
      LL
      (setq numbers (+ numbers (coerce 1 'number)))
      (if (> numbers (* 10000 10000))
          (go END))
      (go LL)
      END)
    nil))

というコードがあります。

これは、Series

(collect-ignore (scan-range :from 0 :upto (* 10000 10000)))

マクロの展開結果で、単に空のループを1億回実行するというものですが、実行スピードが LOOP マクロの同等のコードより10倍位遅いのが悔しいので、同じ位高速なfoo-fastを作成してください、というのが問題です。

実行速度

(foo-slow)
;⇒ NIL
----------
Evaluation took:
  0.520 seconds of real time
  0.520000 seconds of total run time (0.520000 user, 0.000000 system)
  100.00% CPU
  1,242,649,269 processor cycles
  0 bytes consed

Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz
(defun bar-fast ()
  (loop :repeat (* 10000 10000)))

(bar-fast)
;⇒ NIL
----------
Evaluation took:
  0.045 seconds of real time
  0.040000 seconds of total run time (0.040000 user, 0.000000 system)
  88.89% CPU
  106,853,454 processor cycles
  0 bytes consed

Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

foo-slowのDISASSEMBLEの結果は、

; disassembly for FOO-SLOW
; 18029EF4:       48C7C3F8FFFFFF   MOV RBX, -8                ; no-arg-parsing entry point
;      EFB:       90               NOP
;      EFC:       90               NOP
;      EFD:       90               NOP
;      EFE:       90               NOP
;      EFF:       90               NOP
;      F00: L0:   BF08000000       MOV EDI, 8
;      F05:       488BD3           MOV RDX, RBX
;      F08:       4C8D1C25E0010020 LEA R11, [#x200001E0]      ; GENERIC-+
;      F10:       41FFD3           CALL R11
;      F13:       480F42E3         CMOVB RSP, RBX
;      F17:       488BDA           MOV RBX, RDX
;      F1A:       48895DF8         MOV [RBP-8], RBX
;      F1E:       BF0008AF2F       MOV EDI, 800000000
;      F23:       488BD3           MOV RDX, RBX
;      F26:       488D0C2544040020 LEA RCX, [#x20000444]      ; GENERIC->
;      F2E:       FFD1             CALL RCX
;      F30:       488B5DF8         MOV RBX, [RBP-8]
;      F34:       7ECA             JLE L0
;      F36:       BA17001020       MOV EDX, 537919511
;      F3B:       488BE5           MOV RSP, RBP
;      F3E:       F8               CLC
;      F3F:       5D               POP RBP
;      F40:       C3               RET
;      F41:       CC0A             BREAK 10                   ; error trap
;      F43:       02               BYTE #X02
;      F44:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;      F45:       54               BYTE #X54                  ; RCX

ですが、bar-fastのDISASSEMBLE結果は、

; disassembly for BAR-FAST
; 19357284:       B90008AF2F       MOV ECX, 800000000         ; no-arg-parsing entry point
;       89:       EB09             JMP L1
;       8B:       90               NOP
;       8C:       90               NOP
;       8D:       90               NOP
;       8E:       90               NOP
;       8F:       90               NOP
;       90: L0:   4883E908         SUB RCX, 8
;       94: L1:   4883F900         CMP RCX, 0
;       98:       7FF6             JNLE L0
;       9A:       BA17001020       MOV EDX, 537919511
;       9F:       488BE5           MOV RSP, RBP
;       A2:       F8               CLC
;       A3:       5D               POP RBP
;       A4:       C3               RET
;       A5:       CC0A             BREAK 10                   ; error trap
;       A7:       02               BYTE #X02
;       A8:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       A9:       54               BYTE #X54                  ; RCX
;       AA:       CC0A             BREAK 10                   ; error trap
;       AC:       02               BYTE #X02
;       AD:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       AE:       54               BYTE #X54                  ; RCX

です。foo-fastは

; disassembly for FOO-FAST
; 18229894:       31C9             XOR ECX, ECX               ; no-arg-parsing entry point
;       96:       EB0C             JMP L1
;       98:       90               NOP
;       99:       90               NOP
;       9A:       90               NOP
;       9B:       90               NOP
;       9C:       90               NOP
;       9D:       90               NOP
;       9E:       90               NOP
;       9F:       90               NOP
;       A0: L0:   4883C108         ADD RCX, 8
;       A4: L1:   4881F90008AF2F   CMP RCX, 800000000
;       AB:       7EF3             JLE L0
;       AD:       BA17001020       MOV EDX, 537919511
;       B2:       488BE5           MOV RSP, RBP
;       B5:       F8               CLC
;       B6:       5D               POP RBP
;       B7:       C3               RET
;       B8:       CC0A             BREAK 10                   ; error trap
;       BA:       02               BYTE #X02
;       BB:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       BC:       54               BYTE #X54                  ; RCX

のようなものになると思われます。