某愉悅的scheme之旅（5）--從零開始實現模式匹配宏

為什麼需要模式匹配

模式匹配可以大幅度減少你的代碼，將你從大量嵌套if的地獄中拯救出來。

實際體驗：寫一個簡單的lisp解釋器，不使用模式匹配。

嘗試學習racket裡面提供的match函數改寫。

模式匹配可以輕易的解構和綁定數據，常用的模式有：

(match something-to-matchn [(list a b ...) Exp]n [var Exp]n [`(a ,b ...) Exp]n[(struct-constructor-name a ...) Exp]n [else Exp])n

註：在racket中中括弧和小括弧是等效的，但是配對時必須一致。

第一步

(define-syntax pmatchn (syntax-rules ()n [(_ val (var res))n (let ([t val])n (let ([var t])n res))]))n(pmatch (1 . 2) (a (car a)))n(pmatch 2 (x (+ x 1)))n

我們先寫了一個簡單的pmatch宏，僅僅支持直接綁定到一個變數，雖然看似簡陋，不過，千里之行，始於足下。

將val計算出來並綁定到var

第二步

下面我們來支持Pair的配對：

(define-syntax pmatchn (syntax-rules (cons)n [(_ val ((cons a b) res))n (let ([t val])n (let ([a (car t)]n [b (cdr t)])n res))]n [(_ val (var res))n (let ([t val])n (let ([var t])n res))]n ))n(pmatch (1 . 2) [(cons a b) b])n(pmatch (1 2) [(cons a b) b])n(pmatch (3 4 5) [a a])n

這段代碼增加了對pair（cons）的處理，越來越實用了。

這裡還有一個注意點，處理pair的代碼要放在處理var的代碼前面，否則（cons a b）會被直接匹配到 var上面，永遠也不會用到處理pair的代碼。

第三步

現在僅僅有一種匹配的模式一定不能滿足要求，我們需要改成支持多種匹配模式的。如果所有模式都不能滿足要求，提示錯誤。else和var 能滿足所有的要求。

(define-syntax pmatchn (syntax-rules (cons else)n [(_ val ((cons a b) res) rest ...)n (let ([t val])n (if (pair? val)n (let ([a (car t)]n [b (cdr t)])n res) (pmatch t rest ...)))]n [(_ val (else res) rest ...)n res]n [(_ val (var res) rest ...)n (let ([t val])n (let ([var t])n res))]n [(_ val) (error "Pattern Matching Error" val)]n ))nn(pmatch (1 2 3) ((cons a b) b) (else (void)))n(pmatch 23 ((cons a b) a) (a (+ 1 a)))n(pmatch 23 ((cons a b) a))n

我們使用rest ...表示餘下的模式，當不存在餘下模式時，直接報錯。

第四步：更多的cons

雖然我們已經能匹配cons這一模式了，但是還不夠，我們現在還不支持(cons a (cons b c))這樣的複雜模式.。

怎麼辦呢,我們先把pmatch改成Continuation-Passing-Style Macro，什麼，宏也能cps?

沒錯，儘管這算是奇淫技巧，宏裡面的奇淫技巧太多了，甚至有人拿syntax-rules來實現非衛生宏，還有人實現宏層面的apply和lambda，不過一股蛋疼的感覺。。

我們先寫一個ppat宏，算是pmatch的簡化+cps版，參數為fctx（失敗時的cont），val（值），pattern （模式），res（結果表達式）。

(define-syntax ppatn (syntax-rules (cons)n [(_ fctx val (cons a b) res) (if (pair? val)n (ppat fctx (car val) an (ppat fctx (cdr val) b res))n fctx)]n [(_ fctx val var res) (let ((var val))n res)]))nn(ppat (display "failed") ((1 . 2) 3) (cons (cons a b) (cons c d)) (list c b a))n(ppat (display "failed") (2 3) (cons (cons a b) (cons c d)) (list c b a))n

ppat宏完美解決了複雜嵌套模式的問題，現在我們要開始構建我們新的pmatch宏了。

(define-syntax ppatn (syntax-rules (cons)n [(_ fctx val (cons a b) res) (if (pair? val)n (ppat fctx (car val) an (ppat fctx (cdr val) b res))n fctx)]n [(_ fctx val var res) (let ((var val))n res)]))nn(define-syntax pmatchn (syntax-rules ()n [(_ val) (error "Pattern Matching Error")]n [(_ val (pattern res) rest ...)n (let ((t val))n (ppat (pmatch t rest ...)n t pattern res))]))nn(pmatch (1 2 3) ((cons (cons x y) z) z) ((cons x y) x))n(pmatch (1 2 3) ((cons x (cons y (cons z t))) (list z y x)))n

第四步：更多的模式，更多的模式

現在我們還沒有一些對常量的匹配，我們需要擴展ppat宏。

不過我們沒有辦法在宏裡面判斷輸入的參數是否是一個常量，不過也有變通的辦法，比如用const表示常量模式，雖然可能麻煩一些。

(define-syntax ppatn (syntax-rules (cons else const)n [(_ fctx val (const cs) res) (if (equal? cs val)n resn fctx)]n [(_ fctx val else res) res]n [(_ fctx val (cons a b) res) (if (pair? val)n (ppat fctx (car val) an (ppat fctx (cdr val) b res))n fctx)]n [(_ fctx val var res) (let ((var val))n res)]))n

這是最終版的ppat，你可以嘗試改進他。

其實我們現在離真正好用的pattern matching還遠著呢。。。但是演示其是如何實現的對提高水平是大有裨益的。

結尾：用pmatch寫一個解釋器（typed racket）

先定義數據結構：

(struct Add ([x : Exp][y : Exp]))n(struct Sub ([x : Exp][y : Exp]))n(struct Mul ([x : Exp](y : Exp)))n(struct Div ([x : Exp][y : Exp]))n(define-type Exp (U Number Add Sub Mul Div))n(: interp (-> Exp Number))n

(define-syntax ppatn (syntax-rules (cons else const Add Sub Mul Div)n [(_ fctx val (Div a b) res) (if (Div val)n (ppat fctx (Div-x val) an (ppat fctx (Div-y val) b res))n fctx)]n [(_ fctx val (Mul a b) res) (if (Mul? val)n (ppat fctx (Mul-x val) an (ppat fctx (Mul-y val) b res))n fctx)]n [(_ fctx val (Sub a b) res) (if (Sub? val)n (ppat fctx (Sub-x val) an (ppat fctx (Sub-y val) b res))n fctx)]n [(_ fctx val (Add a b) res) (if (Add? val)n (ppat fctx (Add-x val) an (ppat fctx (Add-y val) b res))n fctx)]n [(_ fctx val (const cs) res) (if (equal? cs val)n resn fctx)]n [(_ fctx val else res) res]n [(_ fctx val (cons a b) res) (if (pair? val)n (ppat fctx (car val) an (ppat fctx (cdr val) b res))n fctx)]n [(_ fctx val var res) (let ((var val))n res)]))n

然後開始寫interp函數：

(define interpn (lambda (exp)n (pmatch expn [(Add x y) (+ (interp x) (interp y))]n [(Sub x y) (- (interp x) (interp y))]n [(Mul x y) (* (interp x) (interp y))]n [(Div x (const 0)) (error "DIVIDE ERROR")]n [(Div x y) (/ (interp x) (interp y))]n [num (if (number? num)n numn (error "INTERP ERROR"))])))n(interp (Add (Sub 1 2) (Mul 1 2)))n(interp (Add (Div 3 0) 3))n

呼，第五篇文章完結，有任何問題儘管提出。

補充 由於時間倉促，這樣實現的模式匹配存在一個微小的問題，但僅僅需要做很少的改動，我們在下一篇解決，聰明的你不妨先嘗試解決這個問題。