gistfile1.txt

;;; Demo output (downcased):
#+bad #+reader #+hack

(macroexpand-1 '(string-case ("foobar")
                 ("" 'empty)
                 ("foo" 'foo)
                 ("fob" 'fob)
                 ("foobar" 'hit)
                 (t     'default)))
=>
(let ((#:input2056 "foobar"))
  (flet ((#:on-error2057 ()
           'default))
    (case (length #:input2056)
      ((0) (locally (declare (type (array * (0)) #:input2056))
             (progn 'empty)))
      ((3)
       (locally (declare (type (array * (3)) #:input2056))
        (if (and (zerop (logior (numeric-char= #\f (aref #:input2056 0))
                                (numeric-char= #\o (aref #:input2056 1)))))
            (if (eql #\b (aref #:input2056 2))
                (progn 'fob)
                (if (eql #\o (aref #:input2056 2))
                    (progn 'foo)
                    (#:on-error2057)))
         (#:on-error2057))))
      ((6) (locally (declare (type (array * (6)) #:input2056))
             (if (and (zerop (logior (numeric-char= #\f (aref #:input2056 0))
                                     (numeric-char= #\o (aref #:input2056 1))
                                     (numeric-char= #\o (aref #:input2056 2))
                                     (numeric-char= #\b (aref #:input2056 3))))
                      (zerop (logior (numeric-char= #\a (aref #:input2056 4))
                                     (numeric-char= #\r (aref #:input2056 5)))))
                 (progn 'hit)
                 (#:on-error2057))))
      (t (#:on-error2057)))))

;;; A disassembly of the output on SBCL/x86-64
#+nil
(disassemble (lambda (x)
               (declare (optimize speed)
                        (type simple-base-string x))
               (string-case (x)
                 ("" 'empty)
                 ("foo" 'foo)
                 ("fob" 'fob)
                 ("foobar" 'hit)
                 (t     'default))))

; 0302B9C0:       488B4AF9         MOV RCX, [RDX-7]           ; no-arg-parsing entry point
;      9C4:       4885C9           TEST RCX, RCX
;      9C7:       7513             JNE L1
;      9C9:       488B1560FFFFFF   MOV RDX, [RIP-160]         ; 'EMPTY
;      9D0: L0:   488D65F0         LEA RSP, [RBP-16]
;      9D4:       F8               CLC
;      9D5:       488B6DF8         MOV RBP, [RBP-8]
;      9D9:       C20800           RET 8
;      9DC: L1:   4883F918         CMP RCX, 24
;      9E0:       7468             JEQ L4
;      9E2:       4883F930         CMP RCX, 48
;      9E6:       7405             JEQ L2
;      9E8:       E9AA000000       JMP L7
;      9ED: L2:   480FB64201       MOVZX RAX, BYTE PTR [RDX+1]
;      9F2:       4883F066         XOR RAX, 102
;      9F6:       488BC8           MOV RCX, RAX
;      9F9:       480FB64202       MOVZX RAX, BYTE PTR [RDX+2]
;      9FE:       4883F06F         XOR RAX, 111
;      A02:       4809C1           OR RCX, RAX
;      A05:       480FB64203       MOVZX RAX, BYTE PTR [RDX+3]
;      A0A:       4883F06F         XOR RAX, 111
;      A0E:       4809C1           OR RCX, RAX
;      A11:       480FB64204       MOVZX RAX, BYTE PTR [RDX+4]
;      A16:       4883F062         XOR RAX, 98
;      A1A:       4809C1           OR RCX, RAX
;      A1D:       4885C9           TEST RCX, RCX
;      A20:       7526             JNE L3
;      A22:       480FB64205       MOVZX RAX, BYTE PTR [RDX+5]
;      A27:       4883F061         XOR RAX, 97
;      A2B:       488BC8           MOV RCX, RAX
;      A2E:       480FB64206       MOVZX RAX, BYTE PTR [RDX+6]
;      A33:       4883F072         XOR RAX, 114
;      A37:       4809C1           OR RCX, RAX
;      A3A:       4885C9           TEST RCX, RCX
;      A3D:       7509             JNE L3
;      A3F:       488B15F2FEFFFF   MOV RDX, [RIP-270]         ; 'HIT
;      A46:       EB88             JMP L0
;      A48: L3:   EB4D             JMP L7
;      A4A: L4:   480FB64201       MOVZX RAX, BYTE PTR [RDX+1]
;      A4F:       4883F066         XOR RAX, 102
;      A53:       488BC8           MOV RCX, RAX
;      A56:       480FB64202       MOVZX RAX, BYTE PTR [RDX+2]
;      A5B:       4883F06F         XOR RAX, 111
;      A5F:       4809C1           OR RCX, RAX
;      A62:       4885C9           TEST RCX, RCX
;      A65:       7402             JEQ L5
;      A67:       EB2E             JMP L7
;      A69: L5:   480FB64203       MOVZX RAX, BYTE PTR [RDX+3]
;      A6E:       4883F862         CMP RAX, 98
;      A72:       750C             JNE L6
;      A74:       488B15C5FEFFFF   MOV RDX, [RIP-315]         ; 'FOB
;      A7B:       E950FFFFFF       JMP L0
;      A80: L6:   480FB64203       MOVZX RAX, BYTE PTR [RDX+3]
;      A85:       4883F86F         CMP RAX, 111
;      A89:       750C             JNE L7
;      A8B:       488B15B6FEFFFF   MOV RDX, [RIP-330]         ; 'FOO
;      A92:       E939FFFFFF       JMP L0
;      A97: L7:   488B15B2FEFFFF   MOV RDX, [RIP-334]         ; 'DEFAULT
                                                              ; no-arg-parsing entry point
;      A9E:       488D65F0         LEA RSP, [RBP-16]
;      AA2:       F8               CLC
;      AA3:       488B6DF8         MOV RBP, [RBP-8]
;      AA7:       C20800           RET 8
;      AAA:       90               NOP
;      AAB:       90               NOP
;      AAC:       90               NOP
;      AAD:       90               NOP
;      AAE:       90               NOP
;      AAF:       90               NOP
;      AB0:       0F0B0A           BREAK 10                   ; error trap
;      AB3:       02               BYTE #X02
;      AB4:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;      AB5:       4E               BYTE #X4E                  ; RCX
;      AB6:       0F0B0A           BREAK 10                   ; error trap
;      AB9:       02               BYTE #X02
;      ABA:       34               BYTE #X34                  ; OBJECT-NOT-SIMPLE-BASE-STRING-ERROR
;      ABB:       8F               BYTE #X8F                  ; RDX


;;; Some noise to guide pbook's generation.
;; Local Variables:
;; pbook-author:      "Paul Khuong"
;; pbook-include-toc: nil
;; pbook-style:       article
;; pbook-monochrome:  t
;; End:

#+nil
(defmacro with-timing ((total-iters subiters) &body forms)
  (let ((_thunk (gensym "THUNK"))
        (iters  (ceiling total-iters subiters)))
    `(flet ((,_thunk ()
              ,@forms))
       (let ((min sb-ext:double-float-positive-infinity)
             (sum 0d0)
             (max 0d0))
         (declare (type double-float min sum max))
         (loop repeat ,iters
            do (multiple-value-bind (_ begin/sec begin/us)
                   (sb-unix:unix-fast-getrusage sb-unix:rusage_self)
                 (declare (ignore _))
                 (loop repeat ,subiters
                    do (,_thunk))
                 (multiple-value-bind (_ end/sec end/us)
                     (sb-unix:unix-fast-getrusage sb-unix:rusage_self)
                   (declare (ignore _))
                   (let ((time (+ (float  (- end/sec begin/sec) 0d0)
                                  (* 1d-6 (- end/us begin/us)))))
                     (setf min (min time min)
                           sum (+   time sum)
                           max (max time max))
                     (values))))
            finally (return (values min
                                    (/ sum ,iters)
                                    max)))))))