EmacsLisp中的模式匹配

Emacs自带了一个库 GIT:emacs-lisp/pcase.el 可以为Elisp提供ML风格的模式匹配宏. 该宏是自动加载的, 因此你无需显式的require它.

下面倒数的函数中使用了 if.

(defun recip (n)
  (if (zerop n)
      (error "Can't divide by zero")
    (/ 1.0 n)))

可以使用 pcase 改写成使用模式匹配的版本.

(defun recip (n)
  (pcase n
    (`0 (error "Can't divide by zero"))
    (n (/ 1.0 n))))

(recip 0)
==> (error "Can't divide by zero")
(recip 2)
==> 0.5

下面是另一个使用 pcase 的例子,是一个取绝对值的函数,其中用到了该宏中定义的 pred 符号

(defun absval (x)
  (pcase x
    ((pred (< 0)) x)
    ((pred (= 0)) 0)
    ((pred (> 0)) (- x))))
(absval 1)
==> 1
(absval 0)
==> 0
(absval -1)
==> 1

下面函数实现了 car 的功能,找出list的头元素.

(defun newcar (list)
  (pcase list
    (`(,l . ,ll) l)))
(newcar '(a b c))
==> a

下面函数实现了 cdr 的功能,找出list的尾部.

(defun newcdr (list)
  (pcase list
    (`(,l . ,ll) ll)))
(newcdr '(a b c))
==> (b c)

下面函数取出list中的第二个元素.

(defun 2nd (list)
  (pcase list
    (`(,l ,l2 . ,_) l2)))
(2nd '(1 2 3 4))
==> 2

上面函数在处理长度小于2的list时会返回nil.

(2nd '(1))
==> nil

下面函数取出list中的第三个元素.

(defun 3rd (list)
  (pcase list
    (`(,l ,l2 ,l3 . ,_) l3)))
(3rd '(1 2 3 4))
==> 3

没有模式来匹配list中的最后那个元素,因此你需要递归的用 cdr 截取list的尾部,直到最后一个元素.

(defun thelast (list)
  (pcase list
    (`(,l . nil) l)
    (_ (thelast (cdr list)))))          ;_表示default/otherwise
(thelast '(1 2))
==> 2
(thelast '(1 2 3 4))
==> 4

累加1到N的整数.

(defun sum-to (n)
  (pcase n
    (`1 1)
    (n (+ n (sum-to (1- n))))))
(sum-to 1)
==> 1
(sum-to 2)
==> 3
(sum-to 3)
==> 6
(sum-to 5)
==> 15
(sum-to 8)
==> 36
(mapcar 'sum-to (number-sequence 1 119))
==> (1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190
       210 231 253 276 300 325 351 378 406 435 465 496 528 561 595 630
       666 703 741 780 820 861 903 946 990 1035 1081 1128 1176 1225 1275
       1326 1378 1431 1485 1540 1596 1653 1711 1770 1830 1891 1953 2016
       2080 2145 2211 2278 2346 2415 2485 2556 2628 2701 2775 2850 2926
       3003 3081 3160 3240 3321 3403 3486 3570 3655 3741 3828 3916 4005
       4095 4186 4278 4371 4465 4560 4656 4753 4851 4950 5050 5151 5253
       5356 5460 5565 5671 5778 5886 5995 6105 6216 6328 6441 6555 6670
       6786 6903 7021 7140)

计算第N个Fibonacci数.

(defun fib (n)
  (pcase n
    (`0 1)
    (`1 1)
    (n (+ (fib (- n 1)) (fib (- n 2))))))
(mapcar 'fib (number-sequence 0 6))
==> (1 1 2 3 5 8 13)

计算N的阶乘(N!)

(defun fac (n)
  (pcase n
    (`0 1)
    (n (* n (fac (1- n)))))))
(mapcar 'fac (number-sequence 1 12))
==> (1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600)

计算最大公约数的欧几里得算法. 通过将多个参数整合为一个list,可以将模式匹配用于多个参数.

(defun gcd (x y)
  (pcase (list x y)
    (`(,x 0) x)
    (`(,x ,y) (gcd y (% x y)))))
(gcd 12 8)
==> 4

另一种将同时匹配多参数模式的方法是使用反引用符号`. 要注意它与模式符号用的同一个符号. 下面计算X的N次方.

(defun pow (x n)
  (pcase `(,x ,n)
    (`(,x 0) 1)
    (`(,x ,n)
     (* x (pow x (1- n))))))

下面是一个优化后的版本.

(defun pow-fast (x n)
  (pcase `(,x ,n)
    (`(,x 0) 1)
    ((and (let (pred oddp) n) `(,x ,n))
     (* x (pow-fast (* x x) (/ n 2))))
    (`(,x ,n)
     (pow-fast (* x x) (/ n 2)))))
(pow-fast 2 5)
==> 32

Ackermann函数的实现:

(defun ackermann (m n)
  (pcase (list m n)
    (`(0 ,n) (1+ n))
    (`(,m 0) (ackermann (1- m) 1))
    (`(,m ,n) (ackermann (1- m)
                         (ackermann m (1- n))))))
(ackermann 0 0)
==> 1
(ackermann 0 1)
==> 2
(ackermann 0 2)
==> 3
(ackermann 1 1)
==> 3
(ackermann 1 2)
==> 4
(ackermann 1 3)
==> 5
(ackermann 2 1)
==> 5
(ackermann 2 2)
==> 7
(ackermann 2 3)
==> 9
(ackermann 2 4)
==> 11
(ackermann 2 5)
==> 13
(ackermann 3 1)
==> 13
(ackermann 3 2)
==> 29
(ackermann 3 3)
==> 61
(ackermann 4 1)
==> 65533

用递归的方式将数字转换为英文书写形式.

(defun int-to-words (n)
  "List of English groupings for number N."
  (let* ((pow10 (pcase (if (zerop n) 1 (floor (log10 (abs n))))
                  (`1 1)
                  (`2 2)
                  (`3 3)
                  (n (- n (% n 3)))))
         (base10 (expt 10.0 pow10)))
    (pcase n
      (`nil (error))
      ((pred (> 0)) (cons "negative" (int-to-words (- n))))
      (`0 '("zero"))
      (`1 '("one"))
      (`2 '("two"))
      (`3 '("three"))
      (`4 '("four"))
      (`5 '("five"))
      (`6 '("six"))
      (`7 '("seven"))
      (`8 '("eight"))
      (`9 '("nine"))
      (`10 '("ten"))
      (`11 '("eleven"))
      (`12 '("twelve"))
      (`13 '("thirteen"))
      (`14 '("fourteen"))
      (`15 '("fifteen"))
      (`16 '("sixteen"))
      (`17 '("seventeen"))
      (`18 '("eighteen"))
      (`19 '("nineteen"))
      (`20 '("twenty"))
      (`30 '("thirty"))
      (`40 '("forty"))
      (`50 '("fifty"))
      (`60 '("sixty"))
      (`70 '("seventy"))
      (`80 '("eighty"))
      (`90 '("ninety"))
      ;; Less than 100
      ((pred (> 100))
       (list (mapconcat 'identity
                        (cons (car (int-to-words (- n (% n 10))))
                              (int-to-words (% n 10))) "-")))
      ;; Equal to a base ten
      ((pred (= base10)) (pcase pow10
                           (`2  '("hundred"))
                           (`3  '("thousand"))
                           (`6  '("million"))
                           (`9  '("billion"))
                           (`12 '("trillion"))
                           (`15 '("quadrillion"))
                           (`18 '("quintillion"))
                           (`21 '("sextillion"))
                           (`24 '("septillion"))
                           (`27 '("octillion"))
                           (`30 '("nonillion"))
                           (`33 '("decillion"))
                           (`36 '("undecillion"))
                           (`39 '("duodecillion"))
                           (`42 '("tredecillion"))
                           (`45 '("quattuordecillion"))
                           (`48 '("quindecillion"))
                           (`51 '("sexdecillion"))
                           (`54 '("septendecillion"))
                           (`57 '("octodecillion"))
                           (`60 '("novemdecillion"))
                           (`63 '("vigintillion"))
                           (_ (signal 'domain-error (list n)))))
      ;; Greater than a base ten
      ((pred (< base10))
       (cons (mapconcat 'identity
                        (append (int-to-words (floor (/ n base10)))
                                (int-to-words base10))
                        (if (< (/ n base10) 20) "-" " "))
             (if (zerop (mod n base10))
                 nil
               (int-to-words (if (< n most-positive-fixnum)
                                 (% (floor n) (floor base10))
                               (mod n base10)))))))))

(int-to-words 333)
==> ("three-hundred" "thirty-three")

(defun int-to-phrase (n)
  "Number N in English."
  (let ((words (int-to-words n)))
    (cond
     ((equal "negative" (car words))
      (mapconcat 'identity
                 (append
                  (list (car words)) ;; '("negative")
                  (if (> (length (cdr words)) 1)
                      (list (mapconcat 'identity (butlast (cdr words) 1) ", "))
                    nil)
                  (if (> (length (cdr words)) 1) '("and") nil)
                  (last (cdr words) 1))
                 " "))
     ((> (length words) 1)
      (mapconcat 'identity
                 (append
                  (list (mapconcat 'identity (butlast words 1) ", "))
                  '("and")
                  (last words 1)) " "))
     (t (car words)))))

(int-to-phrase -4444)
==> "negative four-thousand, four-hundred and forty-four"

另外关于 WikiPedia:Pattern matching, Nic Ferrier on using pcase for refactoring

我试了一下下面的代码,完全没问题.

#+BEGIN_SRC emacs-lisp
  (pcase '(apple . (banana orange))
    (`(,a . (,b ,c)) (list a b c)))
  ==> (apple banana orange)
#+END_SRC

但是当我将这个表达式进行宏展开后,得到的结果是:

#+BEGIN_SRC emacs-lisp
  (pp-macroexpand-expression 
   '(pcase '(apple . (banana orange))
      (`(,a . (,b ,c)) (list a b c))))

  ==> 
  (if (consp '(apple banana orange))
      (let* ((xcar (car '(apple banana orange)))
             (xcdr (cdr '(apple banana orange))))
        (if (consp xcdr)
            (let* ((xcar (car xcdr))
                   (xcdr (cdr xcdr)))
              (if (consp xcdr)
                  (let* ((xcar (car xcdr))
                         (xcdr (cdr xcdr)))
                    (if (null xcdr)
                        (let ((c xcar)
                              (b xcar)
                              (a xcar))
                          (list a b c))
                      nil))
                nil))
          nil))
    nil)
#+END_SRC

很明显不可能将‘a’, ‘b’, ‘c’都绑定到‘xcar’,否则结果应该是“(orange orange orange)”. 
我感到很迷惑,这是Emacs中 =macroexpand= 的BUG吗? 还是我理解有问题?我的Emacs版本是 “GNU Emacs 24.3.1”

--xiepan

事实上,所有这些‘xcar’都是不同的symbol,只不过恰巧有同一个名字而已. 若你执行过 (setq print-gensym t), 你就会发现这些xcar输出为 #:xcar ,也就是说它们是uninterned symbols.